diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,16294 +1,16302 @@ Isabelle NEWS -- history of user-relevant changes ================================================= (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.) New in this Isabelle version ---------------------------- *** General *** * Timeouts for Isabelle/ML tools are subject to system option "timeout_scale" --- this already used for the overall session build process before, and allows to adapt to slow machines. The underlying Timeout.apply in Isabelle/ML treats an original timeout specification 0 as no timeout; before it meant immediate timeout. Rare INCOMPATIBILITY in boundary cases. *** Document preparation *** * Improved LaTeX typesetting of \...\ using \guilsinglleft ... \guilsinglright. INCOMPATIBILITY, need to use \usepackage[T1]{fontenc} (which is now also the default in "isabelle mkroot"). *** HOL *** * Theory Multiset: dedicated predicate "multiset" is gone, use explict expression instead. Minor INCOMPATIBILITY. * Theory Multiset: consolidated abbreviations Mempty, Melem, not_Melem to empty_mset, member_mset, not_member_mset respectively. Minor INCOMPATIBILITY. * Theory Multiset: consolidated operation and fact names: inf_subset_mset ~> inter_mset sup_subset_mset ~> union_mset multiset_inter_def ~> inter_mset_def sup_subset_mset_def ~> union_mset_def multiset_inter_count ~> count_inter_mset sup_subset_mset_count ~> count_union_mset * Theory Multiset: syntax precendence for membership operations has been adjusted to match the corresponding precendences on sets. Rare INCOMPATIBILITY. * HOL-Analysis/HOL-Probability: indexed products of discrete distributions, negative binomial distribution, Hoeffding's inequality, Chernoff bounds, Cauchy–Schwarz inequality for nn_integral, and some more small lemmas. Some theorems that were stated awkwardly before were corrected. Minor INCOMPATIBILITY. * Theory "Permutation" in HOL-Library has been renamed to the more specific "List_Permutation". Note that most notions from that theory are already present in theory "Permutations". INCOMPATIBILITY. * Lemma "permutes_induct" has been given named premises. INCOMPATIBILITY. +* Theorems "antisym" and "eq_iff" in class "order" have been renamed to +"order.antisym" and "order.eq_iff", to coexist locally with "antisym" +and "eq_iff" from locale "ordering". INCOMPATIBILITY: significant +potential for change can be avoided if interpretations of type class +"order" are replaced or augmented by interpretations of locale +"ordering". + + *** ML *** * External bash processes are always managed by Isabelle/Scala, in contrast to Isabelle2021 where this was only done for macOS on Apple Silicon. The main Isabelle/ML interface is Isabelle_System.bash_process with result type Process_Result.T (resembling class Process_Result in Scala); derived operations Isabelle_System.bash and Isabelle_System.bash_output provide similar functionality as before. Rare INCOMPATIBILITY due to subtle semantic differences: - Processes invoked from Isabelle/ML actually run in the context of the Java VM of Isabelle/Scala. The settings environment and current working directory are usually the same on both sides, but there can be subtle corner cases (e.g. unexpected uses of "cd" or "putenv" in ML). - Output via stdout and stderr is line-oriented: Unix vs. Windows line-endings are normalized towards Unix; presence or absence of a final newline is irrelevant. The original lines are available as Process_Result.out_lines/err_lines; the concatenated versions Process_Result.out/err *omit* a trailing newline (using Library.trim_line, which was occasional seen in applications before, but is no longer necessary). - Output needs to be plain text encoded in UTF-8: Isabelle/Scala recodes it temporarily as UTF-16. This works for well-formed Unicode text, but not for arbitrary byte strings. In such cases, the bash script should write tempory files, managed by Isabelle/ML operations like Isabelle_System.with_tmp_file to create a file name and File.read to retrieve its content. - Just like any other Scala function invoked from ML, Isabelle_System.bash_process requires a proper PIDE session context. This could be a regular batch session (e.g. "isabelle build"), a PIDE editor session (e.g. "isabelle jedit"), or headless PIDE (e.g. "isabelle dump" or "isabelle server"). Note that old "isabelle console" or raw "isabelle process" don't have that. New Process_Result.timing works as in Isabelle/Scala, based on direct measurements of the bash_process wrapper in C: elapsed time is always available, CPU time is only available on Linux and macOS, GC time is unavailable. * Likewise, the following Isabelle/ML system operations are run in the context of Isabelle/Scala: - Isabelle_System.make_directory - Isabelle_System.copy_dir - Isabelle_System.copy_file - Isabelle_System.copy_base_file - Isabelle_System.rm_tree - Isabelle_System.download New in Isabelle2021 (February 2021) ----------------------------------- *** General *** * On macOS, the IsabelleXYZ.app directory layout now follows the other platforms, without indirection via Contents/Resources/. INCOMPATIBILITY, use e.g. IsabelleXYZ.app/bin/isabelle instead of former IsabelleXYZ.app/Isabelle/bin/isabelle or IsabelleXYZ.app/Isabelle/Contents/Resources/IsabelleXYZ/bin/isabelle. * HTML presentation uses rich markup produced by Isabelle/PIDE, resulting in more colors and links. * HTML presentation includes auxiliary files (e.g. ML) for each theory. * Proof method "subst" is confined to the original subgoal range: its included distinct_subgoals_tac no longer affects unrelated subgoals. Rare INCOMPATIBILITY. * Theory_Data extend operation is obsolete and needs to be the identity function; merge should be conservative and not reset to the empty value. Subtle INCOMPATIBILITY and change of semantics (due to Theory.join_theory from Isabelle2020). Special extend/merge behaviour at the begin of a new theory can be achieved via Theory.at_begin. *** Isabelle/jEdit Prover IDE *** * Improved GUI look-and-feel: the portable and scalable "FlatLaf Light" is used by default on all platforms (appearance similar to IntelliJ IDEA). * Improved markup for theory header imports: hyperlinks for theory files work without formal checking of content. * The prover process can download auxiliary files (e.g. 'ML_file') for theories with remote URL. This requires the external "curl" program. * Action "isabelle.goto-entity" (shortcut CS+d) jumps to the definition of the formal entity at the caret position. * The visual feedback on caret entity focus is normally restricted to definitions within the visible text area. The keyboard modifier "CS" overrides this: then all defining and referencing positions are shown. See also option "jedit_focus_modifier". * The jEdit status line includes widgets both for JVM and ML heap usage. Ongoing ML ongoing garbage collection is shown as "ML cleanup". * The Monitor dockable provides buttons to request a full garbage collection and sharing of live data on the ML heap. It also includes information about the Java Runtime system. * PIDE support for session ROOTS: markup for directories. * Update to jedit-5.6.0, the latest release. This version works properly on macOS by default, without the special MacOSX plugin. * Action "full-screen-mode" (shortcut F11 or S+F11) has been modified for better approximate window size on macOS and Linux/X11. * Improved GUI support for macOS 11.1 Big Sur: native fullscreen mode, but non-native look-and-feel (FlatLaf). * Hyperlinks to various file-formats (.pdf, .png, etc.) open an external viewer, instead of re-using the jEdit text editor. * IDE support for Naproche-SAD: Proof Checking of Natural Mathematical Documents. See also $NAPROCHE_HOME/examples for files with .ftl or .ftl.tex extension. The corresponding Naproche-SAD server process can be disabled by setting the system option naproche_server=false and restarting the Isabelle application. *** Document preparation *** * Keyword 'document_theories' within ROOT specifies theories from other sessions that should be included in the generated document source directory. This does not affect the generated session.tex: \input{...} needs to be used separately. * The standard LaTeX engine is now lualatex, according to settings variable ISABELLE_PDFLATEX. This is mostly upwards compatible with old pdflatex, but text encoding needs to conform strictly to utf8. Rare INCOMPATIBILITY. * Discontinued obsolete DVI format and ISABELLE_LATEX settings variable: document output is always PDF. * Antiquotation @{tool} refers to Isabelle command-line tools, with completion and formal reference to the source (external script or internal Scala function). * Antiquotation @{bash_function} refers to GNU bash functions that are checked within the Isabelle settings environment. * Antiquotations @{scala}, @{scala_object}, @{scala_type}, @{scala_method} refer to checked Isabelle/Scala entities. *** Pure *** * Session Pure-Examples contains notable examples for Isabelle/Pure (former entries of HOL-Isar_Examples). * Named contexts (locale and class specifications, locale and class context blocks) allow bundle mixins for the surface context. This allows syntax notations to be organized within bundles conveniently. See theory "HOL-ex.Specifications_with_bundle_mixins" for examples and the isar-ref manual for syntax descriptions. * Definitions in locales produce rule which can be added as congruence rule to protect foundational terms during simplification. * Consolidated terminology and function signatures for nested targets: - Local_Theory.begin_nested replaces Local_Theory.open_target - Local_Theory.end_nested replaces Local_Theory.close_target - Combination of Local_Theory.begin_nested and Local_Theory.end_nested(_result) replaces Local_Theory.subtarget(_result) INCOMPATIBILITY. * Local_Theory.init replaces Generic_Target.init. Minor INCOMPATIBILITY. *** HOL *** * Session HOL-Examples contains notable examples for Isabelle/HOL (former entries of HOL-Isar_Examples, HOL-ex etc.). * An updated version of the veriT solver is now included as Isabelle component. It can be used in the "smt" proof method via "smt (verit)" or via "declare [[smt_solver = verit]]" in the context; see also session HOL-Word-SMT_Examples. * Zipperposition 2.0 is now included as Isabelle component for experimentation, e.g. in "sledgehammer [prover = zipperposition]". * Sledgehammer: - support veriT in proof preplay - take adventage of more cores in proof preplay * Updated the Metis prover underlying the "metis" proof method to version 2.4 (release 20180810). The new version fixes one soundness defect and two incompleteness defects. Very slight INCOMPATIBILITY. * Nitpick/Kodkod may be invoked directly within the running Isabelle/Scala session (instead of an external Java process): this improves reactivity and saves resources. This experimental feature is guarded by system option "kodkod_scala" (default: true in PIDE interaction, false in batch builds). * Simproc "defined_all" and rewrite rule "subst_all" perform more aggressive substitution with variables from assumptions. INCOMPATIBILITY, consider repairing proofs locally like this: supply subst_all [simp del] [[simproc del: defined_all]] * Simproc "datatype_no_proper_subterm" rewrites equalities "lhs = rhs" on datatypes to "False" if either side is a proper subexpression of the other (for any datatype with a reasonable size function). * Syntax for state monad combinators fcomp and scomp is organized in bundle state_combinator_syntax. Minor INCOMPATIBILITY. * Syntax for reflected term syntax is organized in bundle term_syntax, discontinuing previous locale term_syntax. Minor INCOMPATIBILITY. * New constant "power_int" for exponentiation with integer exponent, written as "x powi n". * Added the "at most 1" quantifier, Uniq. * For the natural numbers, "Sup {} = 0". * New constant semiring_char gives the characteristic of any type of class semiring_1, with the convenient notation CHAR('a). For example, CHAR(nat) = CHAR(int) = CHAR(real) = 0, CHAR(17) = 17. * HOL-Computational_Algebra.Polynomial: Definition and basic properties of algebraic integers. * Library theory "Bit_Operations" with generic bit operations. * Library theory "Signed_Division" provides operations for signed division, instantiated for type int. * Theory "Multiset": removed misleading notation \# for sum_mset; replaced with \\<^sub>#. Analogous notation for prod_mset also exists now. * New theory "HOL-Library.Word" takes over material from former session "HOL-Word". INCOMPATIBILITY: need to adjust imports. * Theory "HOL-Library.Word": Type word is restricted to bit strings consisting of at least one bit. INCOMPATIBILITY. * Theory "HOL-Library.Word": Bit operations NOT, AND, OR, XOR are based on generic algebraic bit operations from theory "HOL-Library.Bit_Operations". INCOMPATIBILITY. * Theory "HOL-Library.Word": Most operations on type word are set up for transfer and lifting. INCOMPATIBILITY. * Theory "HOL-Library.Word": Generic type conversions. INCOMPATIBILITY, sometimes additional rewrite rules must be added to applications to get a confluent system again. * Theory "HOL-Library.Word": Uniform polymorphic "mask" operation for both types int and word. INCOMPATIBILITY. * Theory "HOL-Library.Word": Syntax for signed compare operators has been consolidated with syntax of regular compare operators. Minor INCOMPATIBILITY. * Former session "HOL-Word": Various operations dealing with bit values represented as reversed lists of bools are separated into theory Reversed_Bit_Lists in session Word_Lib in the AFP. INCOMPATIBILITY. * Former session "HOL-Word": Theory "Word_Bitwise" has been moved to AFP entry Word_Lib as theory "Bitwise". INCOMPATIBILITY. * Former session "HOL-Word": Compound operation "bin_split" simplifies by default into its components "drop_bit" and "take_bit". INCOMPATIBILITY. * Former session "HOL-Word": Operations lsb, msb and set_bit are separated into theories Least_significant_bit, Most_significant_bit and Generic_set_bit respectively in session Word_Lib in the AFP. INCOMPATIBILITY. * Former session "HOL-Word": Ancient int numeral representation has been factored out in separate theory "Ancient_Numeral" in session Word_Lib in the AFP. INCOMPATIBILITY. * Former session "HOL-Word": Operations "bin_last", "bin_rest", "bin_nth", "bintrunc", "sbintrunc", "norm_sint", "bin_cat" and "max_word" are now mere input abbreviations. Minor INCOMPATIBILITY. * Former session "HOL-Word": Misc ancient material has been factored out into separate theories and moved to session Word_Lib in the AFP. See theory "Guide" there for further information. INCOMPATIBILITY. * Session HOL-TPTP: The "tptp_isabelle" and "tptp_sledgehammer" commands are in working order again, as opposed to outputting "GaveUp" on nearly all problems. * Session "HOL-Hoare": concrete syntax only for Hoare triples, not abstract language constructors. * Session "HOL-Hoare": now provides a total correctness logic as well. *** FOL *** * Added the "at most 1" quantifier, Uniq, as in HOL. * Simproc "defined_all" and rewrite rule "subst_all" have been changed as in HOL. *** ML *** * Antiquotations @{scala_function}, @{scala}, @{scala_thread} refer to registered Isabelle/Scala functions (of type String => String): invocation works via the PIDE protocol. * Path.append is available as overloaded "+" operator, similar to corresponding Isabelle/Scala operation. * ML statistics via an external Poly/ML process: this allows monitoring the runtime system while the ML program sleeps. *** System *** * Isabelle server allows user-defined commands via isabelle_scala_service. * Update/rebuild external provers on currently supported OS platforms, notably CVC4 1.8, E prover 2.5, SPASS 3.8ds, CSDP 6.1.1. * The command-line tool "isabelle log" prints prover messages from the build database of the given session, following the the order of theory sources, instead of erratic parallel evaluation. Consequently, the session log file is restricted to system messages of the overall build process, and thus becomes more informative. * Discontinued obsolete isabelle display tool, and DVI_VIEWER settings variable. * The command-line tool "isabelle logo" only outputs PDF; obsolete EPS (for DVI documents) has been discontinued. Former option -n has been turned into -o with explicit file name. Minor INCOMPATIBILITY. * The command-line tool "isabelle components" supports new options -u and -x to manage $ISABELLE_HOME_USER/etc/components without manual editing of Isabelle configuration files. * The shell function "isabelle_directory" (within etc/settings of components) augments the list of special directories for persistent symbolic path names. This improves portability of heap images and session databases. It used to be hard-wired for Isabelle + AFP, but other projects may now participate on equal terms. * The command-line tool "isabelle process" now prints output to stdout/stderr separately and incrementally, instead of just one bulk to stdout after termination. Potential INCOMPATIBILITY for external tools. * The command-line tool "isabelle console" now supports interrupts properly (on Linux and macOS). * Batch-builds via "isabelle build" use a PIDE session with special protocol: this allows to invoke Isabelle/Scala operations from Isabelle/ML. Big build jobs (e.g. AFP) require extra heap space for the java process, e.g. like this in $ISABELLE_HOME_USER/etc/settings: ISABELLE_TOOL_JAVA_OPTIONS="$ISABELLE_TOOL_JAVA_OPTIONS -Xmx8g" This includes full PIDE markup, if option "build_pide_reports" is enabled. * The command-line tool "isabelle build" provides option -P DIR to produce PDF/HTML presentation in the specified directory; -P: refers to the standard directory according to ISABELLE_BROWSER_INFO / ISABELLE_BROWSER_INFO_SYSTEM settings. Generated PDF documents are taken from the build database -- from this or earlier builds with option document=pdf. * The command-line tool "isabelle document" generates theory documents on the spot, using the underlying session build database (exported LaTeX sources or existing PDF files). INCOMPATIBILITY, the former "isabelle document" tool was rather different and has been discontinued. * The command-line tool "isabelle sessions" explores the structure of Isabelle sessions and prints result names in topological order (on stdout). * The Isabelle/Scala "Progress" interface changed slightly and "No_Progress" has been discontinued. INCOMPATIBILITY, use "new Progress" instead. * General support for Isabelle/Scala system services, configured via the shell function "isabelle_scala_service" in etc/settings (e.g. of an Isabelle component); see implementations of class Isabelle_System.Service in Isabelle/Scala. This supersedes former "isabelle_scala_tools" and "isabelle_file_format": minor INCOMPATIBILITY. * The syntax of theory load commands (for auxiliary files) is now specified in Isabelle/Scala, as instance of class isabelle.Command_Span.Load_Command registered via isabelle_scala_service in etc/settings. This allows more flexible schemes than just a list of file extensions. Minor INCOMPATIBILITY, e.g. see theory HOL-SPARK.SPARK_Setup to emulate the old behaviour. * JVM system property "isabelle.laf" has been discontinued; the default Swing look-and-feel is ""FlatLaf Light". * Isabelle/Phabricator supports Ubuntu 20.04 LTS. * Isabelle/Phabricator setup has been updated to follow ongoing development: libphutil has been discontinued. Minor INCOMPATIBILITY: existing server installations should remove libphutil from /usr/local/bin/isabelle-phabricator-upgrade and each installation root directory (e.g. /var/www/phabricator-vcs/libphutil). * Experimental support for arm64-linux platform. The reference platform is Raspberry Pi 4 with 8 GB RAM running Pi OS (64 bit). * Support for Apple Silicon, using mostly x86_64-darwin runtime translation via Rosetta 2 (e.g. Poly/ML and external provers), but also some native arm64-darwin executables (e.g. Java). New in Isabelle2020 (April 2020) -------------------------------- *** General *** * Session ROOT files need to specify explicit 'directories' for import of theory files. Directories cannot be shared by different sessions. (Recall that import of theories from other sessions works via session-qualified theory names, together with suitable 'sessions' declarations in the ROOT.) * Internal derivations record dependencies on oracles and other theorems accurately, including the implicit type-class reasoning wrt. proven class relations and type arities. In particular, the formal tagging with "Pure.skip_proofs" of results stemming from "instance ... sorry" is now propagated properly to theorems depending on such type instances. * Command 'sorry' (oracle "Pure.skip_proofs") is more precise about the actual proposition that is assumed in the goal and proof context. This requires at least Proofterm.proofs = 1 to show up in theorem dependencies. * Command 'thm_oracles' prints all oracles used in given theorems, covering the full graph of transitive dependencies. * Command 'thm_deps' prints immediate theorem dependencies of the given facts. The former graph visualization has been discontinued, because it was hardly usable. * Refined treatment of proof terms, including type-class proofs for minor object-logics (FOL, FOLP, Sequents). * The inference kernel is now confined to one main module: structure Thm, without the former circular dependency on structure Axclass. * Mixfix annotations may use "' " (single quote followed by space) to separate delimiters (as documented in the isar-ref manual), without requiring an auxiliary empty block. A literal single quote needs to be escaped properly. Minor INCOMPATIBILITY. *** Isar *** * The proof method combinator (subproofs m) applies the method expression m consecutively to each subgoal, constructing individual subproofs internally. This impacts the internal construction of proof terms: it makes a cascade of let-expressions within the derivation tree and may thus improve scalability. * Attribute "trace_locales" activates tracing of locale instances during roundup. It replaces the diagnostic command 'print_dependencies', which has been discontinued. *** Isabelle/jEdit Prover IDE *** * Prover IDE startup is now much faster, because theory dependencies are no longer explored in advance. The overall session structure with its declarations of 'directories' is sufficient to locate theory files. Thus the "session focus" of option "isabelle jedit -S" has become obsolete (likewise for "isabelle vscode_server -S"). Existing option "-R" is both sufficient and more convenient to start editing a particular session. * Actions isabelle.tooltip (CS+b) and isabelle.message (CS+m) display tooltip message popups, corresponding to mouse hovering with/without the CONTROL/COMMAND key pressed. * The following actions allow to navigate errors within the current document snapshot: isabelle.first-error (CS+a) isabelle.last-error (CS+z) isabelle.next-error (CS+n) isabelle.prev-error (CS+p) * Support more brackets: \ \ (intended for implicit argument syntax). * Action isabelle.jconsole (menu item Plugins / Isabelle / Java/VM Monitor) applies the jconsole tool on the running Isabelle/jEdit process. This allows to monitor resource usage etc. * More adequate default font sizes for Linux on HD / UHD displays: automatic font scaling is usually absent on Linux, in contrast to Windows and macOS. * The default value for the jEdit property "view.antiAlias" (menu item Utilities / Global Options / Text Area / Anti Aliased smooth text) is now "subpixel HRGB", instead of former "standard". Especially on Linux this often leads to faster text rendering, but can also cause problems with odd color shades. An alternative is to switch back to "standard" here, and set the following Java system property: isabelle jedit -Dsun.java2d.opengl=true This can be made persistent via JEDIT_JAVA_OPTIONS in $ISABELLE_HOME_USER/etc/settings. For the "Isabelle2020" desktop application there is a corresponding options file in the same directory. *** Isabelle/VSCode Prover IDE *** * Update of State and Preview panels to use new WebviewPanel API of VSCode. *** HOL *** * Improvements of the 'lift_bnf' command: - Add support for quotient types. - Generate transfer rules for the lifted map/set/rel/pred constants (theorems "._transfer_raw"). * Term_XML.Encode/Decode.term uses compact representation of Const "typargs" from the given declaration environment. This also makes more sense for translations to lambda-calculi with explicit polymorphism. INCOMPATIBILITY, use Term_XML.Encode/Decode.term_raw in special applications. * ASCII membership syntax concerning big operators for infimum and supremum has been discontinued. INCOMPATIBILITY. * Removed multiplicativity assumption from class "normalization_semidom". Introduced various new intermediate classes with the multiplicativity assumption; many theorem statements (especially involving GCD/LCM) had to be adapted. This allows for a more natural instantiation of the algebraic typeclasses for e.g. Gaussian integers. INCOMPATIBILITY. * Clear distinction between types for bits (False / True) and Z2 (0 / 1): theory HOL-Library.Bit has been renamed accordingly. INCOMPATIBILITY. * Dynamic facts "algebra_split_simps" and "field_split_simps" correspond to algebra_simps and field_simps but contain more aggressive rules potentially splitting goals; algebra_split_simps roughly replaces sign_simps and field_split_simps can be used instead of divide_simps. INCOMPATIBILITY. * Theory HOL.Complete_Lattices: renamed Inf_Sup -> Inf_eq_Sup and Sup_Inf -> Sup_eq_Inf * Theory HOL-Library.Monad_Syntax: infix operation "bind" (\) associates to the left now as is customary. * Theory HOL-Library.Ramsey: full finite Ramsey's theorem with multiple colours and arbitrary exponents. * Session HOL-Proofs: build faster thanks to better treatment of proof terms in Isabelle/Pure. * Session HOL-Word: bitwise NOT-operator has proper prefix syntax. Minor INCOMPATIBILITY. * Session HOL-Analysis: proof method "metric" implements a decision procedure for simple linear statements in metric spaces. * Session HOL-Complex_Analysis has been split off from HOL-Analysis. *** ML *** * Theory construction may be forked internally, the operation Theory.join_theory recovers a single result theory. See also the example in theory "HOL-ex.Join_Theory". * Antiquotation @{oracle_name} inlines a formally checked oracle name. * Minimal support for a soft-type system within the Isabelle logical framework (module Soft_Type_System). * Former Variable.auto_fixes has been replaced by slightly more general Proof_Context.augment: it is subject to an optional soft-type system of the underlying object-logic. Minor INCOMPATIBILITY. * More scalable Export.export using XML.tree to avoid premature string allocations, with convenient shortcut XML.blob. Minor INCOMPATIBILITY. * Prover IDE support for the underlying Poly/ML compiler (not the basis library). Open $ML_SOURCES/ROOT.ML in Isabelle/jEdit to browse the implementation with full markup. *** System *** * Standard rendering for more Isabelle symbols: \ \ \ \ * The command-line tool "isabelle scala_project" creates a Gradle project configuration for Isabelle/Scala/jEdit, to support Scala IDEs such as IntelliJ IDEA. * The command-line tool "isabelle phabricator_setup" facilitates self-hosting of the Phabricator software-development platform, with support for Git, Mercurial, Subversion repositories. This helps to avoid monoculture and to escape the gravity of centralized version control by Github and/or Bitbucket. For further documentation, see chapter "Phabricator server administration" in the "system" manual. A notable example installation is https://isabelle-dev.sketis.net/. * The command-line tool "isabelle hg_setup" simplifies the setup of Mercurial repositories, with hosting via Phabricator or SSH file server access. * The command-line tool "isabelle imports" has been discontinued: strict checking of session directories enforces session-qualified theory names in applications -- users are responsible to specify session ROOT entries properly. * The command-line tool "isabelle dump" and its underlying Isabelle/Scala module isabelle.Dump has become more scalable, by splitting sessions and supporting a base logic image. Minor INCOMPATIBILITY in options and parameters. * The command-line tool "isabelle build_docker" has been slightly improved: it is now properly documented in the "system" manual. * Isabelle/Scala support for the Linux platform (Ubuntu): packages, users, system services. * Isabelle/Scala support for proof terms (with full type/term information) in module isabelle.Term. * Isabelle/Scala: more scalable output of YXML files, e.g. relevant for "isabelle dump". * Theory export via Isabelle/Scala has been reworked. The former "fact" name space is now split into individual "thm" items: names are potentially indexed, such as "foo" for singleton facts, or "bar(1)", "bar(2)", "bar(3)" for multi-facts. Theorem dependencies are now exported as well: this spans an overall dependency graph of internal inferences; it might help to reconstruct the formal structure of theory libraries. See also the module isabelle.Export_Theory in Isabelle/Scala. * Theory export of structured specifications, based on internal declarations of Spec_Rules by packages like 'definition', 'inductive', 'primrec', 'function'. * Old settings variables ISABELLE_PLATFORM and ISABELLE_WINDOWS_PLATFORM have been discontinued -- deprecated since Isabelle2018. * More complete x86_64 platform support on macOS, notably Catalina where old x86 has been discontinued. * Update to GHC stack 2.1.3 with stackage lts-13.19/ghc-8.6.4. * Update to OCaml Opam 2.0.6 (using ocaml 4.05.0 as before). New in Isabelle2019 (June 2019) ------------------------------- *** General *** * The font collection "Isabelle DejaVu" is systematically derived from the existing "DejaVu" fonts, with variants "Sans Mono", "Sans", "Serif" and styles "Normal", "Bold", "Italic/Oblique", "Bold-Italic/Oblique". The DejaVu base fonts are retricted to well-defined Unicode ranges and augmented by special Isabelle symbols, taken from the former "IsabelleText" font (which is no longer provided separately). The line metrics and overall rendering quality is closer to original DejaVu. INCOMPATIBILITY with display configuration expecting the old "IsabelleText" font: use e.g. "Isabelle DejaVu Sans Mono" instead. * The Isabelle fonts render "\" properly as superscript "-1". * Old-style inner comments (* ... *) within the term language are no longer supported (legacy feature in Isabelle2018). * Old-style {* verbatim *} tokens are explicitly marked as legacy feature and will be removed soon. Use \cartouche\ syntax instead, e.g. via "isabelle update_cartouches -t" (available since Isabelle2015). * Infix operators that begin or end with a "*" are now parenthesized without additional spaces, e.g. "(*)" instead of "( * )". Minor INCOMPATIBILITY. * Mixfix annotations may use cartouches instead of old-style double quotes, e.g. (infixl \+\ 60). The command-line tool "isabelle update -u mixfix_cartouches" allows to update existing theory sources automatically. * ML setup commands (e.g. 'setup', 'method_setup', 'parse_translation') need to provide a closed expression -- without trailing semicolon. Minor INCOMPATIBILITY. * Commands 'generate_file', 'export_generated_files', and 'compile_generated_files' support a stateless (PIDE-conformant) model for generated sources and compiled binaries of other languages. The compilation process is managed in Isabelle/ML, and results exported to the session database for further use (e.g. with "isabelle export" or "isabelle build -e"). *** Isabelle/jEdit Prover IDE *** * Fonts for the text area, gutter, GUI elements etc. use the "Isabelle DejaVu" collection by default, which provides uniform rendering quality with the usual Isabelle symbols. Line spacing no longer needs to be adjusted: properties for the old IsabelleText font had "Global Options / Text Area / Extra vertical line spacing (in pixels): -2", it now defaults to 1, but 0 works as well. * The jEdit File Browser is more prominent in the default GUI layout of Isabelle/jEdit: various virtual file-systems provide access to Isabelle resources, notably via "favorites:" (or "Edit Favorites"). * Further markup and rendering for "plain text" (e.g. informal prose) and "raw text" (e.g. verbatim sources). This improves the visual appearance of formal comments inside the term language, or in general for repeated alternation of formal and informal text. * Action "isabelle-export-browser" points the File Browser to the theory exports of the current buffer, based on the "isabelle-export:" virtual file-system. The directory view needs to be reloaded manually to follow ongoing document processing. * Action "isabelle-session-browser" points the File Browser to session information, based on the "isabelle-session:" virtual file-system. Its entries are structured according to chapter / session names, the open operation is redirected to the session ROOT file. * Support for user-defined file-formats via class isabelle.File_Format in Isabelle/Scala (e.g. see isabelle.Bibtex.File_Format), configured via the shell function "isabelle_file_format" in etc/settings (e.g. of an Isabelle component). * System option "jedit_text_overview" allows to disable the text overview column. * Command-line options "-s" and "-u" of "isabelle jedit" override the default for system option "system_heaps" that determines the heap storage directory for "isabelle build". Option "-n" is now clearly separated from option "-s". * The Isabelle/jEdit desktop application uses the same options as "isabelle jedit" for its internal "isabelle build" process: the implicit option "-o system_heaps" (or "-s") has been discontinued. This reduces the potential for surprise wrt. command-line tools. * The official download of the Isabelle/jEdit application already contains heap images for Isabelle/HOL within its main directory: thus the first encounter becomes faster and more robust (e.g. when run from a read-only directory). * Isabelle DejaVu fonts are available with hinting by default, which is relevant for low-resolution displays. This may be disabled via system option "isabelle_fonts_hinted = false" in $ISABELLE_HOME_USER/etc/preferences -- it occasionally yields better results. * OpenJDK 11 has quite different font rendering, with better glyph shapes and improved sub-pixel anti-aliasing. In some situations results might be *worse* than Oracle Java 8, though -- a proper HiDPI / UHD display is recommended. * OpenJDK 11 supports GTK version 2.2 and 3 (according to system property jdk.gtk.version). The factory default is version 3, but ISABELLE_JAVA_SYSTEM_OPTIONS includes "-Djdk.gtk.version=2.2" to make this more conservative (as in Java 8). Depending on the GTK theme configuration, "-Djdk.gtk.version=3" might work better or worse. *** Document preparation *** * Document markers are formal comments of the form \<^marker>\marker_body\ that are stripped from document output: the effect is to modify the semantic presentation context or to emit markup to the PIDE document. Some predefined markers are taken from the Dublin Core Metadata Initiative, e.g. \<^marker>\contributor arg\ or \<^marker>\license arg\ and produce PIDE markup that can be retrieved from the document database. * Old-style command tags %name are re-interpreted as markers with proof-scope \<^marker>\tag (proof) name\ and produce LaTeX environments as before. Potential INCOMPATIBILITY: multiple markers are composed in canonical order, resulting in a reversed list of tags in the presentation context. * Marker \<^marker>\tag name\ does not apply to the proof of a top-level goal statement by default (e.g. 'theorem', 'lemma'). This is a subtle change of semantics wrt. old-style %name. * In Isabelle/jEdit, the string "\tag" may be completed to a "\<^marker>\tag \" template. * Document antiquotation option "cartouche" indicates if the output should be delimited as cartouche; this takes precedence over the analogous option "quotes". * Many document antiquotations are internally categorized as "embedded" and expect one cartouche argument, which is typically used with the \<^control>\cartouche\ notation (e.g. \<^term>\\x y. x\). The cartouche delimiters are stripped in output of the source (antiquotation option "source"), but it is possible to enforce delimiters via option "source_cartouche", e.g. @{term [source_cartouche] \\x y. x\}. *** Isar *** * Implicit cases goal1, goal2, goal3, etc. have been discontinued (legacy feature since Isabelle2016). * More robust treatment of structural errors: begin/end blocks take precedence over goal/proof. This is particularly relevant for the headless PIDE session and server. * Command keywords of kind thy_decl / thy_goal may be more specifically fit into the traditional document model of "definition-statement-proof" via thy_defn / thy_stmt / thy_goal_defn / thy_goal_stmt. *** HOL *** * Command 'export_code' produces output as logical files within the theory context, as well as formal session exports that can be materialized via command-line tools "isabelle export" or "isabelle build -e" (with 'export_files' in the session ROOT). Isabelle/jEdit also provides a virtual file-system "isabelle-export:" that can be explored in the regular file-browser. A 'file_prefix' argument allows to specify an explicit name prefix for the target file (SML, OCaml, Scala) or directory (Haskell); the default is "export" with a consecutive number within each theory. * Command 'export_code': the 'file' argument is now legacy and will be removed soon: writing to the physical file-system is not well-defined in a reactive/parallel application like Isabelle. The empty 'file' argument has been discontinued already: it is superseded by the file-browser in Isabelle/jEdit on "isabelle-export:". Minor INCOMPATIBILITY. * Command 'code_reflect' no longer supports the 'file' argument: it has been superseded by 'file_prefix' for stateless file management as in 'export_code'. Minor INCOMPATIBILITY. * Code generation for OCaml: proper strings are used for literals. Minor INCOMPATIBILITY. * Code generation for OCaml: Zarith supersedes Nums as library for proper integer arithmetic. The library is located via standard invocations of "ocamlfind" (via ISABELLE_OCAMLFIND settings variable). The environment provided by "isabelle ocaml_setup" already contains this tool and the required packages. Minor INCOMPATIBILITY. * Code generation for Haskell: code includes for Haskell must contain proper module frame, nothing is added magically any longer. INCOMPATIBILITY. * Code generation: slightly more conventional syntax for 'code_stmts' antiquotation. Minor INCOMPATIBILITY. * Theory List: the precedence of the list_update operator has changed: "f a [n := x]" now needs to be written "(f a)[n := x]". * The functions \, \, \, \ (not the corresponding binding operators) now have the same precedence as any other prefix function symbol. Minor INCOMPATIBILITY. * Simplified syntax setup for big operators under image. In rare situations, type conversions are not inserted implicitly any longer and need to be given explicitly. Auxiliary abbreviations INFIMUM, SUPREMUM, UNION, INTER should now rarely occur in output and are just retained as migration auxiliary. Abbreviations MINIMUM and MAXIMUM are gone INCOMPATIBILITY. * The simplifier uses image_cong_simp as a congruence rule. The historic and not really well-formed congruence rules INF_cong*, SUP_cong*, are not used by default any longer. INCOMPATIBILITY; consider using declare image_cong_simp [cong del] in extreme situations. * INF_image and SUP_image are no default simp rules any longer. INCOMPATIBILITY, prefer image_comp as simp rule if needed. * Strong congruence rules (with =simp=> in the premises) for constant f are now uniformly called f_cong_simp, in accordance with congruence rules produced for mappers by the datatype package. INCOMPATIBILITY. * Retired lemma card_Union_image; use the simpler card_UN_disjoint instead. INCOMPATIBILITY. * Facts sum_mset.commute and prod_mset.commute have been renamed to sum_mset.swap and prod_mset.swap, similarly to sum.swap and prod.swap. INCOMPATIBILITY. * ML structure Inductive: slightly more conventional naming schema. Minor INCOMPATIBILITY. * ML: Various _global variants of specification tools have been removed. Minor INCOMPATIBILITY, prefer combinators Named_Target.theory_map[_result] to lift specifications to the global theory level. * Theory HOL-Library.Simps_Case_Conv: 'case_of_simps' now supports overlapping and non-exhaustive patterns and handles arbitrarily nested patterns. It uses on the same algorithm as HOL-Library.Code_Lazy, which assumes sequential left-to-right pattern matching. The generated equation no longer tuples the arguments on the right-hand side. INCOMPATIBILITY. * Theory HOL-Library.Multiset: the \# operator now has the same precedence as any other prefix function symbol. * Theory HOL-Library.Cardinal_Notations has been discontinued in favor of the bundle cardinal_syntax (available in theory Main). Minor INCOMPATIBILITY. * Session HOL-Library and HOL-Number_Theory: Exponentiation by squaring, used for computing powers in class "monoid_mult" and modular exponentiation. * Session HOL-Computational_Algebra: Formal Laurent series and overhaul of Formal power series. * Session HOL-Number_Theory: More material on residue rings in Carmichael's function, primitive roots, more properties for "ord". * Session HOL-Analysis: Better organization and much more material at the level of abstract topological spaces. * Session HOL-Algebra: Free abelian groups, etc., ported from HOL Light; algebraic closure of a field by de Vilhena and Baillon. * Session HOL-Homology has been added. It is a port of HOL Light's homology library, with new proofs of "invariance of domain" and related results. * Session HOL-SPARK: .prv files are no longer written to the file-system, but exported to the session database. Results may be retrieved via "isabelle build -e HOL-SPARK-Examples" on the command-line. * Sledgehammer: - The URL for SystemOnTPTP, which is used by remote provers, has been updated. - The machine-learning-based filter MaSh has been optimized to take less time (in most cases). * SMT: reconstruction is now possible using the SMT solver veriT. * Session HOL-Word: * New theory More_Word as comprehensive entrance point. * Merged type class bitss into type class bits. INCOMPATIBILITY. *** ML *** * Command 'generate_file' allows to produce sources for other languages, with antiquotations in the Isabelle context (only the control-cartouche form). The default "cartouche" antiquotation evaluates an ML expression of type string and inlines the result as a string literal of the target language. For example, this works for Haskell as follows: generate_file "Pure.hs" = \ module Isabelle.Pure where allConst, impConst, eqConst :: String allConst = \\<^const_name>\Pure.all\\ impConst = \\<^const_name>\Pure.imp\\ eqConst = \\<^const_name>\Pure.eq\\ \ See also commands 'export_generated_files' and 'compile_generated_files' to use the results. * ML evaluation (notably via command 'ML' or 'ML_file') is subject to option ML_environment to select a named environment, such as "Isabelle" for Isabelle/ML, or "SML" for official Standard ML. * ML antiquotation @{master_dir} refers to the master directory of the underlying theory, i.e. the directory of the theory file. * ML antiquotation @{verbatim} inlines its argument as string literal, preserving newlines literally. The short form \<^verbatim>\abc\ is particularly useful. * Local_Theory.reset is no longer available in user space. Regular definitional packages should use balanced blocks of Local_Theory.open_target versus Local_Theory.close_target instead, or the Local_Theory.subtarget(_result) combinator. Rare INCOMPATIBILITY. * Original PolyML.pointerEq is retained as a convenience for tools that don't use Isabelle/ML (where this is called "pointer_eq"). *** System *** * Update to OpenJDK 11: the current long-term support version of Java. * Update to Poly/ML 5.8 allows to use the native x86_64 platform without the full overhead of 64-bit values everywhere. This special x86_64_32 mode provides up to 16GB ML heap, while program code and stacks are allocated elsewhere. Thus approx. 5 times more memory is available for applications compared to old x86 mode (which is no longer used by Isabelle). The switch to the x86_64 CPU architecture also avoids compatibility problems with Linux and macOS, where 32-bit applications are gradually phased out. * System option "checkpoint" has been discontinued: obsolete thanks to improved memory management in Poly/ML. * System option "system_heaps" determines where to store the session image of "isabelle build" (and other tools using that internally). Former option "-s" is superseded by option "-o system_heaps". INCOMPATIBILITY in command-line syntax. * Session directory $ISABELLE_HOME/src/Tools/Haskell provides some source modules for Isabelle tools implemented in Haskell, notably for Isabelle/PIDE. * The command-line tool "isabelle build -e" retrieves theory exports from the session build database, using 'export_files' in session ROOT entries. * The command-line tool "isabelle update" uses Isabelle/PIDE in batch-mode to update theory sources based on semantic markup produced in Isabelle/ML. Actual updates depend on system options that may be enabled via "-u OPT" (for "update_OPT"), see also $ISABELLE_HOME/etc/options section "Theory update". Theory sessions are specified as in "isabelle dump". * The command-line tool "isabelle update -u control_cartouches" changes antiquotations into control-symbol format (where possible): @{NAME} becomes \<^NAME> and @{NAME ARG} becomes \<^NAME>\ARG\. * Support for Isabelle command-line tools defined in Isabelle/Scala. Instances of class Isabelle_Scala_Tools may be configured via the shell function "isabelle_scala_tools" in etc/settings (e.g. of an Isabelle component). * Isabelle Server command "use_theories" supports "nodes_status_delay" for continuous output of node status information. The time interval is specified in seconds; a negative value means it is disabled (default). * Isabelle Server command "use_theories" terminates more robustly in the presence of structurally broken sources: full consolidation of theories is no longer required. * OCaml tools and libraries are now accesed via ISABELLE_OCAMLFIND, which needs to point to a suitable version of "ocamlfind" (e.g. via OPAM, see below). INCOMPATIBILITY: settings variables ISABELLE_OCAML and ISABELLE_OCAMLC are no longer supported. * Support for managed installations of Glasgow Haskell Compiler and OCaml via the following command-line tools: isabelle ghc_setup isabelle ghc_stack isabelle ocaml_setup isabelle ocaml_opam The global installation state is determined by the following settings (and corresponding directory contents): ISABELLE_STACK_ROOT ISABELLE_STACK_RESOLVER ISABELLE_GHC_VERSION ISABELLE_OPAM_ROOT ISABELLE_OCAML_VERSION After setup, the following Isabelle settings are automatically redirected (overriding existing user settings): ISABELLE_GHC ISABELLE_OCAMLFIND The old meaning of these settings as locally installed executables may be recovered by purging the directories ISABELLE_STACK_ROOT / ISABELLE_OPAM_ROOT, or by resetting these variables in $ISABELLE_HOME_USER/etc/settings. New in Isabelle2018 (August 2018) --------------------------------- *** General *** * Session-qualified theory names are mandatory: it is no longer possible to refer to unqualified theories from the parent session. INCOMPATIBILITY for old developments that have not been updated to Isabelle2017 yet (using the "isabelle imports" tool). * Only the most fundamental theory names are global, usually the entry points to major logic sessions: Pure, Main, Complex_Main, HOLCF, IFOL, FOL, ZF, ZFC etc. INCOMPATIBILITY, need to use qualified names for formerly global "HOL-Probability.Probability" and "HOL-SPARK.SPARK". * Global facts need to be closed: no free variables and no hypotheses. Rare INCOMPATIBILITY. * Facts stemming from locale interpretation are subject to lazy evaluation for improved performance. Rare INCOMPATIBILITY: errors stemming from interpretation morphisms might be deferred and thus difficult to locate; enable system option "strict_facts" temporarily to avoid this. * Marginal comments need to be written exclusively in the new-style form "\ \text\", old ASCII variants like "-- {* ... *}" are no longer supported. INCOMPATIBILITY, use the command-line tool "isabelle update_comments" to update existing theory files. * Old-style inner comments (* ... *) within the term language are legacy and will be discontinued soon: use formal comments "\ \...\" or "\<^cancel>\...\" instead. * The "op " syntax for infix operators has been replaced by "()". If begins or ends with a "*", there needs to be a space between the "*" and the corresponding parenthesis. INCOMPATIBILITY, use the command-line tool "isabelle update_op" to convert theory and ML files to the new syntax. Because it is based on regular expression matching, the result may need a bit of manual postprocessing. Invoking "isabelle update_op" converts all files in the current directory (recursively). In case you want to exclude conversion of ML files (because the tool frequently also converts ML's "op" syntax), use option "-m". * Theory header 'abbrevs' specifications need to be separated by 'and'. INCOMPATIBILITY. * Command 'external_file' declares the formal dependency on the given file name, such that the Isabelle build process knows about it, but without specific Prover IDE management. * Session ROOT entries no longer allow specification of 'files'. Rare INCOMPATIBILITY, use command 'external_file' within a proper theory context. * Session root directories may be specified multiple times: each accessible ROOT file is processed only once. This facilitates specification of $ISABELLE_HOME_USER/ROOTS or command-line options like -d or -D for "isabelle build" and "isabelle jedit". Example: isabelle build -D '~~/src/ZF' * The command 'display_drafts' has been discontinued. INCOMPATIBILITY, use action "isabelle.draft" (or "print") in Isabelle/jEdit instead. * In HTML output, the Isabelle symbol "\" is rendered as explicit Unicode hyphen U+2010, to avoid unclear meaning of the old "soft hyphen" U+00AD. Rare INCOMPATIBILITY, e.g. copy-paste of historic Isabelle HTML output. *** Isabelle/jEdit Prover IDE *** * The command-line tool "isabelle jedit" provides more flexible options for session management: - option -R builds an auxiliary logic image with all theories from other sessions that are not already present in its parent - option -S is like -R, with a focus on the selected session and its descendants (this reduces startup time for big projects like AFP) - option -A specifies an alternative ancestor session for options -R and -S - option -i includes additional sessions into the name-space of theories Examples: isabelle jedit -R HOL-Number_Theory isabelle jedit -R HOL-Number_Theory -A HOL isabelle jedit -d '$AFP' -S Formal_SSA -A HOL isabelle jedit -d '$AFP' -S Formal_SSA -A HOL-Analysis isabelle jedit -d '$AFP' -S Formal_SSA -A HOL-Analysis -i CryptHOL * PIDE markup for session ROOT files: allows to complete session names, follow links to theories and document files etc. * Completion supports theory header imports, using theory base name. E.g. "Prob" may be completed to "HOL-Probability.Probability". * Named control symbols (without special Unicode rendering) are shown as bold-italic keyword. This is particularly useful for the short form of antiquotations with control symbol: \<^name>\argument\. The action "isabelle.antiquoted_cartouche" turns an antiquotation with 0 or 1 arguments into this format. * Completion provides templates for named symbols with arguments, e.g. "\ \ARGUMENT\" or "\<^emph>\ARGUMENT\". * Slightly more parallel checking, notably for high priority print functions (e.g. State output). * The view title is set dynamically, according to the Isabelle distribution and the logic session name. The user can override this via set-view-title (stored persistently in $JEDIT_SETTINGS/perspective.xml). * System options "spell_checker_include" and "spell_checker_exclude" supersede former "spell_checker_elements" to determine regions of text that are subject to spell-checking. Minor INCOMPATIBILITY. * Action "isabelle.preview" is able to present more file formats, notably bibtex database files and ML files. * Action "isabelle.draft" is similar to "isabelle.preview", but shows a plain-text document draft. Both are available via the menu "Plugins / Isabelle". * When loading text files, the Isabelle symbols encoding UTF-8-Isabelle is only used if there is no conflict with existing Unicode sequences in the file. Otherwise, the fallback encoding is plain UTF-8 and Isabelle symbols remain in literal \ form. This avoids accidental loss of Unicode content when saving the file. * Bibtex database files (.bib) are semantically checked. * Update to jedit-5.5.0, the latest release. *** Isabelle/VSCode Prover IDE *** * HTML preview of theories and other file-formats similar to Isabelle/jEdit. * Command-line tool "isabelle vscode_server" accepts the same options -A, -R, -S, -i for session selection as "isabelle jedit". This is relevant for isabelle.args configuration settings in VSCode. The former option -A (explore all known session files) has been discontinued: it is enabled by default, unless option -S is used to focus on a particular spot in the session structure. INCOMPATIBILITY. *** Document preparation *** * Formal comments work uniformly in outer syntax, inner syntax (term language), Isabelle/ML and some other embedded languages of Isabelle. See also "Document comments" in the isar-ref manual. The following forms are supported: - marginal text comment: \ \\\ - canceled source: \<^cancel>\\\ - raw LaTeX: \<^latex>\\\ * Outside of the inner theory body, the default presentation context is theory Pure. Thus elementary antiquotations may be used in markup commands (e.g. 'chapter', 'section', 'text') and formal comments. * System option "document_tags" specifies alternative command tags. This is occasionally useful to control the global visibility of commands via session options (e.g. in ROOT). * Document markup commands ('section', 'text' etc.) are implicitly tagged as "document" and visible by default. This avoids the application of option "document_tags" to these commands. * Isabelle names are mangled into LaTeX macro names to allow the full identifier syntax with underscore, prime, digits. This is relevant for antiquotations in control symbol notation, e.g. \<^const_name> becomes \isactrlconstUNDERSCOREname. * Document preparation with skip_proofs option now preserves the content more accurately: only terminal proof steps ('by' etc.) are skipped. * Document antiquotation @{theory name} requires the long session-qualified theory name: this is what users reading the text normally need to import. * Document antiquotation @{session name} checks and prints the given session name verbatim. * Document antiquotation @{cite} now checks the given Bibtex entries against the Bibtex database files -- only in batch-mode session builds. * Command-line tool "isabelle document" has been re-implemented in Isabelle/Scala, with simplified arguments and explicit errors from the latex and bibtex process. Minor INCOMPATIBILITY. * Session ROOT entry: empty 'document_files' means there is no document for this session. There is no need to specify options [document = false] anymore. *** Isar *** * Command 'interpret' no longer exposes resulting theorems as literal facts, notably for the \prop\ notation or the "fact" proof method. This improves modularity of proofs and scalability of locale interpretation. Rare INCOMPATIBILITY, need to refer to explicitly named facts instead (e.g. use 'find_theorems' or 'try' to figure this out). * The old 'def' command has been discontinued (legacy since Isbelle2016-1). INCOMPATIBILITY, use 'define' instead -- usually with object-logic equality or equivalence. *** Pure *** * The inner syntax category "sort" now includes notation "_" for the dummy sort: it is effectively ignored in type-inference. * Rewrites clauses (keyword 'rewrites') were moved into the locale expression syntax, where they are part of locale instances. In interpretation commands rewrites clauses now need to occur before 'for' and 'defines'. Rare INCOMPATIBILITY; definitions immediately subject to rewriting may need to be pulled up into the surrounding theory. * For 'rewrites' clauses, if activating a locale instance fails, fall back to reading the clause first. This helps avoid qualification of locale instances where the qualifier's sole purpose is avoiding duplicate constant declarations. * Proof method "simp" now supports a new modifier "flip:" followed by a list of theorems. Each of these theorems is removed from the simpset (without warning if it is not there) and the symmetric version of the theorem (i.e. lhs and rhs exchanged) is added to the simpset. For "auto" and friends the modifier is "simp flip:". *** HOL *** * Sledgehammer: bundled version of "vampire" (for non-commercial users) helps to avoid fragility of "remote_vampire" service. * Clarified relationship of characters, strings and code generation: - Type "char" is now a proper datatype of 8-bit values. - Conversions "nat_of_char" and "char_of_nat" are gone; use more general conversions "of_char" and "char_of" with suitable type constraints instead. - The zero character is just written "CHR 0x00", not "0" any longer. - Type "String.literal" (for code generation) is now isomorphic to lists of 7-bit (ASCII) values; concrete values can be written as "STR ''...''" for sequences of printable characters and "STR 0x..." for one single ASCII code point given as hexadecimal numeral. - Type "String.literal" supports concatenation "... + ..." for all standard target languages. - Theory HOL-Library.Code_Char is gone; study the explanations concerning "String.literal" in the tutorial on code generation to get an idea how target-language string literals can be converted to HOL string values and vice versa. - Session Imperative-HOL: operation "raise" directly takes a value of type "String.literal" as argument, not type "string". INCOMPATIBILITY. * Code generation: Code generation takes an explicit option "case_insensitive" to accomodate case-insensitive file systems. * Abstract bit operations as part of Main: push_bit, take_bit, drop_bit. * New, more general, axiomatization of complete_distrib_lattice. The former axioms: "sup x (Inf X) = Inf (sup x ` X)" and "inf x (Sup X) = Sup (inf x ` X)" are replaced by: "Inf (Sup ` A) <= Sup (Inf ` {f ` A | f . (! Y \ A . f Y \ Y)})" The instantiations of sets and functions as complete_distrib_lattice are moved to Hilbert_Choice.thy because their proofs need the Hilbert choice operator. The dual of this property is also proved in theory HOL.Hilbert_Choice. * New syntax for the minimum/maximum of a function over a finite set: MIN x\A. B and even MIN x. B (only useful for finite types), also MAX. * Clarifed theorem names: Min.antimono ~> Min.subset_imp Max.antimono ~> Max.subset_imp Minor INCOMPATIBILITY. * SMT module: - The 'smt_oracle' option is now necessary when using the 'smt' method with a solver other than Z3. INCOMPATIBILITY. - The encoding to first-order logic is now more complete in the presence of higher-order quantifiers. An 'smt_explicit_application' option has been added to control this. INCOMPATIBILITY. * Facts sum.commute(_restrict) and prod.commute(_restrict) renamed to sum.swap(_restrict) and prod.swap(_restrict), to avoid name clashes on interpretation of abstract locales. INCOMPATIBILITY. * Predicate coprime is now a real definition, not a mere abbreviation. INCOMPATIBILITY. * Predicate pairwise_coprime abolished, use "pairwise coprime" instead. INCOMPATIBILITY. * The relator rel_filter on filters has been strengthened to its canonical categorical definition with better properties. INCOMPATIBILITY. * Generalized linear algebra involving linear, span, dependent, dim from type class real_vector to locales module and vector_space. Renamed: span_inc ~> span_superset span_superset ~> span_base span_eq ~> span_eq_iff INCOMPATIBILITY. * Class linordered_semiring_1 covers zero_less_one also, ruling out pathologic instances. Minor INCOMPATIBILITY. * Theory HOL.List: functions "sorted_wrt" and "sorted" now compare every element in a list to all following elements, not just the next one. * Theory HOL.List syntax: - filter-syntax "[x <- xs. P]" is no longer output syntax, but only input syntax - list comprehension syntax now supports tuple patterns in "pat <- xs" * Theory Map: "empty" must now be qualified as "Map.empty". * Removed nat-int transfer machinery. Rare INCOMPATIBILITY. * Fact mod_mult_self4 (on nat) renamed to Suc_mod_mult_self3, to avoid clash with fact mod_mult_self4 (on more generic semirings). INCOMPATIBILITY. * Eliminated some theorem aliasses: even_times_iff ~> even_mult_iff mod_2_not_eq_zero_eq_one_nat ~> not_mod_2_eq_0_eq_1 even_of_nat ~> even_int_iff INCOMPATIBILITY. * Eliminated some theorem duplicate variations: - dvd_eq_mod_eq_0_numeral can be replaced by dvd_eq_mod_eq_0 - mod_Suc_eq_Suc_mod can be replaced by mod_Suc - mod_Suc_eq_Suc_mod [symmetrict] can be replaced by mod_simps - mod_eq_0_iff can be replaced by mod_eq_0_iff_dvd and dvd_def - the witness of mod_eqD can be given directly as "_ div _" INCOMPATIBILITY. * Classical setup: Assumption "m mod d = 0" (for m d :: nat) is no longer aggresively destroyed to "\q. m = d * q". INCOMPATIBILITY, adding "elim!: dvd" to classical proof methods in most situations restores broken proofs. * Theory HOL-Library.Conditional_Parametricity provides command 'parametric_constant' for proving parametricity of non-recursive definitions. For constants that are not fully parametric the command will infer conditions on relations (e.g., bi_unique, bi_total, or type class conditions such as "respects 0") sufficient for parametricity. See theory HOL-ex.Conditional_Parametricity_Examples for some examples. * Theory HOL-Library.Code_Lazy provides a new preprocessor for the code generator to generate code for algebraic types with lazy evaluation semantics even in call-by-value target languages. See the theories HOL-ex.Code_Lazy_Demo and HOL-Codegenerator_Test.Code_Lazy_Test for some examples. * Theory HOL-Library.Landau_Symbols has been moved here from AFP. * Theory HOL-Library.Old_Datatype no longer provides the legacy command 'old_datatype'. INCOMPATIBILITY. * Theory HOL-Computational_Algebra.Polynomial_Factorial does not provide instances of rat, real, complex as factorial rings etc. Import HOL-Computational_Algebra.Field_as_Ring explicitly in case of need. INCOMPATIBILITY. * Session HOL-Algebra: renamed (^) to [^] to avoid conflict with new infix/prefix notation. * Session HOL-Algebra: revamped with much new material. The set of isomorphisms between two groups is now denoted iso rather than iso_set. INCOMPATIBILITY. * Session HOL-Analysis: the Arg function now respects the same interval as Ln, namely (-pi,pi]; the old Arg function has been renamed Arg2pi. INCOMPATIBILITY. * Session HOL-Analysis: the functions zorder, zer_poly, porder and pol_poly have been redefined. All related lemmas have been reworked. INCOMPATIBILITY. * Session HOL-Analysis: infinite products, Moebius functions, the Riemann mapping theorem, the Vitali covering theorem, change-of-variables results for integration and measures. * Session HOL-Real_Asymp: proof method "real_asymp" proves asymptotics or real-valued functions (limits, "Big-O", etc.) automatically. See also ~~/src/HOL/Real_Asymp/Manual for some documentation. * Session HOL-Types_To_Sets: more tool support (unoverload_type combines internalize_sorts and unoverload) and larger experimental application (type based linear algebra transferred to linear algebra on subspaces). *** ML *** * Operation Export.export emits theory exports (arbitrary blobs), which are stored persistently in the session build database. * Command 'ML_export' exports ML toplevel bindings to the global bootstrap environment of the ML process. This allows ML evaluation without a formal theory context, e.g. in command-line tools like "isabelle process". *** System *** * Mac OS X 10.10 Yosemite is now the baseline version; Mavericks is no longer supported. * Linux and Windows/Cygwin is for x86_64 only, old 32bit platform support has been discontinued. * Java runtime is for x86_64 only. Corresponding Isabelle settings have been renamed to ISABELLE_TOOL_JAVA_OPTIONS and JEDIT_JAVA_OPTIONS, instead of former 32/64 variants. INCOMPATIBILITY. * Old settings ISABELLE_PLATFORM and ISABELLE_WINDOWS_PLATFORM should be phased out due to unclear preference of 32bit vs. 64bit architecture. Explicit GNU bash expressions are now preferred, for example (with quotes): #Posix executables (Unix or Cygwin), with preference for 64bit "${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}" #native Windows or Unix executables, with preference for 64bit "${ISABELLE_WINDOWS_PLATFORM64:-${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}}" #native Windows (32bit) or Unix executables (preference for 64bit) "${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}" * Command-line tool "isabelle build" supports new options: - option -B NAME: include session NAME and all descendants - option -S: only observe changes of sources, not heap images - option -f: forces a fresh build * Command-line tool "isabelle build" options -c -x -B refer to descendants wrt. the session parent or import graph. Subtle INCOMPATIBILITY: options -c -x used to refer to the session parent graph only. * Command-line tool "isabelle build" takes "condition" options with the corresponding environment values into account, when determining the up-to-date status of a session. * The command-line tool "dump" dumps information from the cumulative PIDE session database: many sessions may be loaded into a given logic image, results from all loaded theories are written to the output directory. * Command-line tool "isabelle imports -I" also reports actual session imports. This helps to minimize the session dependency graph. * The command-line tool "export" and 'export_files' in session ROOT entries retrieve theory exports from the session build database. * The command-line tools "isabelle server" and "isabelle client" provide access to the Isabelle Server: it supports responsive session management and concurrent use of theories, based on Isabelle/PIDE infrastructure. See also the "system" manual. * The command-line tool "isabelle update_comments" normalizes formal comments in outer syntax as follows: \ \text\ (whith a single space to approximate the appearance in document output). This is more specific than former "isabelle update_cartouches -c": the latter tool option has been discontinued. * The command-line tool "isabelle mkroot" now always produces a document outline: its options have been adapted accordingly. INCOMPATIBILITY. * The command-line tool "isabelle mkroot -I" initializes a Mercurial repository for the generated session files. * Settings ISABELLE_HEAPS + ISABELLE_BROWSER_INFO (or ISABELLE_HEAPS_SYSTEM + ISABELLE_BROWSER_INFO_SYSTEM in "system build mode") determine the directory locations of the main build artefacts -- instead of hard-wired directories in ISABELLE_HOME_USER (or ISABELLE_HOME). * Settings ISABELLE_PATH and ISABELLE_OUTPUT have been discontinued: heap images and session databases are always stored in $ISABELLE_HEAPS/$ML_IDENTIFIER (command-line default) or $ISABELLE_HEAPS_SYSTEM/$ML_IDENTIFIER (main Isabelle application or "isabelle jedit -s" or "isabelle build -s"). * ISABELLE_LATEX and ISABELLE_PDFLATEX now include platform-specific options for improved error reporting. Potential INCOMPATIBILITY with unusual LaTeX installations, may have to adapt these settings. * Update to Poly/ML 5.7.1 with slightly improved performance and PIDE markup for identifier bindings. It now uses The GNU Multiple Precision Arithmetic Library (libgmp) on all platforms, notably Mac OS X with 32/64 bit. New in Isabelle2017 (October 2017) ---------------------------------- *** General *** * Experimental support for Visual Studio Code (VSCode) as alternative Isabelle/PIDE front-end, see also https://marketplace.visualstudio.com/items?itemName=makarius.Isabelle2017 VSCode is a new type of application that continues the concepts of "programmer's editor" and "integrated development environment" towards fully semantic editing and debugging -- in a relatively light-weight manner. Thus it fits nicely on top of the Isabelle/PIDE infrastructure. Technically, VSCode is based on the Electron application framework (Node.js + Chromium browser + V8), which is implemented in JavaScript and TypeScript, while Isabelle/VSCode mainly consists of Isabelle/Scala modules around a Language Server implementation. * Theory names are qualified by the session name that they belong to. This affects imports, but not the theory name space prefix (which is just the theory base name as before). In order to import theories from other sessions, the ROOT file format provides a new 'sessions' keyword. In contrast, a theory that is imported in the old-fashioned manner via an explicit file-system path belongs to the current session, and might cause theory name conflicts later on. Theories that are imported from other sessions are excluded from the current session document. The command-line tool "isabelle imports" helps to update theory imports. * The main theory entry points for some non-HOL sessions have changed, to avoid confusion with the global name "Main" of the session HOL. This leads to the follow renamings: CTT/Main.thy ~> CTT/CTT.thy ZF/Main.thy ~> ZF/ZF.thy ZF/Main_ZF.thy ~> ZF/ZF.thy ZF/Main_ZFC.thy ~> ZF/ZFC.thy ZF/ZF.thy ~> ZF/ZF_Base.thy INCOMPATIBILITY. * Commands 'alias' and 'type_alias' introduce aliases for constants and type constructors, respectively. This allows adhoc changes to name-space accesses within global or local theory contexts, e.g. within a 'bundle'. * Document antiquotations @{prf} and @{full_prf} output proof terms (again) in the same way as commands 'prf' and 'full_prf'. * Computations generated by the code generator can be embedded directly into ML, alongside with @{code} antiquotations, using the following antiquotations: @{computation ... terms: ... datatypes: ...} : ((term -> term) -> 'ml option -> 'a) -> Proof.context -> term -> 'a @{computation_conv ... terms: ... datatypes: ...} : (Proof.context -> 'ml -> conv) -> Proof.context -> conv @{computation_check terms: ... datatypes: ...} : Proof.context -> conv See src/HOL/ex/Computations.thy, src/HOL/Decision_Procs/Commutative_Ring.thy and src/HOL/Decision_Procs/Reflective_Field.thy for examples and the tutorial on code generation. *** Prover IDE -- Isabelle/Scala/jEdit *** * Session-qualified theory imports allow the Prover IDE to process arbitrary theory hierarchies independently of the underlying logic session image (e.g. option "isabelle jedit -l"), but the directory structure needs to be known in advance (e.g. option "isabelle jedit -d" or a line in the file $ISABELLE_HOME_USER/ROOTS). * The PIDE document model maintains file content independently of the status of jEdit editor buffers. Reloading jEdit buffers no longer causes changes of formal document content. Theory dependencies are always resolved internally, without the need for corresponding editor buffers. The system option "jedit_auto_load" has been discontinued: it is effectively always enabled. * The Theories dockable provides a "Purge" button, in order to restrict the document model to theories that are required for open editor buffers. * The Theories dockable indicates the overall status of checking of each entry. When all forked tasks of a theory are finished, the border is painted with thick lines; remaining errors in this situation are represented by a different border color. * Automatic indentation is more careful to avoid redundant spaces in intermediate situations. Keywords are indented after input (via typed characters or completion); see also option "jedit_indent_input". * Action "isabelle.preview" opens an HTML preview of the current theory document in the default web browser. * Command-line invocation "isabelle jedit -R -l LOGIC" opens the ROOT entry of the specified logic session in the editor, while its parent is used for formal checking. * The main Isabelle/jEdit plugin may be restarted manually (using the jEdit Plugin Manager), as long as the "Isabelle Base" plugin remains enabled at all times. * Update to current jedit-5.4.0. *** Pure *** * Deleting the last code equations for a particular function using [code del] results in function with no equations (runtime abort) rather than an unimplemented function (generation time abort). Use explicit [[code drop:]] to enforce the latter. Minor INCOMPATIBILITY. * Proper concept of code declarations in code.ML: - Regular code declarations act only on the global theory level, being ignored with warnings if syntactically malformed. - Explicitly global code declarations yield errors if syntactically malformed. - Default code declarations are silently ignored if syntactically malformed. Minor INCOMPATIBILITY. * Clarified and standardized internal data bookkeeping of code declarations: history of serials allows to track potentially non-monotonous declarations appropriately. Minor INCOMPATIBILITY. *** HOL *** * The Nunchaku model finder is now part of "Main". * SMT module: - A new option, 'smt_nat_as_int', has been added to translate 'nat' to 'int' and benefit from the SMT solver's theory reasoning. It is disabled by default. - The legacy module "src/HOL/Library/Old_SMT.thy" has been removed. - Several small issues have been rectified in the 'smt' command. * (Co)datatype package: The 'size_gen_o_map' lemma is no longer generated for datatypes with type class annotations. As a result, the tactic that derives it no longer fails on nested datatypes. Slight INCOMPATIBILITY. * Command and antiquotation "value" with modified default strategy: terms without free variables are always evaluated using plain evaluation only, with no fallback on normalization by evaluation. Minor INCOMPATIBILITY. * Theories "GCD" and "Binomial" are already included in "Main" (instead of "Complex_Main"). * Constant "surj" is a full input/output abbreviation (again). Minor INCOMPATIBILITY. * Dropped aliasses RangeP, DomainP for Rangep, Domainp respectively. INCOMPATIBILITY. * Renamed ii to imaginary_unit in order to free up ii as a variable name. The syntax \ remains available. INCOMPATIBILITY. * Dropped abbreviations transP, antisymP, single_valuedP; use constants transp, antisymp, single_valuedp instead. INCOMPATIBILITY. * Constant "subseq" in Topological_Spaces has been removed -- it is subsumed by "strict_mono". Some basic lemmas specific to "subseq" have been renamed accordingly, e.g. "subseq_o" -> "strict_mono_o" etc. * Theory List: "sublist" renamed to "nths" in analogy with "nth", and "sublisteq" renamed to "subseq". Minor INCOMPATIBILITY. * Theory List: new generic function "sorted_wrt". * Named theorems mod_simps covers various congruence rules concerning mod, replacing former zmod_simps. INCOMPATIBILITY. * Swapped orientation of congruence rules mod_add_left_eq, mod_add_right_eq, mod_add_eq, mod_mult_left_eq, mod_mult_right_eq, mod_mult_eq, mod_minus_eq, mod_diff_left_eq, mod_diff_right_eq, mod_diff_eq. INCOMPATIBILITY. * Generalized some facts: measure_induct_rule measure_induct zminus_zmod ~> mod_minus_eq zdiff_zmod_left ~> mod_diff_left_eq zdiff_zmod_right ~> mod_diff_right_eq zmod_eq_dvd_iff ~> mod_eq_dvd_iff INCOMPATIBILITY. * Algebraic type class hierarchy of euclidean (semi)rings in HOL: euclidean_(semi)ring, euclidean_(semi)ring_cancel, unique_euclidean_(semi)ring; instantiation requires provision of a euclidean size. * Theory "HOL-Number_Theory.Euclidean_Algorithm" has been reworked: - Euclidean induction is available as rule eucl_induct. - Constants Euclidean_Algorithm.gcd, Euclidean_Algorithm.lcm, Euclidean_Algorithm.Gcd and Euclidean_Algorithm.Lcm allow easy instantiation of euclidean (semi)rings as GCD (semi)rings. - Coefficients obtained by extended euclidean algorithm are available as "bezout_coefficients". INCOMPATIBILITY. * Theory "Number_Theory.Totient" introduces basic notions about Euler's totient function previously hidden as solitary example in theory Residues. Definition changed so that "totient 1 = 1" in agreement with the literature. Minor INCOMPATIBILITY. * New styles in theory "HOL-Library.LaTeXsugar": - "dummy_pats" for printing equations with "_" on the lhs; - "eta_expand" for printing eta-expanded terms. * Theory "HOL-Library.Permutations": theorem bij_swap_ompose_bij has been renamed to bij_swap_compose_bij. INCOMPATIBILITY. * New theory "HOL-Library.Going_To_Filter" providing the "f going_to F" filter for describing points x such that f(x) is in the filter F. * Theory "HOL-Library.Formal_Power_Series": constants X/E/L/F have been renamed to fps_X/fps_exp/fps_ln/fps_hypergeo to avoid polluting the name space. INCOMPATIBILITY. * Theory "HOL-Library.FinFun" has been moved to AFP (again). INCOMPATIBILITY. * Theory "HOL-Library.FuncSet": some old and rarely used ASCII replacement syntax has been removed. INCOMPATIBILITY, standard syntax with symbols should be used instead. The subsequent commands help to reproduce the old forms, e.g. to simplify porting old theories: syntax (ASCII) "_PiE" :: "pttrn \ 'a set \ 'b set \ ('a \ 'b) set" ("(3PIE _:_./ _)" 10) "_Pi" :: "pttrn \ 'a set \ 'b set \ ('a \ 'b) set" ("(3PI _:_./ _)" 10) "_lam" :: "pttrn \ 'a set \ 'a \ 'b \ ('a \ 'b)" ("(3%_:_./ _)" [0,0,3] 3) * Theory "HOL-Library.Multiset": the simprocs on subsets operators of multisets have been renamed: msetless_cancel_numerals ~> msetsubset_cancel msetle_cancel_numerals ~> msetsubset_eq_cancel INCOMPATIBILITY. * Theory "HOL-Library.Pattern_Aliases" provides input and output syntax for pattern aliases as known from Haskell, Scala and ML. * Theory "HOL-Library.Uprod" formalizes the type of unordered pairs. * Session HOL-Analysis: more material involving arcs, paths, covering spaces, innessential maps, retracts, infinite products, simplicial complexes. Baire Category theorem. Major results include the Jordan Curve Theorem and the Great Picard Theorem. * Session HOL-Algebra has been extended by additional lattice theory: the Knaster-Tarski fixed point theorem and Galois Connections. * Sessions HOL-Computational_Algebra and HOL-Number_Theory: new notions of squarefreeness, n-th powers, and prime powers. * Session "HOL-Computional_Algebra" covers many previously scattered theories, notably Euclidean_Algorithm, Factorial_Ring, Formal_Power_Series, Fraction_Field, Fundamental_Theorem_Algebra, Normalized_Fraction, Polynomial_FPS, Polynomial, Primes. Minor INCOMPATIBILITY. *** System *** * Isabelle/Scala: the SQL module supports access to relational databases, either as plain file (SQLite) or full-scale server (PostgreSQL via local port or remote ssh connection). * Results of "isabelle build" are recorded as SQLite database (i.e. "Application File Format" in the sense of https://www.sqlite.org/appfileformat.html). This allows systematic access via operations from module Sessions.Store in Isabelle/Scala. * System option "parallel_proofs" is 1 by default (instead of more aggressive 2). This requires less heap space and avoids burning parallel CPU cycles, while full subproof parallelization is enabled for repeated builds (according to parallel_subproofs_threshold). * System option "record_proofs" allows to change the global Proofterm.proofs variable for a session. Regular values are are 0, 1, 2; a negative value means the current state in the ML heap image remains unchanged. * Isabelle settings variable ISABELLE_SCALA_BUILD_OPTIONS has been renamed to ISABELLE_SCALAC_OPTIONS. Rare INCOMPATIBILITY. * Isabelle settings variables ISABELLE_WINDOWS_PLATFORM, ISABELLE_WINDOWS_PLATFORM32, ISABELLE_WINDOWS_PLATFORM64 indicate the native Windows platform (independently of the Cygwin installation). This is analogous to ISABELLE_PLATFORM, ISABELLE_PLATFORM32, ISABELLE_PLATFORM64. * Command-line tool "isabelle build_docker" builds a Docker image from the Isabelle application bundle for Linux. See also https://hub.docker.com/r/makarius/isabelle * Command-line tool "isabelle vscode_server" provides a Language Server Protocol implementation, e.g. for the Visual Studio Code editor. It serves as example for alternative PIDE front-ends. * Command-line tool "isabelle imports" helps to maintain theory imports wrt. session structure. Examples for the main Isabelle distribution: isabelle imports -I -a isabelle imports -U -a isabelle imports -U -i -a isabelle imports -M -a -d '~~/src/Benchmarks' New in Isabelle2016-1 (December 2016) ------------------------------------- *** General *** * Splitter in proof methods "simp", "auto" and friends: - The syntax "split add" has been discontinued, use plain "split", INCOMPATIBILITY. - For situations with many conditional or case expressions, there is an alternative splitting strategy that can be much faster. It is selected by writing "split!" instead of "split". It applies safe introduction and elimination rules after each split rule. As a result the subgoal may be split into several subgoals. * Command 'bundle' provides a local theory target to define a bundle from the body of specification commands (such as 'declare', 'declaration', 'notation', 'lemmas', 'lemma'). For example: bundle foo begin declare a [simp] declare b [intro] end * Command 'unbundle' is like 'include', but works within a local theory context. Unlike "context includes ... begin", the effect of 'unbundle' on the target context persists, until different declarations are given. * Simplified outer syntax: uniform category "name" includes long identifiers. Former "xname" / "nameref" / "name reference" has been discontinued. * Embedded content (e.g. the inner syntax of types, terms, props) may be delimited uniformly via cartouches. This works better than old-fashioned quotes when sub-languages are nested. * Mixfix annotations support general block properties, with syntax "(\x=a y=b z \\". Notable property names are "indent", "consistent", "unbreakable", "markup". The existing notation "(DIGITS" is equivalent to "(\indent=DIGITS\". The former notation "(00" for unbreakable blocks is superseded by "(\unbreabable\" --- rare INCOMPATIBILITY. * Proof method "blast" is more robust wrt. corner cases of Pure statements without object-logic judgment. * Commands 'prf' and 'full_prf' are somewhat more informative (again): proof terms are reconstructed and cleaned from administrative thm nodes. * Code generator: config option "code_timing" triggers measurements of different phases of code generation. See src/HOL/ex/Code_Timing.thy for examples. * Code generator: implicits in Scala (stemming from type class instances) are generated into companion object of corresponding type class, to resolve some situations where ambiguities may occur. * Solve direct: option "solve_direct_strict_warnings" gives explicit warnings for lemma statements with trivial proofs. *** Prover IDE -- Isabelle/Scala/jEdit *** * More aggressive flushing of machine-generated input, according to system option editor_generated_input_delay (in addition to existing editor_input_delay for regular user edits). This may affect overall PIDE reactivity and CPU usage. * Syntactic indentation according to Isabelle outer syntax. Action "indent-lines" (shortcut C+i) indents the current line according to command keywords and some command substructure. Action "isabelle.newline" (shortcut ENTER) indents the old and the new line according to command keywords only; see also option "jedit_indent_newline". * Semantic indentation for unstructured proof scripts ('apply' etc.) via number of subgoals. This requires information of ongoing document processing and may thus lag behind, when the user is editing too quickly; see also option "jedit_script_indent" and "jedit_script_indent_limit". * Refined folding mode "isabelle" based on Isar syntax: 'next' and 'qed' are treated as delimiters for fold structure; 'begin' and 'end' structure of theory specifications is treated as well. * Command 'proof' provides information about proof outline with cases, e.g. for proof methods "cases", "induct", "goal_cases". * Completion templates for commands involving "begin ... end" blocks, e.g. 'context', 'notepad'. * Sidekick parser "isabelle-context" shows nesting of context blocks according to 'begin' and 'end' structure. * Highlighting of entity def/ref positions wrt. cursor. * Action "isabelle.select-entity" (shortcut CS+ENTER) selects all occurrences of the formal entity at the caret position. This facilitates systematic renaming. * PIDE document markup works across multiple Isar commands, e.g. the results established at the end of a proof are properly identified in the theorem statement. * Cartouche abbreviations work both for " and ` to accomodate typical situations where old ASCII notation may be updated. * Dockable window "Symbols" also provides access to 'abbrevs' from the outer syntax of the current theory buffer. This provides clickable syntax templates, including entries with empty abbrevs name (which are inaccessible via keyboard completion). * IDE support for the Isabelle/Pure bootstrap process, with the following independent stages: src/Pure/ROOT0.ML src/Pure/ROOT.ML src/Pure/Pure.thy src/Pure/ML_Bootstrap.thy The ML ROOT files act like quasi-theories in the context of theory ML_Bootstrap: this allows continuous checking of all loaded ML files. The theory files are presented with a modified header to import Pure from the running Isabelle instance. Results from changed versions of each stage are *not* propagated to the next stage, and isolated from the actual Isabelle/Pure that runs the IDE itself. The sequential dependencies of the above files are only observed for batch build. * Isabelle/ML and Standard ML files are presented in Sidekick with the tree structure of section headings: this special comment format is described in "implementation" chapter 0, e.g. (*** section ***). * Additional abbreviations for syntactic completion may be specified within the theory header as 'abbrevs'. The theory syntax for 'keywords' has been simplified accordingly: optional abbrevs need to go into the new 'abbrevs' section. * Global abbreviations via $ISABELLE_HOME/etc/abbrevs and $ISABELLE_HOME_USER/etc/abbrevs are no longer supported. Minor INCOMPATIBILITY, use 'abbrevs' within theory header instead. * Action "isabelle.keymap-merge" asks the user to resolve pending Isabelle keymap changes that are in conflict with the current jEdit keymap; non-conflicting changes are always applied implicitly. This action is automatically invoked on Isabelle/jEdit startup and thus increases chances that users see new keyboard shortcuts when re-using old keymaps. * ML and document antiquotations for file-systems paths are more uniform and diverse: @{path NAME} -- no file-system check @{file NAME} -- check for plain file @{dir NAME} -- check for directory Minor INCOMPATIBILITY, former uses of @{file} and @{file_unchecked} may have to be changed. *** Document preparation *** * New symbol \, e.g. for temporal operator. * New document and ML antiquotation @{locale} for locales, similar to existing antiquotation @{class}. * Mixfix annotations support delimiters like \<^control>\cartouche\ -- this allows special forms of document output. * Raw LaTeX output now works via \<^latex>\...\ instead of raw control symbol \<^raw:...>. INCOMPATIBILITY, notably for LaTeXsugar.thy and its derivatives. * \<^raw:...> symbols are no longer supported. * Old 'header' command is no longer supported (legacy since Isabelle2015). *** Isar *** * Many specification elements support structured statements with 'if' / 'for' eigen-context, e.g. 'axiomatization', 'abbreviation', 'definition', 'inductive', 'function'. * Toplevel theorem statements support eigen-context notation with 'if' / 'for' (in postfix), which corresponds to 'assumes' / 'fixes' in the traditional long statement form (in prefix). Local premises are called "that" or "assms", respectively. Empty premises are *not* bound in the context: INCOMPATIBILITY. * Command 'define' introduces a local (non-polymorphic) definition, with optional abstraction over local parameters. The syntax resembles 'definition' and 'obtain'. It fits better into the Isar language than old 'def', which is now a legacy feature. * Command 'obtain' supports structured statements with 'if' / 'for' context. * Command '\' is an alias for 'sorry', with different typesetting. E.g. to produce proof holes in examples and documentation. * The defining position of a literal fact \prop\ is maintained more carefully, and made accessible as hyperlink in the Prover IDE. * Commands 'finally' and 'ultimately' used to expose the result as literal fact: this accidental behaviour has been discontinued. Rare INCOMPATIBILITY, use more explicit means to refer to facts in Isar. * Command 'axiomatization' has become more restrictive to correspond better to internal axioms as singleton facts with mandatory name. Minor INCOMPATIBILITY. * Proof methods may refer to the main facts via the dynamic fact "method_facts". This is particularly useful for Eisbach method definitions. * Proof method "use" allows to modify the main facts of a given method expression, e.g. (use facts in simp) (use facts in \simp add: ...\) * The old proof method "default" has been removed (legacy since Isabelle2016). INCOMPATIBILITY, use "standard" instead. *** Pure *** * Pure provides basic versions of proof methods "simp" and "simp_all" that only know about meta-equality (==). Potential INCOMPATIBILITY in theory imports that merge Pure with e.g. Main of Isabelle/HOL: the order is relevant to avoid confusion of Pure.simp vs. HOL.simp. * The command 'unfolding' and proof method "unfold" include a second stage where given equations are passed through the attribute "abs_def" before rewriting. This ensures that definitions are fully expanded, regardless of the actual parameters that are provided. Rare INCOMPATIBILITY in some corner cases: use proof method (simp only:) instead, or declare [[unfold_abs_def = false]] in the proof context. * Type-inference improves sorts of newly introduced type variables for the object-logic, using its base sort (i.e. HOL.type for Isabelle/HOL). Thus terms like "f x" or "\x. P x" without any further syntactic context produce x::'a::type in HOL instead of x::'a::{} in Pure. Rare INCOMPATIBILITY, need to provide explicit type constraints for Pure types where this is really intended. *** HOL *** * New proof method "argo" using the built-in Argo solver based on SMT technology. The method can be used to prove goals of quantifier-free propositional logic, goals based on a combination of quantifier-free propositional logic with equality, and goals based on a combination of quantifier-free propositional logic with linear real arithmetic including min/max/abs. See HOL/ex/Argo_Examples.thy for examples. * The new "nunchaku" command integrates the Nunchaku model finder. The tool is experimental. See ~~/src/HOL/Nunchaku/Nunchaku.thy for details. * Metis: The problem encoding has changed very slightly. This might break existing proofs. INCOMPATIBILITY. * Sledgehammer: - The MaSh relevance filter is now faster than before. - Produce syntactically correct Vampire 4.0 problem files. * (Co)datatype package: - New commands for defining corecursive functions and reasoning about them in "~~/src/HOL/Library/BNF_Corec.thy": 'corec', 'corecursive', 'friend_of_corec', and 'corecursion_upto'; and 'corec_unique' proof method. See 'isabelle doc corec'. - The predicator :: ('a \ bool) \ 'a F \ bool is now a first-class citizen in bounded natural functors. - 'primrec' now allows nested calls through the predicator in addition to the map function. - 'bnf' automatically discharges reflexive proof obligations. - 'bnf' outputs a slightly modified proof obligation expressing rel in terms of map and set (not giving a specification for rel makes this one reflexive). - 'bnf' outputs a new proof obligation expressing pred in terms of set (not giving a specification for pred makes this one reflexive). INCOMPATIBILITY: manual 'bnf' declarations may need adjustment. - Renamed lemmas: rel_prod_apply ~> rel_prod_inject pred_prod_apply ~> pred_prod_inject INCOMPATIBILITY. - The "size" plugin has been made compatible again with locales. - The theorems about "rel" and "set" may have a slightly different (but equivalent) form. INCOMPATIBILITY. * The 'coinductive' command produces a proper coinduction rule for mutual coinductive predicates. This new rule replaces the old rule, which exposed details of the internal fixpoint construction and was hard to use. INCOMPATIBILITY. * New abbreviations for negated existence (but not bounded existence): \x. P x \ \ (\x. P x) \!x. P x \ \ (\!x. P x) * The print mode "HOL" for ASCII syntax of binders "!", "?", "?!", "@" has been removed for output. It is retained for input only, until it is eliminated altogether. * The unique existence quantifier no longer provides 'binder' syntax, but uses syntax translations (as for bounded unique existence). Thus iterated quantification \!x y. P x y with its slightly confusing sequential meaning \!x. \!y. P x y is no longer possible. Instead, pattern abstraction admits simultaneous unique existence \!(x, y). P x y (analogous to existing notation \!(x, y)\A. P x y). Potential INCOMPATIBILITY in rare situations. * Conventional syntax "%(). t" for unit abstractions. Slight syntactic INCOMPATIBILITY. * Renamed constants and corresponding theorems: setsum ~> sum setprod ~> prod listsum ~> sum_list listprod ~> prod_list INCOMPATIBILITY. * Sligthly more standardized theorem names: sgn_times ~> sgn_mult sgn_mult' ~> Real_Vector_Spaces.sgn_mult divide_zero_left ~> div_0 zero_mod_left ~> mod_0 divide_zero ~> div_by_0 divide_1 ~> div_by_1 nonzero_mult_divide_cancel_left ~> nonzero_mult_div_cancel_left div_mult_self1_is_id ~> nonzero_mult_div_cancel_left nonzero_mult_divide_cancel_right ~> nonzero_mult_div_cancel_right div_mult_self2_is_id ~> nonzero_mult_div_cancel_right is_unit_divide_mult_cancel_left ~> is_unit_div_mult_cancel_left is_unit_divide_mult_cancel_right ~> is_unit_div_mult_cancel_right mod_div_equality ~> div_mult_mod_eq mod_div_equality2 ~> mult_div_mod_eq mod_div_equality3 ~> mod_div_mult_eq mod_div_equality4 ~> mod_mult_div_eq minus_div_eq_mod ~> minus_div_mult_eq_mod minus_div_eq_mod2 ~> minus_mult_div_eq_mod minus_mod_eq_div ~> minus_mod_eq_div_mult minus_mod_eq_div2 ~> minus_mod_eq_mult_div div_mod_equality' ~> minus_mod_eq_div_mult [symmetric] mod_div_equality' ~> minus_div_mult_eq_mod [symmetric] zmod_zdiv_equality ~> mult_div_mod_eq [symmetric] zmod_zdiv_equality' ~> minus_div_mult_eq_mod [symmetric] Divides.mult_div_cancel ~> minus_mod_eq_mult_div [symmetric] mult_div_cancel ~> minus_mod_eq_mult_div [symmetric] zmult_div_cancel ~> minus_mod_eq_mult_div [symmetric] div_1 ~> div_by_Suc_0 mod_1 ~> mod_by_Suc_0 INCOMPATIBILITY. * New type class "idom_abs_sgn" specifies algebraic properties of sign and absolute value functions. Type class "sgn_if" has disappeared. Slight INCOMPATIBILITY. * Dedicated syntax LENGTH('a) for length of types. * Characters (type char) are modelled as finite algebraic type corresponding to {0..255}. - Logical representation: * 0 is instantiated to the ASCII zero character. * All other characters are represented as "Char n" with n being a raw numeral expression less than 256. * Expressions of the form "Char n" with n greater than 255 are non-canonical. - Printing and parsing: * Printable characters are printed and parsed as "CHR ''\''" (as before). * The ASCII zero character is printed and parsed as "0". * All other canonical characters are printed as "CHR 0xXX" with XX being the hexadecimal character code. "CHR n" is parsable for every numeral expression n. * Non-canonical characters have no special syntax and are printed as their logical representation. - Explicit conversions from and to the natural numbers are provided as char_of_nat, nat_of_char (as before). - The auxiliary nibble type has been discontinued. INCOMPATIBILITY. * Type class "div" with operation "mod" renamed to type class "modulo" with operation "modulo", analogously to type class "divide". This eliminates the need to qualify any of those names in the presence of infix "mod" syntax. INCOMPATIBILITY. * Statements and proofs of Knaster-Tarski fixpoint combinators lfp/gfp have been clarified. The fixpoint properties are lfp_fixpoint, its symmetric lfp_unfold (as before), and the duals for gfp. Auxiliary items for the proof (lfp_lemma2 etc.) are no longer exported, but can be easily recovered by composition with eq_refl. Minor INCOMPATIBILITY. * Constant "surj" is a mere input abbreviation, to avoid hiding an equation in term output. Minor INCOMPATIBILITY. * Command 'code_reflect' accepts empty constructor lists for datatypes, which renders those abstract effectively. * Command 'export_code' checks given constants for abstraction violations: a small guarantee that given constants specify a safe interface for the generated code. * Code generation for Scala: ambiguous implicts in class diagrams are spelt out explicitly. * Static evaluators (Code_Evaluation.static_* in Isabelle/ML) rely on explicitly provided auxiliary definitions for required type class dictionaries rather than half-working magic. INCOMPATIBILITY, see the tutorial on code generation for details. * Theory Set_Interval: substantial new theorems on indexed sums and products. * Locale bijection establishes convenient default simp rules such as "inv f (f a) = a" for total bijections. * Abstract locales semigroup, abel_semigroup, semilattice, semilattice_neutr, ordering, ordering_top, semilattice_order, semilattice_neutr_order, comm_monoid_set, semilattice_set, semilattice_neutr_set, semilattice_order_set, semilattice_order_neutr_set monoid_list, comm_monoid_list, comm_monoid_list_set, comm_monoid_mset, comm_monoid_fun use boldified syntax uniformly that does not clash with corresponding global syntax. INCOMPATIBILITY. * Former locale lifting_syntax is now a bundle, which is easier to include in a local context or theorem statement, e.g. "context includes lifting_syntax begin ... end". Minor INCOMPATIBILITY. * Some old / obsolete theorems have been renamed / removed, potential INCOMPATIBILITY. nat_less_cases -- removed, use linorder_cases instead inv_image_comp -- removed, use image_inv_f_f instead image_surj_f_inv_f ~> image_f_inv_f * Some theorems about groups and orders have been generalised from groups to semi-groups that are also monoids: le_add_same_cancel1 le_add_same_cancel2 less_add_same_cancel1 less_add_same_cancel2 add_le_same_cancel1 add_le_same_cancel2 add_less_same_cancel1 add_less_same_cancel2 * Some simplifications theorems about rings have been removed, since superseeded by a more general version: less_add_cancel_left_greater_zero ~> less_add_same_cancel1 less_add_cancel_right_greater_zero ~> less_add_same_cancel2 less_eq_add_cancel_left_greater_eq_zero ~> le_add_same_cancel1 less_eq_add_cancel_right_greater_eq_zero ~> le_add_same_cancel2 less_eq_add_cancel_left_less_eq_zero ~> add_le_same_cancel1 less_eq_add_cancel_right_less_eq_zero ~> add_le_same_cancel2 less_add_cancel_left_less_zero ~> add_less_same_cancel1 less_add_cancel_right_less_zero ~> add_less_same_cancel2 INCOMPATIBILITY. * Renamed split_if -> if_split and split_if_asm -> if_split_asm to resemble the f.split naming convention, INCOMPATIBILITY. * Added class topological_monoid. * The following theorems have been renamed: setsum_left_distrib ~> sum_distrib_right setsum_right_distrib ~> sum_distrib_left INCOMPATIBILITY. * Compound constants INFIMUM and SUPREMUM are mere abbreviations now. INCOMPATIBILITY. * "Gcd (f ` A)" and "Lcm (f ` A)" are printed with optional comprehension-like syntax analogously to "Inf (f ` A)" and "Sup (f ` A)". * Class semiring_Lcd merged into semiring_Gcd. INCOMPATIBILITY. * The type class ordered_comm_monoid_add is now called ordered_cancel_comm_monoid_add. A new type class ordered_comm_monoid_add is introduced as the combination of ordered_ab_semigroup_add + comm_monoid_add. INCOMPATIBILITY. * Introduced the type classes canonically_ordered_comm_monoid_add and dioid. * Introduced the type class ordered_ab_semigroup_monoid_add_imp_le. When instantiating linordered_semiring_strict and ordered_ab_group_add, an explicit instantiation of ordered_ab_semigroup_monoid_add_imp_le might be required. INCOMPATIBILITY. * Dropped various legacy fact bindings, whose replacements are often of a more general type also: lcm_left_commute_nat ~> lcm.left_commute lcm_left_commute_int ~> lcm.left_commute gcd_left_commute_nat ~> gcd.left_commute gcd_left_commute_int ~> gcd.left_commute gcd_greatest_iff_nat ~> gcd_greatest_iff gcd_greatest_iff_int ~> gcd_greatest_iff coprime_dvd_mult_nat ~> coprime_dvd_mult coprime_dvd_mult_int ~> coprime_dvd_mult zpower_numeral_even ~> power_numeral_even gcd_mult_cancel_nat ~> gcd_mult_cancel gcd_mult_cancel_int ~> gcd_mult_cancel div_gcd_coprime_nat ~> div_gcd_coprime div_gcd_coprime_int ~> div_gcd_coprime zpower_numeral_odd ~> power_numeral_odd zero_less_int_conv ~> of_nat_0_less_iff gcd_greatest_nat ~> gcd_greatest gcd_greatest_int ~> gcd_greatest coprime_mult_nat ~> coprime_mult coprime_mult_int ~> coprime_mult lcm_commute_nat ~> lcm.commute lcm_commute_int ~> lcm.commute int_less_0_conv ~> of_nat_less_0_iff gcd_commute_nat ~> gcd.commute gcd_commute_int ~> gcd.commute Gcd_insert_nat ~> Gcd_insert Gcd_insert_int ~> Gcd_insert of_int_int_eq ~> of_int_of_nat_eq lcm_least_nat ~> lcm_least lcm_least_int ~> lcm_least lcm_assoc_nat ~> lcm.assoc lcm_assoc_int ~> lcm.assoc int_le_0_conv ~> of_nat_le_0_iff int_eq_0_conv ~> of_nat_eq_0_iff Gcd_empty_nat ~> Gcd_empty Gcd_empty_int ~> Gcd_empty gcd_assoc_nat ~> gcd.assoc gcd_assoc_int ~> gcd.assoc zero_zle_int ~> of_nat_0_le_iff lcm_dvd2_nat ~> dvd_lcm2 lcm_dvd2_int ~> dvd_lcm2 lcm_dvd1_nat ~> dvd_lcm1 lcm_dvd1_int ~> dvd_lcm1 gcd_zero_nat ~> gcd_eq_0_iff gcd_zero_int ~> gcd_eq_0_iff gcd_dvd2_nat ~> gcd_dvd2 gcd_dvd2_int ~> gcd_dvd2 gcd_dvd1_nat ~> gcd_dvd1 gcd_dvd1_int ~> gcd_dvd1 int_numeral ~> of_nat_numeral lcm_ac_nat ~> ac_simps lcm_ac_int ~> ac_simps gcd_ac_nat ~> ac_simps gcd_ac_int ~> ac_simps abs_int_eq ~> abs_of_nat zless_int ~> of_nat_less_iff zdiff_int ~> of_nat_diff zadd_int ~> of_nat_add int_mult ~> of_nat_mult int_Suc ~> of_nat_Suc inj_int ~> inj_of_nat int_1 ~> of_nat_1 int_0 ~> of_nat_0 Lcm_empty_nat ~> Lcm_empty Lcm_empty_int ~> Lcm_empty Lcm_insert_nat ~> Lcm_insert Lcm_insert_int ~> Lcm_insert comp_fun_idem_gcd_nat ~> comp_fun_idem_gcd comp_fun_idem_gcd_int ~> comp_fun_idem_gcd comp_fun_idem_lcm_nat ~> comp_fun_idem_lcm comp_fun_idem_lcm_int ~> comp_fun_idem_lcm Lcm_eq_0 ~> Lcm_eq_0_I Lcm0_iff ~> Lcm_0_iff Lcm_dvd_int ~> Lcm_least divides_mult_nat ~> divides_mult divides_mult_int ~> divides_mult lcm_0_nat ~> lcm_0_right lcm_0_int ~> lcm_0_right lcm_0_left_nat ~> lcm_0_left lcm_0_left_int ~> lcm_0_left dvd_gcd_D1_nat ~> dvd_gcdD1 dvd_gcd_D1_int ~> dvd_gcdD1 dvd_gcd_D2_nat ~> dvd_gcdD2 dvd_gcd_D2_int ~> dvd_gcdD2 coprime_dvd_mult_iff_nat ~> coprime_dvd_mult_iff coprime_dvd_mult_iff_int ~> coprime_dvd_mult_iff realpow_minus_mult ~> power_minus_mult realpow_Suc_le_self ~> power_Suc_le_self dvd_Gcd, dvd_Gcd_nat, dvd_Gcd_int removed in favour of Gcd_greatest INCOMPATIBILITY. * Renamed HOL/Quotient_Examples/FSet.thy to HOL/Quotient_Examples/Quotient_FSet.thy INCOMPATIBILITY. * Session HOL-Library: theory FinFun bundles "finfun_syntax" and "no_finfun_syntax" allow to control optional syntax in local contexts; this supersedes former theory FinFun_Syntax. INCOMPATIBILITY, e.g. use "unbundle finfun_syntax" to imitate import of "~~/src/HOL/Library/FinFun_Syntax". * Session HOL-Library: theory Multiset_Permutations (executably) defines the set of permutations of a given set or multiset, i.e. the set of all lists that contain every element of the carrier (multi-)set exactly once. * Session HOL-Library: multiset membership is now expressed using set_mset rather than count. - Expressions "count M a > 0" and similar simplify to membership by default. - Converting between "count M a = 0" and non-membership happens using equations count_eq_zero_iff and not_in_iff. - Rules count_inI and in_countE obtain facts of the form "count M a = n" from membership. - Rules count_in_diffI and in_diff_countE obtain facts of the form "count M a = n + count N a" from membership on difference sets. INCOMPATIBILITY. * Session HOL-Library: theory LaTeXsugar uses new-style "dummy_pats" for displaying equations in functional programming style --- variables present on the left-hand but not on the righ-hand side are replaced by underscores. * Session HOL-Library: theory Combinator_PER provides combinator to build partial equivalence relations from a predicate and an equivalence relation. * Session HOL-Library: theory Perm provides basic facts about almost everywhere fix bijections. * Session HOL-Library: theory Normalized_Fraction allows viewing an element of a field of fractions as a normalized fraction (i.e. a pair of numerator and denominator such that the two are coprime and the denominator is normalized wrt. unit factors). * Session HOL-NSA has been renamed to HOL-Nonstandard_Analysis. * Session HOL-Multivariate_Analysis has been renamed to HOL-Analysis. * Session HOL-Analysis: measure theory has been moved here from HOL-Probability. When importing HOL-Analysis some theorems need additional name spaces prefixes due to name clashes. INCOMPATIBILITY. * Session HOL-Analysis: more complex analysis including Cauchy's inequality, Liouville theorem, open mapping theorem, maximum modulus principle, Residue theorem, Schwarz Lemma. * Session HOL-Analysis: Theory of polyhedra: faces, extreme points, polytopes, and the Krein–Milman Minkowski theorem. * Session HOL-Analysis: Numerous results ported from the HOL Light libraries: homeomorphisms, continuous function extensions, invariance of domain. * Session HOL-Probability: the type of emeasure and nn_integral was changed from ereal to ennreal, INCOMPATIBILITY. emeasure :: 'a measure \ 'a set \ ennreal nn_integral :: 'a measure \ ('a \ ennreal) \ ennreal * Session HOL-Probability: Code generation and QuickCheck for Probability Mass Functions. * Session HOL-Probability: theory Random_Permutations contains some theory about choosing a permutation of a set uniformly at random and folding over a list in random order. * Session HOL-Probability: theory SPMF formalises discrete subprobability distributions. * Session HOL-Library: the names of multiset theorems have been normalised to distinguish which ordering the theorems are about mset_less_eqI ~> mset_subset_eqI mset_less_insertD ~> mset_subset_insertD mset_less_eq_count ~> mset_subset_eq_count mset_less_diff_self ~> mset_subset_diff_self mset_le_exists_conv ~> mset_subset_eq_exists_conv mset_le_mono_add_right_cancel ~> mset_subset_eq_mono_add_right_cancel mset_le_mono_add_left_cancel ~> mset_subset_eq_mono_add_left_cancel mset_le_mono_add ~> mset_subset_eq_mono_add mset_le_add_left ~> mset_subset_eq_add_left mset_le_add_right ~> mset_subset_eq_add_right mset_le_single ~> mset_subset_eq_single mset_le_multiset_union_diff_commute ~> mset_subset_eq_multiset_union_diff_commute diff_le_self ~> diff_subset_eq_self mset_leD ~> mset_subset_eqD mset_lessD ~> mset_subsetD mset_le_insertD ~> mset_subset_eq_insertD mset_less_of_empty ~> mset_subset_of_empty mset_less_size ~> mset_subset_size wf_less_mset_rel ~> wf_subset_mset_rel count_le_replicate_mset_le ~> count_le_replicate_mset_subset_eq mset_remdups_le ~> mset_remdups_subset_eq ms_lesseq_impl ~> subset_eq_mset_impl Some functions have been renamed: ms_lesseq_impl -> subset_eq_mset_impl * HOL-Library: multisets are now ordered with the multiset ordering #\# ~> \ #\# ~> < le_multiset ~> less_eq_multiset less_multiset ~> le_multiset INCOMPATIBILITY. * Session HOL-Library: the prefix multiset_order has been discontinued: the theorems can be directly accessed. As a consequence, the lemmas "order_multiset" and "linorder_multiset" have been discontinued, and the interpretations "multiset_linorder" and "multiset_wellorder" have been replaced by instantiations. INCOMPATIBILITY. * Session HOL-Library: some theorems about the multiset ordering have been renamed: le_multiset_def ~> less_eq_multiset_def less_multiset_def ~> le_multiset_def less_eq_imp_le_multiset ~> subset_eq_imp_le_multiset mult_less_not_refl ~> mset_le_not_refl mult_less_trans ~> mset_le_trans mult_less_not_sym ~> mset_le_not_sym mult_less_asym ~> mset_le_asym mult_less_irrefl ~> mset_le_irrefl union_less_mono2{,1,2} ~> union_le_mono2{,1,2} le_multiset\<^sub>H\<^sub>O ~> less_eq_multiset\<^sub>H\<^sub>O le_multiset_total ~> less_eq_multiset_total less_multiset_right_total ~> subset_eq_imp_le_multiset le_multiset_empty_left ~> less_eq_multiset_empty_left le_multiset_empty_right ~> less_eq_multiset_empty_right less_multiset_empty_right ~> le_multiset_empty_left less_multiset_empty_left ~> le_multiset_empty_right union_less_diff_plus ~> union_le_diff_plus ex_gt_count_imp_less_multiset ~> ex_gt_count_imp_le_multiset less_multiset_plus_left_nonempty ~> le_multiset_plus_left_nonempty le_multiset_plus_right_nonempty ~> le_multiset_plus_right_nonempty INCOMPATIBILITY. * Session HOL-Library: the lemma mset_map has now the attribute [simp]. INCOMPATIBILITY. * Session HOL-Library: some theorems about multisets have been removed. INCOMPATIBILITY, use the following replacements: le_multiset_plus_plus_left_iff ~> add_less_cancel_right less_multiset_plus_plus_left_iff ~> add_less_cancel_right le_multiset_plus_plus_right_iff ~> add_less_cancel_left less_multiset_plus_plus_right_iff ~> add_less_cancel_left add_eq_self_empty_iff ~> add_cancel_left_right mset_subset_add_bothsides ~> subset_mset.add_less_cancel_right mset_less_add_bothsides ~> subset_mset.add_less_cancel_right mset_le_add_bothsides ~> subset_mset.add_less_cancel_right empty_inter ~> subset_mset.inf_bot_left inter_empty ~> subset_mset.inf_bot_right empty_sup ~> subset_mset.sup_bot_left sup_empty ~> subset_mset.sup_bot_right bdd_below_multiset ~> subset_mset.bdd_above_bot subset_eq_empty ~> subset_mset.le_zero_eq le_empty ~> subset_mset.le_zero_eq mset_subset_empty_nonempty ~> subset_mset.zero_less_iff_neq_zero mset_less_empty_nonempty ~> subset_mset.zero_less_iff_neq_zero * Session HOL-Library: some typeclass constraints about multisets have been reduced from ordered or linordered to preorder. Multisets have the additional typeclasses order_bot, no_top, ordered_ab_semigroup_add_imp_le, ordered_cancel_comm_monoid_add, linordered_cancel_ab_semigroup_add, and ordered_ab_semigroup_monoid_add_imp_le. INCOMPATIBILITY. * Session HOL-Library: there are some new simplification rules about multisets, the multiset ordering, and the subset ordering on multisets. INCOMPATIBILITY. * Session HOL-Library: the subset ordering on multisets has now the interpretations ordered_ab_semigroup_monoid_add_imp_le and bounded_lattice_bot. INCOMPATIBILITY. * Session HOL-Library, theory Multiset: single has been removed in favor of add_mset that roughly corresponds to Set.insert. Some theorems have removed or changed: single_not_empty ~> add_mset_not_empty or empty_not_add_mset fold_mset_insert ~> fold_mset_add_mset image_mset_insert ~> image_mset_add_mset union_single_eq_diff multi_self_add_other_not_self diff_single_eq_union INCOMPATIBILITY. * Session HOL-Library, theory Multiset: some theorems have been changed to use add_mset instead of single: mset_add multi_self_add_other_not_self diff_single_eq_union union_single_eq_diff union_single_eq_member add_eq_conv_diff insert_noteq_member add_eq_conv_ex multi_member_split multiset_add_sub_el_shuffle mset_subset_eq_insertD mset_subset_insertD insert_subset_eq_iff insert_union_subset_iff multi_psub_of_add_self inter_add_left1 inter_add_left2 inter_add_right1 inter_add_right2 sup_union_left1 sup_union_left2 sup_union_right1 sup_union_right2 size_eq_Suc_imp_eq_union multi_nonempty_split mset_insort mset_update mult1I less_add mset_zip_take_Cons_drop_twice rel_mset_Zero msed_map_invL msed_map_invR msed_rel_invL msed_rel_invR le_multiset_right_total multiset_induct multiset_induct2_size multiset_induct2 INCOMPATIBILITY. * Session HOL-Library, theory Multiset: the definitions of some constants have changed to use add_mset instead of adding a single element: image_mset mset replicate_mset mult1 pred_mset rel_mset' mset_insort INCOMPATIBILITY. * Session HOL-Library, theory Multiset: due to the above changes, the attributes of some multiset theorems have been changed: insert_DiffM [] ~> [simp] insert_DiffM2 [simp] ~> [] diff_add_mset_swap [simp] fold_mset_add_mset [simp] diff_diff_add [simp] (for multisets only) diff_cancel [simp] ~> [] count_single [simp] ~> [] set_mset_single [simp] ~> [] size_multiset_single [simp] ~> [] size_single [simp] ~> [] image_mset_single [simp] ~> [] mset_subset_eq_mono_add_right_cancel [simp] ~> [] mset_subset_eq_mono_add_left_cancel [simp] ~> [] fold_mset_single [simp] ~> [] subset_eq_empty [simp] ~> [] empty_sup [simp] ~> [] sup_empty [simp] ~> [] inter_empty [simp] ~> [] empty_inter [simp] ~> [] INCOMPATIBILITY. * Session HOL-Library, theory Multiset: the order of the variables in the second cases of multiset_induct, multiset_induct2_size, multiset_induct2 has been changed (e.g. Add A a ~> Add a A). INCOMPATIBILITY. * Session HOL-Library, theory Multiset: there is now a simplification procedure on multisets. It mimics the behavior of the procedure on natural numbers. INCOMPATIBILITY. * Session HOL-Library, theory Multiset: renamed sums and products of multisets: msetsum ~> sum_mset msetprod ~> prod_mset * Session HOL-Library, theory Multiset: the notation for intersection and union of multisets have been changed: #\ ~> \# #\ ~> \# INCOMPATIBILITY. * Session HOL-Library, theory Multiset: the lemma one_step_implies_mult_aux on multisets has been removed, use one_step_implies_mult instead. INCOMPATIBILITY. * Session HOL-Library: theory Complete_Partial_Order2 provides reasoning support for monotonicity and continuity in chain-complete partial orders and about admissibility conditions for fixpoint inductions. * Session HOL-Library: theory Library/Polynomial contains also derivation of polynomials (formerly in Library/Poly_Deriv) but not gcd/lcm on polynomials over fields. This has been moved to a separate theory Library/Polynomial_GCD_euclidean.thy, to pave way for a possible future different type class instantiation for polynomials over factorial rings. INCOMPATIBILITY. * Session HOL-Library: theory Sublist provides function "prefixes" with the following renaming prefixeq -> prefix prefix -> strict_prefix suffixeq -> suffix suffix -> strict_suffix Added theory of longest common prefixes. * Session HOL-Number_Theory: algebraic foundation for primes: Generalisation of predicate "prime" and introduction of predicates "prime_elem", "irreducible", a "prime_factorization" function, and the "factorial_ring" typeclass with instance proofs for nat, int, poly. Some theorems now have different names, most notably "prime_def" is now "prime_nat_iff". INCOMPATIBILITY. * Session Old_Number_Theory has been removed, after porting remaining theories. * Session HOL-Types_To_Sets provides an experimental extension of Higher-Order Logic to allow translation of types to sets. *** ML *** * Integer.gcd and Integer.lcm use efficient operations from the Poly/ML library (notably for big integers). Subtle change of semantics: Integer.gcd and Integer.lcm both normalize the sign, results are never negative. This coincides with the definitions in HOL/GCD.thy. INCOMPATIBILITY. * Structure Rat for rational numbers is now an integral part of Isabelle/ML, with special notation @int/nat or @int for numerals (an abbreviation for antiquotation @{Pure.rat argument}) and ML pretty printing. Standard operations on type Rat.rat are provided via ad-hoc overloading of + - * / < <= > >= ~ abs. INCOMPATIBILITY, need to use + instead of +/ etc. Moreover, exception Rat.DIVZERO has been superseded by General.Div. * ML antiquotation @{path} is superseded by @{file}, which ensures that the argument is a plain file. Minor INCOMPATIBILITY. * Antiquotation @{make_string} is available during Pure bootstrap -- with approximative output quality. * Low-level ML system structures (like PolyML and RunCall) are no longer exposed to Isabelle/ML user-space. Potential INCOMPATIBILITY. * The ML function "ML" provides easy access to run-time compilation. This is particularly useful for conditional compilation, without requiring separate files. * Option ML_exception_debugger controls detailed exception trace via the Poly/ML debugger. Relevant ML modules need to be compiled beforehand with ML_file_debug, or with ML_file and option ML_debugger enabled. Note debugger information requires consirable time and space: main Isabelle/HOL with full debugger support may need ML_system_64. * Local_Theory.restore has been renamed to Local_Theory.reset to emphasize its disruptive impact on the cumulative context, notably the scope of 'private' or 'qualified' names. Note that Local_Theory.reset is only appropriate when targets are managed, e.g. starting from a global theory and returning to it. Regular definitional packages should use balanced blocks of Local_Theory.open_target versus Local_Theory.close_target instead. Rare INCOMPATIBILITY. * Structure TimeLimit (originally from the SML/NJ library) has been replaced by structure Timeout, with slightly different signature. INCOMPATIBILITY. * Discontinued cd and pwd operations, which are not well-defined in a multi-threaded environment. Note that files are usually located relatively to the master directory of a theory (see also File.full_path). Potential INCOMPATIBILITY. * Binding.empty_atts supersedes Thm.empty_binding and Attrib.empty_binding. Minor INCOMPATIBILITY. *** System *** * SML/NJ and old versions of Poly/ML are no longer supported. * Poly/ML heaps now follow the hierarchy of sessions, and thus require much less disk space. * The Isabelle ML process is now managed directly by Isabelle/Scala, and shell scripts merely provide optional command-line access. In particular: . Scala module ML_Process to connect to the raw ML process, with interaction via stdin/stdout/stderr or in batch mode; . command-line tool "isabelle console" as interactive wrapper; . command-line tool "isabelle process" as batch mode wrapper. * The executable "isabelle_process" has been discontinued. Tools and prover front-ends should use ML_Process or Isabelle_Process in Isabelle/Scala. INCOMPATIBILITY. * New command-line tool "isabelle process" supports ML evaluation of literal expressions (option -e) or files (option -f) in the context of a given heap image. Errors lead to premature exit of the ML process with return code 1. * The command-line tool "isabelle build" supports option -N for cyclic shuffling of NUMA CPU nodes. This may help performance tuning on Linux servers with separate CPU/memory modules. * System option "threads" (for the size of the Isabelle/ML thread farm) is also passed to the underlying ML runtime system as --gcthreads, unless there is already a default provided via ML_OPTIONS settings. * System option "checkpoint" helps to fine-tune the global heap space management of isabelle build. This is relevant for big sessions that may exhaust the small 32-bit address space of the ML process (which is used by default). * System option "profiling" specifies the mode for global ML profiling in "isabelle build". Possible values are "time", "allocations". The command-line tool "isabelle profiling_report" helps to digest the resulting log files. * System option "ML_process_policy" specifies an optional command prefix for the underlying ML process, e.g. to control CPU affinity on multiprocessor systems. The "isabelle jedit" tool allows to override the implicit default via option -p. * Command-line tool "isabelle console" provides option -r to help to bootstrapping Isabelle/Pure interactively. * Command-line tool "isabelle yxml" has been discontinued. INCOMPATIBILITY, use operations from the modules "XML" and "YXML" in Isabelle/ML or Isabelle/Scala. * Many Isabelle tools that require a Java runtime system refer to the settings ISABELLE_TOOL_JAVA_OPTIONS32 / ISABELLE_TOOL_JAVA_OPTIONS64, depending on the underlying platform. The settings for "isabelle build" ISABELLE_BUILD_JAVA_OPTIONS32 / ISABELLE_BUILD_JAVA_OPTIONS64 have been discontinued. Potential INCOMPATIBILITY. * The Isabelle system environment always ensures that the main executables are found within the shell search $PATH: "isabelle" and "isabelle_scala_script". * Isabelle tools may consist of .scala files: the Scala compiler is invoked on the spot. The source needs to define some object that extends Isabelle_Tool.Body. * File.bash_string, File.bash_path etc. represent Isabelle/ML and Isabelle/Scala strings authentically within GNU bash. This is useful to produce robust shell scripts under program control, without worrying about spaces or special characters. Note that user output works via Path.print (ML) or Path.toString (Scala). INCOMPATIBILITY, the old (and less versatile) operations File.shell_quote, File.shell_path etc. have been discontinued. * The isabelle_java executable allows to run a Java process within the name space of Java and Scala components that are bundled with Isabelle, but without the Isabelle settings environment. * Isabelle/Scala: the SSH module supports ssh and sftp connections, for remote command-execution and file-system access. This resembles operations from module File and Isabelle_System to some extent. Note that Path specifications need to be resolved remotely via ssh.remote_path instead of File.standard_path: the implicit process environment is different, Isabelle settings are not available remotely. * Isabelle/Scala: the Mercurial module supports repositories via the regular hg command-line interface. The repositroy clone and working directory may reside on a local or remote file-system (via ssh connection). New in Isabelle2016 (February 2016) ----------------------------------- *** General *** * Eisbach is now based on Pure instead of HOL. Objects-logics may import either the theory ~~/src/HOL/Eisbach/Eisbach (for HOL etc.) or ~~/src/HOL/Eisbach/Eisbach_Old_Appl_Syntax (for FOL, ZF etc.). Note that the HOL-Eisbach session located in ~~/src/HOL/Eisbach/ contains further examples that do require HOL. * Better resource usage on all platforms (Linux, Windows, Mac OS X) for both Isabelle/ML and Isabelle/Scala. Slightly reduced heap space usage. * Former "xsymbols" syntax with Isabelle symbols is used by default, without any special print mode. Important ASCII replacement syntax remains available under print mode "ASCII", but less important syntax has been removed (see below). * Support for more arrow symbols, with rendering in LaTeX and Isabelle fonts: \ \ \ \ \ \. * Special notation \ for the first implicit 'structure' in the context has been discontinued. Rare INCOMPATIBILITY, use explicit structure name instead, notably in indexed notation with block-subscript (e.g. \\<^bsub>A\<^esub>). * The glyph for \ in the IsabelleText font now corresponds better to its counterpart \ as quantifier-like symbol. A small diamond is available as \; the old symbol \ loses this rendering and any special meaning. * Syntax for formal comments "-- text" now also supports the symbolic form "\ text". Command-line tool "isabelle update_cartouches -c" helps to update old sources. * Toplevel theorem statements have been simplified as follows: theorems ~> lemmas schematic_lemma ~> schematic_goal schematic_theorem ~> schematic_goal schematic_corollary ~> schematic_goal Command-line tool "isabelle update_theorems" updates theory sources accordingly. * Toplevel theorem statement 'proposition' is another alias for 'theorem'. * The old 'defs' command has been removed (legacy since Isabelle2014). INCOMPATIBILITY, use regular 'definition' instead. Overloaded and/or deferred definitions require a surrounding 'overloading' block. *** Prover IDE -- Isabelle/Scala/jEdit *** * IDE support for the source-level debugger of Poly/ML, to work with Isabelle/ML and official Standard ML. Option "ML_debugger" and commands 'ML_file_debug', 'ML_file_no_debug', 'SML_file_debug', 'SML_file_no_debug' control compilation of sources with or without debugging information. The Debugger panel allows to set breakpoints (via context menu), step through stopped threads, evaluate local ML expressions etc. At least one Debugger view needs to be active to have any effect on the running ML program. * The State panel manages explicit proof state output, with dynamic auto-update according to cursor movement. Alternatively, the jEdit action "isabelle.update-state" (shortcut S+ENTER) triggers manual update. * The Output panel no longer shows proof state output by default, to avoid GUI overcrowding. INCOMPATIBILITY, use the State panel instead or enable option "editor_output_state". * The text overview column (status of errors, warnings etc.) is updated asynchronously, leading to much better editor reactivity. Moreover, the full document node content is taken into account. The width of the column is scaled according to the main text area font, for improved visibility. * The main text area no longer changes its color hue in outdated situations. The text overview column takes over the role to indicate unfinished edits in the PIDE pipeline. This avoids flashing text display due to ad-hoc updates by auxiliary GUI components, such as the State panel. * Slightly improved scheduling for urgent print tasks (e.g. command state output, interactive queries) wrt. long-running background tasks. * Completion of symbols via prefix of \ or \<^name> or \name is always possible, independently of the language context. It is never implicit: a popup will show up unconditionally. * Additional abbreviations for syntactic completion may be specified in $ISABELLE_HOME/etc/abbrevs and $ISABELLE_HOME_USER/etc/abbrevs, with support for simple templates using ASCII 007 (bell) as placeholder. * Symbols \, \, \, \, \, \, \, \ no longer provide abbreviations for completion like "+o", "*o", ".o" etc. -- due to conflicts with other ASCII syntax. INCOMPATIBILITY, use plain backslash-completion or define suitable abbreviations in $ISABELLE_HOME_USER/etc/abbrevs. * Action "isabelle-emph" (with keyboard shortcut C+e LEFT) controls emphasized text style; the effect is visible in document output, not in the editor. * Action "isabelle-reset" now uses keyboard shortcut C+e BACK_SPACE, instead of former C+e LEFT. * The command-line tool "isabelle jedit" and the isabelle.Main application wrapper treat the default $USER_HOME/Scratch.thy more uniformly, and allow the dummy file argument ":" to open an empty buffer instead. * New command-line tool "isabelle jedit_client" allows to connect to an already running Isabelle/jEdit process. This achieves the effect of single-instance applications seen on common GUI desktops. * The default look-and-feel for Linux is the traditional "Metal", which works better with GUI scaling for very high-resolution displays (e.g. 4K). Moreover, it is generally more robust than "Nimbus". * Update to jedit-5.3.0, with improved GUI scaling and support of high-resolution displays (e.g. 4K). * The main Isabelle executable is managed as single-instance Desktop application uniformly on all platforms: Linux, Windows, Mac OS X. *** Document preparation *** * Commands 'paragraph' and 'subparagraph' provide additional section headings. Thus there are 6 levels of standard headings, as in HTML. * Command 'text_raw' has been clarified: input text is processed as in 'text' (with antiquotations and control symbols). The key difference is the lack of the surrounding isabelle markup environment in output. * Text is structured in paragraphs and nested lists, using notation that is similar to Markdown. The control symbols for list items are as follows: \<^item> itemize \<^enum> enumerate \<^descr> description * There is a new short form for antiquotations with a single argument that is a cartouche: \<^name>\...\ is equivalent to @{name \...\} and \...\ without control symbol is equivalent to @{cartouche \...\}. \<^name> without following cartouche is equivalent to @{name}. The standard Isabelle fonts provide glyphs to render important control symbols, e.g. "\<^verbatim>", "\<^emph>", "\<^bold>". * Antiquotations @{noindent}, @{smallskip}, @{medskip}, @{bigskip} with corresponding control symbols \<^noindent>, \<^smallskip>, \<^medskip>, \<^bigskip> specify spacing formally, using standard LaTeX macros of the same names. * Antiquotation @{cartouche} in Isabelle/Pure is the same as @{text}. Consequently, \...\ without any decoration prints literal quasi-formal text. Command-line tool "isabelle update_cartouches -t" helps to update old sources, by approximative patching of the content of string and cartouche tokens seen in theory sources. * The @{text} antiquotation now ignores the antiquotation option "source". The given text content is output unconditionally, without any surrounding quotes etc. Subtle INCOMPATIBILITY, put quotes into the argument where they are really intended, e.g. @{text \"foo"\}. Initial or terminal spaces are ignored. * Antiquotations @{emph} and @{bold} output LaTeX source recursively, adding appropriate text style markup. These may be used in the short form \<^emph>\...\ and \<^bold>\...\. * Document antiquotation @{footnote} outputs LaTeX source recursively, marked as \footnote{}. This may be used in the short form \<^footnote>\...\. * Antiquotation @{verbatim [display]} supports option "indent". * Antiquotation @{theory_text} prints uninterpreted theory source text (Isar outer syntax with command keywords etc.). This may be used in the short form \<^theory_text>\...\. @{theory_text [display]} supports option "indent". * Antiquotation @{doc ENTRY} provides a reference to the given documentation, with a hyperlink in the Prover IDE. * Antiquotations @{command}, @{method}, @{attribute} print checked entities of the Isar language. * HTML presentation uses the standard IsabelleText font and Unicode rendering of Isabelle symbols like Isabelle/Scala/jEdit. The former print mode "HTML" loses its special meaning. *** Isar *** * Local goals ('have', 'show', 'hence', 'thus') allow structured rule statements like fixes/assumes/shows in theorem specifications, but the notation is postfix with keywords 'if' (or 'when') and 'for'. For example: have result: "C x y" if "A x" and "B y" for x :: 'a and y :: 'a The local assumptions are bound to the name "that". The result is exported from context of the statement as usual. The above roughly corresponds to a raw proof block like this: { fix x :: 'a and y :: 'a assume that: "A x" "B y" have "C x y" } note result = this The keyword 'when' may be used instead of 'if', to indicate 'presume' instead of 'assume' above. * Assumptions ('assume', 'presume') allow structured rule statements using 'if' and 'for', similar to 'have' etc. above. For example: assume result: "C x y" if "A x" and "B y" for x :: 'a and y :: 'a This assumes "\x y::'a. A x \ B y \ C x y" and produces a general result as usual: "A ?x \ B ?y \ C ?x ?y". Vacuous quantification in assumptions is omitted, i.e. a for-context only effects propositions according to actual use of variables. For example: assume "A x" and "B y" for x and y is equivalent to: assume "\x. A x" and "\y. B y" * The meaning of 'show' with Pure rule statements has changed: premises are treated in the sense of 'assume', instead of 'presume'. This means, a goal like "\x. A x \ B x \ C x" can be solved completely as follows: show "\x. A x \ B x \ C x" or: show "C x" if "A x" "B x" for x Rare INCOMPATIBILITY, the old behaviour may be recovered as follows: show "C x" when "A x" "B x" for x * New command 'consider' states rules for generalized elimination and case splitting. This is like a toplevel statement "theorem obtains" used within a proof body; or like a multi-branch 'obtain' without activation of the local context elements yet. * Proof method "cases" allows to specify the rule as first entry of chained facts. This is particularly useful with 'consider': consider (a) A | (b) B | (c) C then have something proof cases case a then show ?thesis next case b then show ?thesis next case c then show ?thesis qed * Command 'case' allows fact name and attribute specification like this: case a: (c xs) case a [attributes]: (c xs) Facts that are introduced by invoking the case context are uniformly qualified by "a"; the same name is used for the cumulative fact. The old form "case (c xs) [attributes]" is no longer supported. Rare INCOMPATIBILITY, need to adapt uses of case facts in exotic situations, and always put attributes in front. * The standard proof method of commands 'proof' and '..' is now called "standard" to make semantically clear what it is; the old name "default" is still available as legacy for some time. Documentation now explains '..' more accurately as "by standard" instead of "by rule". * Nesting of Isar goal structure has been clarified: the context after the initial backwards refinement is retained for the whole proof, within all its context sections (as indicated via 'next'). This is e.g. relevant for 'using', 'including', 'supply': have "A \ A" if a: A for A supply [simp] = a proof show A by simp next show A by simp qed * Command 'obtain' binds term abbreviations (via 'is' patterns) in the proof body as well, abstracted over relevant parameters. * Improved type-inference for theorem statement 'obtains': separate parameter scope for of each clause. * Term abbreviations via 'is' patterns also work for schematic statements: result is abstracted over unknowns. * Command 'subgoal' allows to impose some structure on backward refinements, to avoid proof scripts degenerating into long of 'apply' sequences. Further explanations and examples are given in the isar-ref manual. * Command 'supply' supports fact definitions during goal refinement ('apply' scripts). * Proof method "goal_cases" turns the current subgoals into cases within the context; the conclusion is bound to variable ?case in each case. For example: lemma "\x. A x \ B x \ C x" and "\y z. U y \ V z \ W y z" proof goal_cases case (1 x) then show ?case using \A x\ \B x\ sorry next case (2 y z) then show ?case using \U y\ \V z\ sorry qed lemma "\x. A x \ B x \ C x" and "\y z. U y \ V z \ W y z" proof goal_cases case prems: 1 then show ?case using prems sorry next case prems: 2 then show ?case using prems sorry qed * The undocumented feature of implicit cases goal1, goal2, goal3, etc. is marked as legacy, and will be removed eventually. The proof method "goals" achieves a similar effect within regular Isar; often it can be done more adequately by other means (e.g. 'consider'). * The vacuous fact "TERM x" may be established "by fact" or as `TERM x` as well, not just "by this" or "." as before. * Method "sleep" succeeds after a real-time delay (in seconds). This is occasionally useful for demonstration and testing purposes. *** Pure *** * Qualifiers in locale expressions default to mandatory ('!') regardless of the command. Previously, for 'locale' and 'sublocale' the default was optional ('?'). The old synatx '!' has been discontinued. INCOMPATIBILITY, remove '!' and add '?' as required. * Keyword 'rewrites' identifies rewrite morphisms in interpretation commands. Previously, the keyword was 'where'. INCOMPATIBILITY. * More gentle suppression of syntax along locale morphisms while printing terms. Previously 'abbreviation' and 'notation' declarations would be suppressed for morphisms except term identity. Now 'abbreviation' is also kept for morphims that only change the involved parameters, and only 'notation' is suppressed. This can be of great help when working with complex locale hierarchies, because proof states are displayed much more succinctly. It also means that only notation needs to be redeclared if desired, as illustrated by this example: locale struct = fixes composition :: "'a => 'a => 'a" (infixl "\" 65) begin definition derived (infixl "\" 65) where ... end locale morphism = left: struct composition + right: struct composition' for composition (infix "\" 65) and composition' (infix "\''" 65) begin notation right.derived ("\''") end * Command 'global_interpretation' issues interpretations into global theories, with optional rewrite definitions following keyword 'defines'. * Command 'sublocale' accepts optional rewrite definitions after keyword 'defines'. * Command 'permanent_interpretation' has been discontinued. Use 'global_interpretation' or 'sublocale' instead. INCOMPATIBILITY. * Command 'print_definitions' prints dependencies of definitional specifications. This functionality used to be part of 'print_theory'. * Configuration option rule_insts_schematic has been discontinued (intermediate legacy feature in Isabelle2015). INCOMPATIBILITY. * Abbreviations in type classes now carry proper sort constraint. Rare INCOMPATIBILITY in situations where the previous misbehaviour has been exploited. * Refinement of user-space type system in type classes: pseudo-local operations behave more similar to abbreviations. Potential INCOMPATIBILITY in exotic situations. *** HOL *** * The 'typedef' command has been upgraded from a partially checked "axiomatization", to a full definitional specification that takes the global collection of overloaded constant / type definitions into account. Type definitions with open dependencies on overloaded definitions need to be specified as "typedef (overloaded)". This provides extra robustness in theory construction. Rare INCOMPATIBILITY. * Qualification of various formal entities in the libraries is done more uniformly via "context begin qualified definition ... end" instead of old-style "hide_const (open) ...". Consequently, both the defined constant and its defining fact become qualified, e.g. Option.is_none and Option.is_none_def. Occasional INCOMPATIBILITY in applications. * Some old and rarely used ASCII replacement syntax has been removed. INCOMPATIBILITY, standard syntax with symbols should be used instead. The subsequent commands help to reproduce the old forms, e.g. to simplify porting old theories: notation iff (infixr "<->" 25) notation Times (infixr "<*>" 80) type_notation Map.map (infixr "~=>" 0) notation Map.map_comp (infixl "o'_m" 55) type_notation FinFun.finfun ("(_ =>f /_)" [22, 21] 21) notation FuncSet.funcset (infixr "->" 60) notation FuncSet.extensional_funcset (infixr "->\<^sub>E" 60) notation Omega_Words_Fun.conc (infixr "conc" 65) notation Preorder.equiv ("op ~~") and Preorder.equiv ("(_/ ~~ _)" [51, 51] 50) notation (in topological_space) tendsto (infixr "--->" 55) notation (in topological_space) LIMSEQ ("((_)/ ----> (_))" [60, 60] 60) notation LIM ("((_)/ -- (_)/ --> (_))" [60, 0, 60] 60) notation NSA.approx (infixl "@=" 50) notation NSLIMSEQ ("((_)/ ----NS> (_))" [60, 60] 60) notation NSLIM ("((_)/ -- (_)/ --NS> (_))" [60, 0, 60] 60) * The alternative notation "\" for type and sort constraints has been removed: in LaTeX document output it looks the same as "::". INCOMPATIBILITY, use plain "::" instead. * Commands 'inductive' and 'inductive_set' work better when names for intro rules are omitted: the "cases" and "induct" rules no longer declare empty case_names, but no case_names at all. This allows to use numbered cases in proofs, without requiring method "goal_cases". * Inductive definitions ('inductive', 'coinductive', etc.) expose low-level facts of the internal construction only if the option "inductive_internals" is enabled. This refers to the internal predicate definition and its monotonicity result. Rare INCOMPATIBILITY. * Recursive function definitions ('fun', 'function', 'partial_function') expose low-level facts of the internal construction only if the option "function_internals" is enabled. Its internal inductive definition is also subject to "inductive_internals". Rare INCOMPATIBILITY. * BNF datatypes ('datatype', 'codatatype', etc.) expose low-level facts of the internal construction only if the option "bnf_internals" is enabled. This supersedes the former option "bnf_note_all". Rare INCOMPATIBILITY. * Combinator to represent case distinction on products is named "case_prod", uniformly, discontinuing any input aliasses. Very popular theorem aliasses have been retained. Consolidated facts: PairE ~> prod.exhaust Pair_eq ~> prod.inject pair_collapse ~> prod.collapse Pair_fst_snd_eq ~> prod_eq_iff split_twice ~> prod.case_distrib split_weak_cong ~> prod.case_cong_weak split_split ~> prod.split split_split_asm ~> prod.split_asm splitI ~> case_prodI splitD ~> case_prodD splitI2 ~> case_prodI2 splitI2' ~> case_prodI2' splitE ~> case_prodE splitE' ~> case_prodE' split_pair ~> case_prod_Pair split_eta ~> case_prod_eta split_comp ~> case_prod_comp mem_splitI ~> mem_case_prodI mem_splitI2 ~> mem_case_prodI2 mem_splitE ~> mem_case_prodE The_split ~> The_case_prod cond_split_eta ~> cond_case_prod_eta Collect_split_in_rel_leE ~> Collect_case_prod_in_rel_leE Collect_split_in_rel_leI ~> Collect_case_prod_in_rel_leI in_rel_Collect_split_eq ~> in_rel_Collect_case_prod_eq Collect_split_Grp_eqD ~> Collect_case_prod_Grp_eqD Collect_split_Grp_inD ~> Collect_case_prod_Grp_in Domain_Collect_split ~> Domain_Collect_case_prod Image_Collect_split ~> Image_Collect_case_prod Range_Collect_split ~> Range_Collect_case_prod Eps_split ~> Eps_case_prod Eps_split_eq ~> Eps_case_prod_eq split_rsp ~> case_prod_rsp curry_split ~> curry_case_prod split_curry ~> case_prod_curry Changes in structure HOLogic: split_const ~> case_prod_const mk_split ~> mk_case_prod mk_psplits ~> mk_ptupleabs strip_psplits ~> strip_ptupleabs INCOMPATIBILITY. * The coercions to type 'real' have been reorganised. The function 'real' is no longer overloaded, but has type 'nat => real' and abbreviates of_nat for that type. Also 'real_of_int :: int => real' abbreviates of_int for that type. Other overloaded instances of 'real' have been replaced by 'real_of_ereal' and 'real_of_float'. Consolidated facts (among others): real_of_nat_le_iff -> of_nat_le_iff real_of_nat_numeral of_nat_numeral real_of_int_zero of_int_0 real_of_nat_zero of_nat_0 real_of_one of_int_1 real_of_int_add of_int_add real_of_nat_add of_nat_add real_of_int_diff of_int_diff real_of_nat_diff of_nat_diff floor_subtract floor_diff_of_int real_of_int_inject of_int_eq_iff real_of_int_gt_zero_cancel_iff of_int_0_less_iff real_of_int_ge_zero_cancel_iff of_int_0_le_iff real_of_nat_ge_zero of_nat_0_le_iff real_of_int_ceiling_ge le_of_int_ceiling ceiling_less_eq ceiling_less_iff ceiling_le_eq ceiling_le_iff less_floor_eq less_floor_iff floor_less_eq floor_less_iff floor_divide_eq_div floor_divide_of_int_eq real_of_int_zero_cancel of_nat_eq_0_iff ceiling_real_of_int ceiling_of_int INCOMPATIBILITY. * Theory Map: lemma map_of_is_SomeD was a clone of map_of_SomeD and has been removed. INCOMPATIBILITY. * Quickcheck setup for finite sets. * Discontinued simp_legacy_precond. Potential INCOMPATIBILITY. * Sledgehammer: - The MaSh relevance filter has been sped up. - Proof reconstruction has been improved, to minimize the incidence of cases where Sledgehammer gives a proof that does not work. - Auto Sledgehammer now minimizes and preplays the results. - Handle Vampire 4.0 proof output without raising exception. - Eliminated "MASH" environment variable. Use the "MaSh" option in Isabelle/jEdit instead. INCOMPATIBILITY. - Eliminated obsolete "blocking" option and related subcommands. * Nitpick: - Fixed soundness bug in translation of "finite" predicate. - Fixed soundness bug in "destroy_constrs" optimization. - Fixed soundness bug in translation of "rat" type. - Removed "check_potential" and "check_genuine" options. - Eliminated obsolete "blocking" option. * (Co)datatype package: - New commands "lift_bnf" and "copy_bnf" for lifting (copying) a BNF structure on the raw type to an abstract type defined using typedef. - Always generate "case_transfer" theorem. - For mutual types, generate slightly stronger "rel_induct", "rel_coinduct", and "coinduct" theorems. INCOMPATIBILITY. - Allow discriminators and selectors with the same name as the type being defined. - Avoid various internal name clashes (e.g., 'datatype f = f'). * Transfer: new methods for interactive debugging of 'transfer' and 'transfer_prover': 'transfer_start', 'transfer_step', 'transfer_end', 'transfer_prover_start' and 'transfer_prover_end'. * New diagnostic command print_record for displaying record definitions. * Division on integers is bootstrapped directly from division on naturals and uses generic numeral algorithm for computations. Slight INCOMPATIBILITY, simproc numeral_divmod replaces and generalizes former simprocs binary_int_div and binary_int_mod * Tightened specification of class semiring_no_zero_divisors. Minor INCOMPATIBILITY. * Class algebraic_semidom introduces common algebraic notions of integral (semi)domains, particularly units. Although logically subsumed by fields, is is not a super class of these in order not to burden fields with notions that are trivial there. * Class normalization_semidom specifies canonical representants for equivalence classes of associated elements in an integral (semi)domain. This formalizes associated elements as well. * Abstract specification of gcd/lcm operations in classes semiring_gcd, semiring_Gcd, semiring_Lcd. Minor INCOMPATIBILITY: facts gcd_nat.commute and gcd_int.commute are subsumed by gcd.commute, as well as gcd_nat.assoc and gcd_int.assoc by gcd.assoc. * Former constants Fields.divide (_ / _) and Divides.div (_ div _) are logically unified to Rings.divide in syntactic type class Rings.divide, with infix syntax (_ div _). Infix syntax (_ / _) for field division is added later as abbreviation in class Fields.inverse. INCOMPATIBILITY, instantiations must refer to Rings.divide rather than the former separate constants, hence infix syntax (_ / _) is usually not available during instantiation. * New cancellation simprocs for boolean algebras to cancel complementary terms for sup and inf. For example, "sup x (sup y (- x))" simplifies to "top". INCOMPATIBILITY. * Class uniform_space introduces uniform spaces btw topological spaces and metric spaces. Minor INCOMPATIBILITY: open__def needs to be introduced in the form of an uniformity. Some constants are more general now, it may be necessary to add type class constraints. open_real_def \ open_dist open_complex_def \ open_dist * Library/Monad_Syntax: notation uses symbols \ and \. INCOMPATIBILITY. * Library/Multiset: - Renamed multiset inclusion operators: < ~> <# > ~> ># <= ~> <=# >= ~> >=# \ ~> \# \ ~> \# INCOMPATIBILITY. - Added multiset inclusion operator syntax: \# \# \# \# - "'a multiset" is no longer an instance of the "order", "ordered_ab_semigroup_add_imp_le", "ordered_cancel_comm_monoid_diff", "semilattice_inf", and "semilattice_sup" type classes. The theorems previously provided by these type classes (directly or indirectly) are now available through the "subset_mset" interpretation (e.g. add_mono ~> subset_mset.add_mono). INCOMPATIBILITY. - Renamed conversions: multiset_of ~> mset multiset_of_set ~> mset_set set_of ~> set_mset INCOMPATIBILITY - Renamed lemmas: mset_le_def ~> subseteq_mset_def mset_less_def ~> subset_mset_def less_eq_multiset.rep_eq ~> subseteq_mset_def INCOMPATIBILITY - Removed lemmas generated by lift_definition: less_eq_multiset.abs_eq, less_eq_multiset.rsp, less_eq_multiset.transfer, less_eq_multiset_def INCOMPATIBILITY * Library/Omega_Words_Fun: Infinite words modeled as functions nat \ 'a. * Library/Bourbaki_Witt_Fixpoint: Added formalisation of the Bourbaki-Witt fixpoint theorem for increasing functions in chain-complete partial orders. * Library/Old_Recdef: discontinued obsolete 'defer_recdef' command. Minor INCOMPATIBILITY, use 'function' instead. * Library/Periodic_Fun: a locale that provides convenient lemmas for periodic functions. * Library/Formal_Power_Series: proper definition of division (with remainder) for formal power series; instances for Euclidean Ring and GCD. * HOL-Imperative_HOL: obsolete theory Legacy_Mrec has been removed. * HOL-Statespace: command 'statespace' uses mandatory qualifier for import of parent, as for general 'locale' expressions. INCOMPATIBILITY, remove '!' and add '?' as required. * HOL-Decision_Procs: The "approximation" method works with "powr" (exponentiation on real numbers) again. * HOL-Multivariate_Analysis: theory Cauchy_Integral_Thm with Contour integrals (= complex path integrals), Cauchy's integral theorem, winding numbers and Cauchy's integral formula, Liouville theorem, Fundamental Theorem of Algebra. Ported from HOL Light. * HOL-Multivariate_Analysis: topological concepts such as connected components, homotopic paths and the inside or outside of a set. * HOL-Multivariate_Analysis: radius of convergence of power series and various summability tests; Harmonic numbers and the Euler–Mascheroni constant; the Generalised Binomial Theorem; the complex and real Gamma/log-Gamma/Digamma/ Polygamma functions and their most important properties. * HOL-Probability: The central limit theorem based on Levy's uniqueness and continuity theorems, weak convergence, and characterisitc functions. * HOL-Data_Structures: new and growing session of standard data structures. *** ML *** * The following combinators for low-level profiling of the ML runtime system are available: profile_time (*CPU time*) profile_time_thread (*CPU time on this thread*) profile_allocations (*overall heap allocations*) * Antiquotation @{undefined} or \<^undefined> inlines (raise Match). * Antiquotation @{method NAME} inlines the (checked) name of the given Isar proof method. * Pretty printing of Poly/ML compiler output in Isabelle has been improved: proper treatment of break offsets and blocks with consistent breaks. * The auxiliary module Pure/display.ML has been eliminated. Its elementary thm print operations are now in Pure/more_thm.ML and thus called Thm.pretty_thm, Thm.string_of_thm etc. INCOMPATIBILITY. * Simproc programming interfaces have been simplified: Simplifier.make_simproc and Simplifier.define_simproc supersede various forms of Simplifier.mk_simproc, Simplifier.simproc_global etc. Note that term patterns for the left-hand sides are specified with implicitly fixed variables, like top-level theorem statements. INCOMPATIBILITY. * Instantiation rules have been re-organized as follows: Thm.instantiate (*low-level instantiation with named arguments*) Thm.instantiate' (*version with positional arguments*) Drule.infer_instantiate (*instantiation with type inference*) Drule.infer_instantiate' (*version with positional arguments*) The LHS only requires variable specifications, instead of full terms. Old cterm_instantiate is superseded by infer_instantiate. INCOMPATIBILITY, need to re-adjust some ML names and types accordingly. * Old tactic shorthands atac, rtac, etac, dtac, ftac have been discontinued. INCOMPATIBILITY, use regular assume_tac, resolve_tac etc. instead (with proper context). * Thm.instantiate (and derivatives) no longer require the LHS of the instantiation to be certified: plain variables are given directly. * Subgoal.SUBPROOF and Subgoal.FOCUS combinators use anonymous quasi-bound variables (like the Simplifier), instead of accidentally named local fixes. This has the potential to improve stability of proof tools, but can also cause INCOMPATIBILITY for tools that don't observe the proof context discipline. * Isar proof methods are based on a slightly more general type context_tactic, which allows to change the proof context dynamically (e.g. to update cases) and indicate explicit Seq.Error results. Former METHOD_CASES is superseded by CONTEXT_METHOD; further combinators are provided in src/Pure/Isar/method.ML for convenience. INCOMPATIBILITY. *** System *** * Command-line tool "isabelle console" enables print mode "ASCII". * Command-line tool "isabelle update_then" expands old Isar command conflations: hence ~> then have thus ~> then show This syntax is more orthogonal and improves readability and maintainability of proofs. * Global session timeout is multiplied by timeout_scale factor. This allows to adjust large-scale tests (e.g. AFP) to overall hardware performance. * Property values in etc/symbols may contain spaces, if written with the replacement character "␣" (Unicode point 0x2324). For example: \ code: 0x0022c6 group: operator font: Deja␣Vu␣Sans␣Mono * Java runtime environment for x86_64-windows allows to use larger heap space. * Java runtime options are determined separately for 32bit vs. 64bit platforms as follows. - Isabelle desktop application: platform-specific files that are associated with the main app bundle - isabelle jedit: settings JEDIT_JAVA_SYSTEM_OPTIONS JEDIT_JAVA_OPTIONS32 vs. JEDIT_JAVA_OPTIONS64 - isabelle build: settings ISABELLE_BUILD_JAVA_OPTIONS32 vs. ISABELLE_BUILD_JAVA_OPTIONS64 * Bash shell function "jvmpath" has been renamed to "platform_path": it is relevant both for Poly/ML and JVM processes. * Poly/ML default platform architecture may be changed from 32bit to 64bit via system option ML_system_64. A system restart (and rebuild) is required after change. * Poly/ML 5.6 runs natively on x86-windows and x86_64-windows, which both allow larger heap space than former x86-cygwin. * Heap images are 10-15% smaller due to less wasteful persistent theory content (using ML type theory_id instead of theory); New in Isabelle2015 (May 2015) ------------------------------ *** General *** * Local theory specification commands may have a 'private' or 'qualified' modifier to restrict name space accesses to the local scope, as provided by some "context begin ... end" block. For example: context begin private definition ... private lemma ... qualified definition ... qualified lemma ... lemma ... theorem ... end * Command 'experiment' opens an anonymous locale context with private naming policy. * Command 'notepad' requires proper nesting of begin/end and its proof structure in the body: 'oops' is no longer supported here. Minor INCOMPATIBILITY, use 'sorry' instead. * Command 'named_theorems' declares a dynamic fact within the context, together with an attribute to maintain the content incrementally. This supersedes functor Named_Thms in Isabelle/ML, but with a subtle change of semantics due to external visual order vs. internal reverse order. * 'find_theorems': search patterns which are abstractions are schematically expanded before search. Search results match the naive expectation more closely, particularly wrt. abbreviations. INCOMPATIBILITY. * Commands 'method_setup' and 'attribute_setup' now work within a local theory context. * Outer syntax commands are managed authentically within the theory context, without implicit global state. Potential for accidental INCOMPATIBILITY, make sure that required theories are really imported. * Historical command-line terminator ";" is no longer accepted (and already used differently in Isar). Minor INCOMPATIBILITY, use "isabelle update_semicolons" to remove obsolete semicolons from old theory sources. * Structural composition of proof methods (meth1; meth2) in Isar corresponds to (tac1 THEN_ALL_NEW tac2) in ML. * The Eisbach proof method language allows to define new proof methods by combining existing ones with their usual syntax. The "match" proof method provides basic fact/term matching in addition to premise/conclusion matching through Subgoal.focus, and binds fact names from matches as well as term patterns within matches. The Isabelle documentation provides an entry "eisbach" for the Eisbach User Manual. Sources and various examples are in ~~/src/HOL/Eisbach/. *** Prover IDE -- Isabelle/Scala/jEdit *** * Improved folding mode "isabelle" based on Isar syntax. Alternatively, the "sidekick" mode may be used for document structure. * Extended bracket matching based on Isar language structure. System option jedit_structure_limit determines maximum number of lines to scan in the buffer. * Support for BibTeX files: context menu, context-sensitive token marker, SideKick parser. * Document antiquotation @{cite} provides formal markup, which is interpreted semi-formally based on .bib files that happen to be open in the editor (hyperlinks, completion etc.). * Less waste of vertical space via negative line spacing (see Global Options / Text Area). * Improved graphview panel with optional output of PNG or PDF, for display of 'thy_deps', 'class_deps' etc. * The commands 'thy_deps' and 'class_deps' allow optional bounds to restrict the visualized hierarchy. * Improved scheduling for asynchronous print commands (e.g. provers managed by the Sledgehammer panel) wrt. ongoing document processing. *** Document preparation *** * Document markup commands 'chapter', 'section', 'subsection', 'subsubsection', 'text', 'txt', 'text_raw' work uniformly in any context, even before the initial 'theory' command. Obsolete proof commands 'sect', 'subsect', 'subsubsect', 'txt_raw' have been discontinued, use 'section', 'subsection', 'subsubsection', 'text_raw' instead. The old 'header' command is still retained for some time, but should be replaced by 'chapter', 'section' etc. (using "isabelle update_header"). Minor INCOMPATIBILITY. * Official support for "tt" style variants, via \isatt{...} or \begin{isabellett}...\end{isabellett}. The somewhat fragile \verb or verbatim environment of LaTeX is no longer used. This allows @{ML} etc. as argument to other macros (such as footnotes). * Document antiquotation @{verbatim} prints ASCII text literally in "tt" style. * Discontinued obsolete option "document_graph": session_graph.pdf is produced unconditionally for HTML browser_info and PDF-LaTeX document. * Diagnostic commands and document markup commands within a proof do not affect the command tag for output. Thus commands like 'thm' are subject to proof document structure, and no longer "stick out" accidentally. Commands 'text' and 'txt' merely differ in the LaTeX style, not their tags. Potential INCOMPATIBILITY in exotic situations. * System option "pretty_margin" is superseded by "thy_output_margin", which is also accessible via document antiquotation option "margin". Only the margin for document output may be changed, but not the global pretty printing: that is 76 for plain console output, and adapted dynamically in GUI front-ends. Implementations of document antiquotations need to observe the margin explicitly according to Thy_Output.string_of_margin. Minor INCOMPATIBILITY. * Specification of 'document_files' in the session ROOT file is mandatory for document preparation. The legacy mode with implicit copying of the document/ directory is no longer supported. Minor INCOMPATIBILITY. *** Pure *** * Proof methods with explicit instantiation ("rule_tac", "subgoal_tac" etc.) allow an optional context of local variables ('for' declaration): these variables become schematic in the instantiated theorem; this behaviour is analogous to 'for' in attributes "where" and "of". Configuration option rule_insts_schematic (default false) controls use of schematic variables outside the context. Minor INCOMPATIBILITY, declare rule_insts_schematic = true temporarily and update to use local variable declarations or dummy patterns instead. * Explicit instantiation via attributes "where", "of", and proof methods "rule_tac" with derivatives like "subgoal_tac" etc. admit dummy patterns ("_") that stand for anonymous local variables. * Generated schematic variables in standard format of exported facts are incremented to avoid material in the proof context. Rare INCOMPATIBILITY, explicit instantiation sometimes needs to refer to different index. * Lexical separation of signed and unsigned numerals: categories "num" and "float" are unsigned. INCOMPATIBILITY: subtle change in precedence of numeral signs, particularly in expressions involving infix syntax like "(- 1) ^ n". * Old inner token category "xnum" has been discontinued. Potential INCOMPATIBILITY for exotic syntax: may use mixfix grammar with "num" token category instead. *** HOL *** * New (co)datatype package: - The 'datatype_new' command has been renamed 'datatype'. The old command of that name is now called 'old_datatype' and is provided by "~~/src/HOL/Library/Old_Datatype.thy". See 'isabelle doc datatypes' for information on porting. INCOMPATIBILITY. - Renamed theorems: disc_corec ~> corec_disc disc_corec_iff ~> corec_disc_iff disc_exclude ~> distinct_disc disc_exhaust ~> exhaust_disc disc_map_iff ~> map_disc_iff sel_corec ~> corec_sel sel_exhaust ~> exhaust_sel sel_map ~> map_sel sel_set ~> set_sel sel_split ~> split_sel sel_split_asm ~> split_sel_asm strong_coinduct ~> coinduct_strong weak_case_cong ~> case_cong_weak INCOMPATIBILITY. - The "no_code" option to "free_constructors", "datatype_new", and "codatatype" has been renamed "plugins del: code". INCOMPATIBILITY. - The rules "set_empty" have been removed. They are easy consequences of other set rules "by auto". INCOMPATIBILITY. - The rule "set_cases" is now registered with the "[cases set]" attribute. This can influence the behavior of the "cases" proof method when more than one case rule is applicable (e.g., an assumption is of the form "w : set ws" and the method "cases w" is invoked). The solution is to specify the case rule explicitly (e.g. "cases w rule: widget.exhaust"). INCOMPATIBILITY. - Renamed theories: BNF_Comp ~> BNF_Composition BNF_FP_Base ~> BNF_Fixpoint_Base BNF_GFP ~> BNF_Greatest_Fixpoint BNF_LFP ~> BNF_Least_Fixpoint BNF_Constructions_on_Wellorders ~> BNF_Wellorder_Constructions Cardinals/Constructions_on_Wellorders ~> Cardinals/Wellorder_Constructions INCOMPATIBILITY. - Lifting and Transfer setup for basic HOL types sum and prod (also option) is now performed by the BNF package. Theories Lifting_Sum, Lifting_Product and Lifting_Option from Main became obsolete and were removed. Changed definitions of the relators rel_prod and rel_sum (using inductive). INCOMPATIBILITY: use rel_prod.simps and rel_sum.simps instead of rel_prod_def and rel_sum_def. Minor INCOMPATIBILITY: (rarely used by name) transfer theorem names changed (e.g. map_prod_transfer ~> prod.map_transfer). - Parametricity theorems for map functions, relators, set functions, constructors, case combinators, discriminators, selectors and (co)recursors are automatically proved and registered as transfer rules. * Old datatype package: - The old 'datatype' command has been renamed 'old_datatype', and 'rep_datatype' has been renamed 'old_rep_datatype'. They are provided by "~~/src/HOL/Library/Old_Datatype.thy". See 'isabelle doc datatypes' for information on porting. INCOMPATIBILITY. - Renamed theorems: weak_case_cong ~> case_cong_weak INCOMPATIBILITY. - Renamed theory: ~~/src/HOL/Datatype.thy ~> ~~/src/HOL/Library/Old_Datatype.thy INCOMPATIBILITY. * Nitpick: - Fixed soundness bug related to the strict and non-strict subset operations. * Sledgehammer: - CVC4 is now included with Isabelle instead of CVC3 and run by default. - Z3 is now always enabled by default, now that it is fully open source. The "z3_non_commercial" option is discontinued. - Minimization is now always enabled by default. Removed sub-command: min - Proof reconstruction, both one-liners and Isar, has been dramatically improved. - Improved support for CVC4 and veriT. * Old and new SMT modules: - The old 'smt' method has been renamed 'old_smt' and moved to 'src/HOL/Library/Old_SMT.thy'. It is provided for compatibility, until applications have been ported to use the new 'smt' method. For the method to work, an older version of Z3 (e.g. Z3 3.2 or 4.0) must be installed, and the environment variable "OLD_Z3_SOLVER" must point to it. INCOMPATIBILITY. - The 'smt2' method has been renamed 'smt'. INCOMPATIBILITY. - New option 'smt_reconstruction_step_timeout' to limit the reconstruction time of Z3 proof steps in the new 'smt' method. - New option 'smt_statistics' to display statistics of the new 'smt' method, especially runtime statistics of Z3 proof reconstruction. * Lifting: command 'lift_definition' allows to execute lifted constants that have as a return type a datatype containing a subtype. This overcomes long-time limitations in the area of code generation and lifting, and avoids tedious workarounds. * Command and antiquotation "value" provide different evaluation slots (again), where the previous strategy (NBE after ML) serves as default. Minor INCOMPATIBILITY. * Add NO_MATCH-simproc, allows to check for syntactic non-equality. * field_simps: Use NO_MATCH-simproc for distribution rules, to avoid non-termination in case of distributing a division. With this change field_simps is in some cases slightly less powerful, if it fails try to add algebra_simps, or use divide_simps. Minor INCOMPATIBILITY. * Separate class no_zero_divisors has been given up in favour of fully algebraic semiring_no_zero_divisors. INCOMPATIBILITY. * Class linordered_semidom really requires no zero divisors. INCOMPATIBILITY. * Classes division_ring, field and linordered_field always demand "inverse 0 = 0". Given up separate classes division_ring_inverse_zero, field_inverse_zero and linordered_field_inverse_zero. INCOMPATIBILITY. * Classes cancel_ab_semigroup_add / cancel_monoid_add specify explicit additive inverse operation. INCOMPATIBILITY. * Complex powers and square roots. The functions "ln" and "powr" are now overloaded for types real and complex, and 0 powr y = 0 by definition. INCOMPATIBILITY: type constraints may be necessary. * The functions "sin" and "cos" are now defined for any type of sort "{real_normed_algebra_1,banach}" type, so in particular on "real" and "complex" uniformly. Minor INCOMPATIBILITY: type constraints may be needed. * New library of properties of the complex transcendental functions sin, cos, tan, exp, Ln, Arctan, Arcsin, Arccos. Ported from HOL Light. * The factorial function, "fact", now has type "nat => 'a" (of a sort that admits numeric types including nat, int, real and complex. INCOMPATIBILITY: an expression such as "fact 3 = 6" may require a type constraint, and the combination "real (fact k)" is likely to be unsatisfactory. If a type conversion is still necessary, then use "of_nat (fact k)" or "real_of_nat (fact k)". * Removed functions "natfloor" and "natceiling", use "nat o floor" and "nat o ceiling" instead. A few of the lemmas have been retained and adapted: in their names "natfloor"/"natceiling" has been replaced by "nat_floor"/"nat_ceiling". * Qualified some duplicated fact names required for boostrapping the type class hierarchy: ab_add_uminus_conv_diff ~> diff_conv_add_uminus field_inverse_zero ~> inverse_zero field_divide_inverse ~> divide_inverse field_inverse ~> left_inverse Minor INCOMPATIBILITY. * Eliminated fact duplicates: mult_less_imp_less_right ~> mult_right_less_imp_less mult_less_imp_less_left ~> mult_left_less_imp_less Minor INCOMPATIBILITY. * Fact consolidation: even_less_0_iff is subsumed by double_add_less_zero_iff_single_add_less_zero (simp by default anyway). * Generalized and consolidated some theorems concerning divsibility: dvd_reduce ~> dvd_add_triv_right_iff dvd_plus_eq_right ~> dvd_add_right_iff dvd_plus_eq_left ~> dvd_add_left_iff Minor INCOMPATIBILITY. * "even" and "odd" are mere abbreviations for "2 dvd _" and "~ 2 dvd _" and part of theory Main. even_def ~> even_iff_mod_2_eq_zero INCOMPATIBILITY. * Lemma name consolidation: divide_Numeral1 ~> divide_numeral_1. Minor INCOMPATIBILITY. * Bootstrap of listsum as special case of abstract product over lists. Fact rename: listsum_def ~> listsum.eq_foldr INCOMPATIBILITY. * Product over lists via constant "listprod". * Theory List: renamed drop_Suc_conv_tl and nth_drop' to Cons_nth_drop_Suc. * New infrastructure for compiling, running, evaluating and testing generated code in target languages in HOL/Library/Code_Test. See HOL/Codegenerator_Test/Code_Test* for examples. * Library/Multiset: - Introduced "replicate_mset" operation. - Introduced alternative characterizations of the multiset ordering in "Library/Multiset_Order". - Renamed multiset ordering: <# ~> #<# <=# ~> #<=# \# ~> #\# \# ~> #\# INCOMPATIBILITY. - Introduced abbreviations for ill-named multiset operations: <#, \# abbreviate < (strict subset) <=#, \#, \# abbreviate <= (subset or equal) INCOMPATIBILITY. - Renamed in_multiset_of ~> in_multiset_in_set Multiset.fold ~> fold_mset Multiset.filter ~> filter_mset INCOMPATIBILITY. - Removed mcard, is equal to size. - Added attributes: image_mset.id [simp] image_mset_id [simp] elem_multiset_of_set [simp, intro] comp_fun_commute_plus_mset [simp] comp_fun_commute.fold_mset_insert [OF comp_fun_commute_plus_mset, simp] in_mset_fold_plus_iff [iff] set_of_Union_mset [simp] in_Union_mset_iff [iff] INCOMPATIBILITY. * Library/Sum_of_Squares: simplified and improved "sos" method. Always use local CSDP executable, which is much faster than the NEOS server. The "sos_cert" functionality is invoked as "sos" with additional argument. Minor INCOMPATIBILITY. * HOL-Decision_Procs: New counterexample generator quickcheck [approximation] for inequalities of transcendental functions. Uses hardware floating point arithmetic to randomly discover potential counterexamples. Counterexamples are certified with the "approximation" method. See HOL/Decision_Procs/ex/Approximation_Quickcheck_Ex.thy for examples. * HOL-Probability: Reworked measurability prover - applies destructor rules repeatedly - removed application splitting (replaced by destructor rule) - added congruence rules to rewrite measure spaces under the sets projection * New proof method "rewrite" (in theory ~~/src/HOL/Library/Rewrite) for single-step rewriting with subterm selection based on patterns. *** ML *** * Subtle change of name space policy: undeclared entries are now considered inaccessible, instead of accessible via the fully-qualified internal name. This mainly affects Name_Space.intern (and derivatives), which may produce an unexpected Long_Name.hidden prefix. Note that contemporary applications use the strict Name_Space.check (and derivatives) instead, which is not affected by the change. Potential INCOMPATIBILITY in rare applications of Name_Space.intern. * Subtle change of error semantics of Toplevel.proof_of: regular user ERROR instead of internal Toplevel.UNDEF. * Basic combinators map, fold, fold_map, split_list, apply are available as parameterized antiquotations, e.g. @{map 4} for lists of quadruples. * Renamed "pairself" to "apply2", in accordance to @{apply 2}. INCOMPATIBILITY. * Former combinators NAMED_CRITICAL and CRITICAL for central critical sections have been discontinued, in favour of the more elementary Multithreading.synchronized and its high-level derivative Synchronized.var (which is usually sufficient in applications). Subtle INCOMPATIBILITY: synchronized access needs to be atomic and cannot be nested. * Synchronized.value (ML) is actually synchronized (as in Scala): subtle change of semantics with minimal potential for INCOMPATIBILITY. * The main operations to certify logical entities are Thm.ctyp_of and Thm.cterm_of with a local context; old-style global theory variants are available as Thm.global_ctyp_of and Thm.global_cterm_of. INCOMPATIBILITY. * Elementary operations in module Thm are no longer pervasive. INCOMPATIBILITY, need to use qualified Thm.prop_of, Thm.cterm_of, Thm.term_of etc. * Proper context for various elementary tactics: assume_tac, resolve_tac, eresolve_tac, dresolve_tac, forward_tac, match_tac, compose_tac, Splitter.split_tac etc. INCOMPATIBILITY. * Tactical PARALLEL_ALLGOALS is the most common way to refer to PARALLEL_GOALS. * Goal.prove_multi is superseded by the fully general Goal.prove_common, which also allows to specify a fork priority. * Antiquotation @{command_spec "COMMAND"} is superseded by @{command_keyword COMMAND} (usually without quotes and with PIDE markup). Minor INCOMPATIBILITY. * Cartouches within ML sources are turned into values of type Input.source (with formal position information). *** System *** * The Isabelle tool "update_cartouches" changes theory files to use cartouches instead of old-style {* verbatim *} or `alt_string` tokens. * The Isabelle tool "build" provides new options -X, -k, -x. * Discontinued old-fashioned "codegen" tool. Code generation can always be externally triggered using an appropriate ROOT file plus a corresponding theory. Parametrization is possible using environment variables, or ML snippets in the most extreme cases. Minor INCOMPATIBILITY. * JVM system property "isabelle.threads" determines size of Scala thread pool, like Isabelle system option "threads" for ML. * JVM system property "isabelle.laf" determines the default Swing look-and-feel, via internal class name or symbolic name as in the jEdit menu Global Options / Appearance. * Support for Proof General and Isar TTY loop has been discontinued. Minor INCOMPATIBILITY, use standard PIDE infrastructure instead. New in Isabelle2014 (August 2014) --------------------------------- *** General *** * Support for official Standard ML within the Isabelle context. Command 'SML_file' reads and evaluates the given Standard ML file. Toplevel bindings are stored within the theory context; the initial environment is restricted to the Standard ML implementation of Poly/ML, without the add-ons of Isabelle/ML. Commands 'SML_import' and 'SML_export' allow to exchange toplevel bindings between the two separate environments. See also ~~/src/Tools/SML/Examples.thy for some examples. * Standard tactics and proof methods such as "clarsimp", "auto" and "safe" now preserve equality hypotheses "x = expr" where x is a free variable. Locale assumptions and chained facts containing "x" continue to be useful. The new method "hypsubst_thin" and the configuration option "hypsubst_thin" (within the attribute name space) restore the previous behavior. INCOMPATIBILITY, especially where induction is done after these methods or when the names of free and bound variables clash. As first approximation, old proofs may be repaired by "using [[hypsubst_thin = true]]" in the critical spot. * More static checking of proof methods, which allows the system to form a closure over the concrete syntax. Method arguments should be processed in the original proof context as far as possible, before operating on the goal state. In any case, the standard discipline for subgoal-addressing needs to be observed: no subgoals or a subgoal number that is out of range produces an empty result sequence, not an exception. Potential INCOMPATIBILITY for non-conformant tactical proof tools. * Lexical syntax (inner and outer) supports text cartouches with arbitrary nesting, and without escapes of quotes etc. The Prover IDE supports input via ` (backquote). * The outer syntax categories "text" (for formal comments and document markup commands) and "altstring" (for literal fact references) allow cartouches as well, in addition to the traditional mix of quotations. * Syntax of document antiquotation @{rail} now uses \ instead of "\\", to avoid the optical illusion of escaped backslash within string token. General renovation of its syntax using text cartouches. Minor INCOMPATIBILITY. * Discontinued legacy_isub_isup, which was a temporary workaround for Isabelle/ML in Isabelle2013-1. The prover process no longer accepts old identifier syntax with \<^isub> or \<^isup>. Potential INCOMPATIBILITY. * Document antiquotation @{url} produces markup for the given URL, which results in an active hyperlink within the text. * Document antiquotation @{file_unchecked} is like @{file}, but does not check existence within the file-system. * Updated and extended manuals: codegen, datatypes, implementation, isar-ref, jedit, system. *** Prover IDE -- Isabelle/Scala/jEdit *** * Improved Document panel: simplified interaction where every single mouse click (re)opens document via desktop environment or as jEdit buffer. * Support for Navigator plugin (with toolbar buttons), with connection to PIDE hyperlinks. * Auxiliary files ('ML_file' etc.) are managed by the Prover IDE. Open text buffers take precedence over copies within the file-system. * Improved support for Isabelle/ML, with jEdit mode "isabelle-ml" for auxiliary ML files. * Improved syntactic and semantic completion mechanism, with simple templates, completion language context, name-space completion, file-name completion, spell-checker completion. * Refined GUI popup for completion: more robust key/mouse event handling and propagation to enclosing text area -- avoid loosing keystrokes with slow / remote graphics displays. * Completion popup supports both ENTER and TAB (default) to select an item, depending on Isabelle options. * Refined insertion of completion items wrt. jEdit text: multiple selections, rectangular selections, rectangular selection as "tall caret". * Integrated spell-checker for document text, comments etc. with completion popup and context-menu. * More general "Query" panel supersedes "Find" panel, with GUI access to commands 'find_theorems' and 'find_consts', as well as print operations for the context. Minor incompatibility in keyboard shortcuts etc.: replace action isabelle-find by isabelle-query. * Search field for all output panels ("Output", "Query", "Info" etc.) to highlight text via regular expression. * Option "jedit_print_mode" (see also "Plugin Options / Isabelle / General") allows to specify additional print modes for the prover process, without requiring old-fashioned command-line invocation of "isabelle jedit -m MODE". * More support for remote files (e.g. http) using standard Java networking operations instead of jEdit virtual file-systems. * Empty editors buffers that are no longer required (e.g.\ via theory imports) are automatically removed from the document model. * Improved monitor panel. * Improved Console/Scala plugin: more uniform scala.Console output, more robust treatment of threads and interrupts. * Improved management of dockable windows: clarified keyboard focus and window placement wrt. main editor view; optional menu item to "Detach" a copy where this makes sense. * New Simplifier Trace panel provides an interactive view of the simplification process, enabled by the "simp_trace_new" attribute within the context. *** Pure *** * Low-level type-class commands 'classes', 'classrel', 'arities' have been discontinued to avoid the danger of non-trivial axiomatization that is not immediately visible. INCOMPATIBILITY, use regular 'instance' command with proof. The required OFCLASS(...) theorem might be postulated via 'axiomatization' beforehand, or the proof finished trivially if the underlying class definition is made vacuous (without any assumptions). See also Isabelle/ML operations Axclass.class_axiomatization, Axclass.classrel_axiomatization, Axclass.arity_axiomatization. * Basic constants of Pure use more conventional names and are always qualified. Rare INCOMPATIBILITY, but with potentially serious consequences, notably for tools in Isabelle/ML. The following renaming needs to be applied: == ~> Pure.eq ==> ~> Pure.imp all ~> Pure.all TYPE ~> Pure.type dummy_pattern ~> Pure.dummy_pattern Systematic porting works by using the following theory setup on a *previous* Isabelle version to introduce the new name accesses for the old constants: setup {* fn thy => thy |> Sign.root_path |> Sign.const_alias (Binding.qualify true "Pure" @{binding eq}) "==" |> Sign.const_alias (Binding.qualify true "Pure" @{binding imp}) "==>" |> Sign.const_alias (Binding.qualify true "Pure" @{binding all}) "all" |> Sign.restore_naming thy *} Thus ML antiquotations like @{const_name Pure.eq} may be used already. Later the application is moved to the current Isabelle version, and the auxiliary aliases are deleted. * Attributes "where" and "of" allow an optional context of local variables ('for' declaration): these variables become schematic in the instantiated theorem. * Obsolete attribute "standard" has been discontinued (legacy since Isabelle2012). Potential INCOMPATIBILITY, use explicit 'for' context where instantiations with schematic variables are intended (for declaration commands like 'lemmas' or attributes like "of"). The following temporary definition may help to port old applications: attribute_setup standard = "Scan.succeed (Thm.rule_attribute (K Drule.export_without_context))" * More thorough check of proof context for goal statements and attributed fact expressions (concerning background theory, declared hyps). Potential INCOMPATIBILITY, tools need to observe standard context discipline. See also Assumption.add_assumes and the more primitive Thm.assume_hyps. * Inner syntax token language allows regular quoted strings "..." (only makes sense in practice, if outer syntax is delimited differently, e.g. via cartouches). * Command 'print_term_bindings' supersedes 'print_binds' for clarity, but the latter is retained some time as Proof General legacy. * Code generator preprocessor: explicit control of simp tracing on a per-constant basis. See attribute "code_preproc". *** HOL *** * Code generator: enforce case of identifiers only for strict target language requirements. INCOMPATIBILITY. * Code generator: explicit proof contexts in many ML interfaces. INCOMPATIBILITY. * Code generator: minimize exported identifiers by default. Minor INCOMPATIBILITY. * Code generation for SML and OCaml: dropped arcane "no_signatures" option. Minor INCOMPATIBILITY. * "declare [[code abort: ...]]" replaces "code_abort ...". INCOMPATIBILITY. * "declare [[code drop: ...]]" drops all code equations associated with the given constants. * Code generations are provided for make, fields, extend and truncate operations on records. * Command and antiquotation "value" are now hardcoded against nbe and ML. Minor INCOMPATIBILITY. * Renamed command 'enriched_type' to 'functor'. INCOMPATIBILITY. * The symbol "\" may be used within char or string literals to represent (Char Nibble0 NibbleA), i.e. ASCII newline. * Qualified String.implode and String.explode. INCOMPATIBILITY. * Simplifier: Enhanced solver of preconditions of rewrite rules can now deal with conjunctions. For help with converting proofs, the old behaviour of the simplifier can be restored like this: declare/using [[simp_legacy_precond]]. This configuration option will disappear again in the future. INCOMPATIBILITY. * Simproc "finite_Collect" is no longer enabled by default, due to spurious crashes and other surprises. Potential INCOMPATIBILITY. * Moved new (co)datatype package and its dependencies from session "HOL-BNF" to "HOL". The commands 'bnf', 'wrap_free_constructors', 'datatype_new', 'codatatype', 'primcorec', 'primcorecursive' are now part of theory "Main". Theory renamings: FunDef.thy ~> Fun_Def.thy (and Fun_Def_Base.thy) Library/Wfrec.thy ~> Wfrec.thy Library/Zorn.thy ~> Zorn.thy Cardinals/Order_Relation.thy ~> Order_Relation.thy Library/Order_Union.thy ~> Cardinals/Order_Union.thy Cardinals/Cardinal_Arithmetic_Base.thy ~> BNF_Cardinal_Arithmetic.thy Cardinals/Cardinal_Order_Relation_Base.thy ~> BNF_Cardinal_Order_Relation.thy Cardinals/Constructions_on_Wellorders_Base.thy ~> BNF_Constructions_on_Wellorders.thy Cardinals/Wellorder_Embedding_Base.thy ~> BNF_Wellorder_Embedding.thy Cardinals/Wellorder_Relation_Base.thy ~> BNF_Wellorder_Relation.thy BNF/Ctr_Sugar.thy ~> Ctr_Sugar.thy BNF/Basic_BNFs.thy ~> Basic_BNFs.thy BNF/BNF_Comp.thy ~> BNF_Comp.thy BNF/BNF_Def.thy ~> BNF_Def.thy BNF/BNF_FP_Base.thy ~> BNF_FP_Base.thy BNF/BNF_GFP.thy ~> BNF_GFP.thy BNF/BNF_LFP.thy ~> BNF_LFP.thy BNF/BNF_Util.thy ~> BNF_Util.thy BNF/Coinduction.thy ~> Coinduction.thy BNF/More_BNFs.thy ~> Library/More_BNFs.thy BNF/Countable_Type.thy ~> Library/Countable_Set_Type.thy BNF/Examples/* ~> BNF_Examples/* New theories: Wellorder_Extension.thy (split from Zorn.thy) Library/Cardinal_Notations.thy Library/BNF_Axomatization.thy BNF_Examples/Misc_Primcorec.thy BNF_Examples/Stream_Processor.thy Discontinued theories: BNF/BNF.thy BNF/Equiv_Relations_More.thy INCOMPATIBILITY. * New (co)datatype package: - Command 'primcorec' is fully implemented. - Command 'datatype_new' generates size functions ("size_xxx" and "size") as required by 'fun'. - BNFs are integrated with the Lifting tool and new-style (co)datatypes with Transfer. - Renamed commands: datatype_new_compat ~> datatype_compat primrec_new ~> primrec wrap_free_constructors ~> free_constructors INCOMPATIBILITY. - The generated constants "xxx_case" and "xxx_rec" have been renamed "case_xxx" and "rec_xxx" (e.g., "prod_case" ~> "case_prod"). INCOMPATIBILITY. - The constant "xxx_(un)fold" and related theorems are no longer generated. Use "xxx_(co)rec" or define "xxx_(un)fold" manually using "prim(co)rec". INCOMPATIBILITY. - No discriminators are generated for nullary constructors by default, eliminating the need for the odd "=:" syntax. INCOMPATIBILITY. - No discriminators or selectors are generated by default by "datatype_new", unless custom names are specified or the new "discs_sels" option is passed. INCOMPATIBILITY. * Old datatype package: - The generated theorems "xxx.cases" and "xxx.recs" have been renamed "xxx.case" and "xxx.rec" (e.g., "sum.cases" -> "sum.case"). INCOMPATIBILITY. - The generated constants "xxx_case", "xxx_rec", and "xxx_size" have been renamed "case_xxx", "rec_xxx", and "size_xxx" (e.g., "prod_case" ~> "case_prod"). INCOMPATIBILITY. * The types "'a list" and "'a option", their set and map functions, their relators, and their selectors are now produced using the new BNF-based datatype package. Renamed constants: Option.set ~> set_option Option.map ~> map_option option_rel ~> rel_option Renamed theorems: set_def ~> set_rec[abs_def] map_def ~> map_rec[abs_def] Option.map_def ~> map_option_case[abs_def] (with "case_option" instead of "rec_option") option.recs ~> option.rec list_all2_def ~> list_all2_iff set.simps ~> set_simps (or the slightly different "list.set") map.simps ~> list.map hd.simps ~> list.sel(1) tl.simps ~> list.sel(2-3) the.simps ~> option.sel INCOMPATIBILITY. * The following map functions and relators have been renamed: sum_map ~> map_sum map_pair ~> map_prod prod_rel ~> rel_prod sum_rel ~> rel_sum fun_rel ~> rel_fun set_rel ~> rel_set filter_rel ~> rel_filter fset_rel ~> rel_fset (in "src/HOL/Library/FSet.thy") cset_rel ~> rel_cset (in "src/HOL/Library/Countable_Set_Type.thy") vset ~> rel_vset (in "src/HOL/Library/Quotient_Set.thy") INCOMPATIBILITY. * Lifting and Transfer: - a type variable as a raw type is supported - stronger reflexivity prover - rep_eq is always generated by lift_definition - setup for Lifting/Transfer is now automated for BNFs + holds for BNFs that do not contain a dead variable + relator_eq, relator_mono, relator_distr, relator_domain, relator_eq_onp, quot_map, transfer rules for bi_unique, bi_total, right_unique, right_total, left_unique, left_total are proved automatically + definition of a predicator is generated automatically + simplification rules for a predicator definition are proved automatically for datatypes - consolidation of the setup of Lifting/Transfer + property that a relator preservers reflexivity is not needed any more Minor INCOMPATIBILITY. + left_total and left_unique rules are now transfer rules (reflexivity_rule attribute not needed anymore) INCOMPATIBILITY. + Domainp does not have to be a separate assumption in relator_domain theorems (=> more natural statement) INCOMPATIBILITY. - registration of code equations is more robust Potential INCOMPATIBILITY. - respectfulness proof obligation is preprocessed to a more readable form Potential INCOMPATIBILITY. - eq_onp is always unfolded in respectfulness proof obligation Potential INCOMPATIBILITY. - unregister lifting setup for Code_Numeral.integer and Code_Numeral.natural Potential INCOMPATIBILITY. - Lifting.invariant -> eq_onp INCOMPATIBILITY. * New internal SAT solver "cdclite" that produces models and proof traces. This solver replaces the internal SAT solvers "enumerate" and "dpll". Applications that explicitly used one of these two SAT solvers should use "cdclite" instead. In addition, "cdclite" is now the default SAT solver for the "sat" and "satx" proof methods and corresponding tactics; the old default can be restored using "declare [[sat_solver = zchaff_with_proofs]]". Minor INCOMPATIBILITY. * SMT module: A new version of the SMT module, temporarily called "SMT2", uses SMT-LIB 2 and supports recent versions of Z3 (e.g., 4.3). The new proof method is called "smt2". CVC3 and CVC4 are also supported as oracles. Yices is no longer supported, because no version of the solver can handle both SMT-LIB 2 and quantifiers. * Activation of Z3 now works via "z3_non_commercial" system option (without requiring restart), instead of former settings variable "Z3_NON_COMMERCIAL". The option can be edited in Isabelle/jEdit menu Plugin Options / Isabelle / General. * Sledgehammer: - Z3 can now produce Isar proofs. - MaSh overhaul: . New SML-based learning algorithms eliminate the dependency on Python and increase performance and reliability. . MaSh and MeSh are now used by default together with the traditional MePo (Meng-Paulson) relevance filter. To disable MaSh, set the "MaSh" system option in Isabelle/jEdit Plugin Options / Isabelle / General to "none". - New option: smt_proofs - Renamed options: isar_compress ~> compress isar_try0 ~> try0 INCOMPATIBILITY. * Removed solvers remote_cvc3 and remote_z3. Use cvc3 and z3 instead. * Nitpick: - Fixed soundness bug whereby mutually recursive datatypes could take infinite values. - Fixed soundness bug with low-level number functions such as "Abs_Integ" and "Rep_Integ". - Removed "std" option. - Renamed "show_datatypes" to "show_types" and "hide_datatypes" to "hide_types". * Metis: Removed legacy proof method 'metisFT'. Use 'metis (full_types)' instead. INCOMPATIBILITY. * Try0: Added 'algebra' and 'meson' to the set of proof methods. * Adjustion of INF and SUP operations: - Elongated constants INFI and SUPR to INFIMUM and SUPREMUM. - Consolidated theorem names containing INFI and SUPR: have INF and SUP instead uniformly. - More aggressive normalization of expressions involving INF and Inf or SUP and Sup. - INF_image and SUP_image do not unfold composition. - Dropped facts INF_comp, SUP_comp. - Default congruence rules strong_INF_cong and strong_SUP_cong, with simplifier implication in premises. Generalize and replace former INT_cong, SUP_cong INCOMPATIBILITY. * SUP and INF generalized to conditionally_complete_lattice. * Swapped orientation of facts image_comp and vimage_comp: image_compose ~> image_comp [symmetric] image_comp ~> image_comp [symmetric] vimage_compose ~> vimage_comp [symmetric] vimage_comp ~> vimage_comp [symmetric] INCOMPATIBILITY. * Theory reorganization: split of Big_Operators.thy into Groups_Big.thy and Lattices_Big.thy. * Consolidated some facts about big group operators: setsum_0' ~> setsum.neutral setsum_0 ~> setsum.neutral_const setsum_addf ~> setsum.distrib setsum_cartesian_product ~> setsum.cartesian_product setsum_cases ~> setsum.If_cases setsum_commute ~> setsum.commute setsum_cong ~> setsum.cong setsum_delta ~> setsum.delta setsum_delta' ~> setsum.delta' setsum_diff1' ~> setsum.remove setsum_empty ~> setsum.empty setsum_infinite ~> setsum.infinite setsum_insert ~> setsum.insert setsum_inter_restrict'' ~> setsum.inter_filter setsum_mono_zero_cong_left ~> setsum.mono_neutral_cong_left setsum_mono_zero_cong_right ~> setsum.mono_neutral_cong_right setsum_mono_zero_left ~> setsum.mono_neutral_left setsum_mono_zero_right ~> setsum.mono_neutral_right setsum_reindex ~> setsum.reindex setsum_reindex_cong ~> setsum.reindex_cong setsum_reindex_nonzero ~> setsum.reindex_nontrivial setsum_restrict_set ~> setsum.inter_restrict setsum_Plus ~> setsum.Plus setsum_setsum_restrict ~> setsum.commute_restrict setsum_Sigma ~> setsum.Sigma setsum_subset_diff ~> setsum.subset_diff setsum_Un_disjoint ~> setsum.union_disjoint setsum_UN_disjoint ~> setsum.UNION_disjoint setsum_Un_Int ~> setsum.union_inter setsum_Union_disjoint ~> setsum.Union_disjoint setsum_UNION_zero ~> setsum.Union_comp setsum_Un_zero ~> setsum.union_inter_neutral strong_setprod_cong ~> setprod.strong_cong strong_setsum_cong ~> setsum.strong_cong setprod_1' ~> setprod.neutral setprod_1 ~> setprod.neutral_const setprod_cartesian_product ~> setprod.cartesian_product setprod_cong ~> setprod.cong setprod_delta ~> setprod.delta setprod_delta' ~> setprod.delta' setprod_empty ~> setprod.empty setprod_infinite ~> setprod.infinite setprod_insert ~> setprod.insert setprod_mono_one_cong_left ~> setprod.mono_neutral_cong_left setprod_mono_one_cong_right ~> setprod.mono_neutral_cong_right setprod_mono_one_left ~> setprod.mono_neutral_left setprod_mono_one_right ~> setprod.mono_neutral_right setprod_reindex ~> setprod.reindex setprod_reindex_cong ~> setprod.reindex_cong setprod_reindex_nonzero ~> setprod.reindex_nontrivial setprod_Sigma ~> setprod.Sigma setprod_subset_diff ~> setprod.subset_diff setprod_timesf ~> setprod.distrib setprod_Un2 ~> setprod.union_diff2 setprod_Un_disjoint ~> setprod.union_disjoint setprod_UN_disjoint ~> setprod.UNION_disjoint setprod_Un_Int ~> setprod.union_inter setprod_Union_disjoint ~> setprod.Union_disjoint setprod_Un_one ~> setprod.union_inter_neutral Dropped setsum_cong2 (simple variant of setsum.cong). Dropped setsum_inter_restrict' (simple variant of setsum.inter_restrict) Dropped setsum_reindex_id, setprod_reindex_id (simple variants of setsum.reindex [symmetric], setprod.reindex [symmetric]). INCOMPATIBILITY. * Abolished slightly odd global lattice interpretation for min/max. Fact consolidations: min_max.inf_assoc ~> min.assoc min_max.inf_commute ~> min.commute min_max.inf_left_commute ~> min.left_commute min_max.inf_idem ~> min.idem min_max.inf_left_idem ~> min.left_idem min_max.inf_right_idem ~> min.right_idem min_max.sup_assoc ~> max.assoc min_max.sup_commute ~> max.commute min_max.sup_left_commute ~> max.left_commute min_max.sup_idem ~> max.idem min_max.sup_left_idem ~> max.left_idem min_max.sup_inf_distrib1 ~> max_min_distrib2 min_max.sup_inf_distrib2 ~> max_min_distrib1 min_max.inf_sup_distrib1 ~> min_max_distrib2 min_max.inf_sup_distrib2 ~> min_max_distrib1 min_max.distrib ~> min_max_distribs min_max.inf_absorb1 ~> min.absorb1 min_max.inf_absorb2 ~> min.absorb2 min_max.sup_absorb1 ~> max.absorb1 min_max.sup_absorb2 ~> max.absorb2 min_max.le_iff_inf ~> min.absorb_iff1 min_max.le_iff_sup ~> max.absorb_iff2 min_max.inf_le1 ~> min.cobounded1 min_max.inf_le2 ~> min.cobounded2 le_maxI1, min_max.sup_ge1 ~> max.cobounded1 le_maxI2, min_max.sup_ge2 ~> max.cobounded2 min_max.le_infI1 ~> min.coboundedI1 min_max.le_infI2 ~> min.coboundedI2 min_max.le_supI1 ~> max.coboundedI1 min_max.le_supI2 ~> max.coboundedI2 min_max.less_infI1 ~> min.strict_coboundedI1 min_max.less_infI2 ~> min.strict_coboundedI2 min_max.less_supI1 ~> max.strict_coboundedI1 min_max.less_supI2 ~> max.strict_coboundedI2 min_max.inf_mono ~> min.mono min_max.sup_mono ~> max.mono min_max.le_infI, min_max.inf_greatest ~> min.boundedI min_max.le_supI, min_max.sup_least ~> max.boundedI min_max.le_inf_iff ~> min.bounded_iff min_max.le_sup_iff ~> max.bounded_iff For min_max.inf_sup_aci, prefer (one of) min.commute, min.assoc, min.left_commute, min.left_idem, max.commute, max.assoc, max.left_commute, max.left_idem directly. For min_max.inf_sup_ord, prefer (one of) min.cobounded1, min.cobounded2, max.cobounded1m max.cobounded2 directly. For min_ac or max_ac, prefer more general collection ac_simps. INCOMPATIBILITY. * Theorem disambiguation Inf_le_Sup (on finite sets) ~> Inf_fin_le_Sup_fin. INCOMPATIBILITY. * Qualified constant names Wellfounded.acc, Wellfounded.accp. INCOMPATIBILITY. * Fact generalization and consolidation: neq_one_mod_two, mod_2_not_eq_zero_eq_one_int ~> not_mod_2_eq_0_eq_1 INCOMPATIBILITY. * Purely algebraic definition of even. Fact generalization and consolidation: nat_even_iff_2_dvd, int_even_iff_2_dvd ~> even_iff_2_dvd even_zero_(nat|int) ~> even_zero INCOMPATIBILITY. * Abolished neg_numeral. - Canonical representation for minus one is "- 1". - Canonical representation for other negative numbers is "- (numeral _)". - When devising rule sets for number calculation, consider the following canonical cases: 0, 1, numeral _, - 1, - numeral _. - HOLogic.dest_number also recognizes numerals in non-canonical forms like "numeral One", "- numeral One", "- 0" and even "- ... - _". - Syntax for negative numerals is mere input syntax. INCOMPATIBILITY. * Reduced name variants for rules on associativity and commutativity: add_assoc ~> add.assoc add_commute ~> add.commute add_left_commute ~> add.left_commute mult_assoc ~> mult.assoc mult_commute ~> mult.commute mult_left_commute ~> mult.left_commute nat_add_assoc ~> add.assoc nat_add_commute ~> add.commute nat_add_left_commute ~> add.left_commute nat_mult_assoc ~> mult.assoc nat_mult_commute ~> mult.commute eq_assoc ~> iff_assoc eq_left_commute ~> iff_left_commute INCOMPATIBILITY. * Fact collections add_ac and mult_ac are considered old-fashioned. Prefer ac_simps instead, or specify rules (add|mult).(assoc|commute|left_commute) individually. * Elimination of fact duplicates: equals_zero_I ~> minus_unique diff_eq_0_iff_eq ~> right_minus_eq nat_infinite ~> infinite_UNIV_nat int_infinite ~> infinite_UNIV_int INCOMPATIBILITY. * Fact name consolidation: diff_def, diff_minus, ab_diff_minus ~> diff_conv_add_uminus minus_le_self_iff ~> neg_less_eq_nonneg le_minus_self_iff ~> less_eq_neg_nonpos neg_less_nonneg ~> neg_less_pos less_minus_self_iff ~> less_neg_neg [simp] INCOMPATIBILITY. * More simplification rules on unary and binary minus: add_diff_cancel, add_diff_cancel_left, add_le_same_cancel1, add_le_same_cancel2, add_less_same_cancel1, add_less_same_cancel2, add_minus_cancel, diff_add_cancel, le_add_same_cancel1, le_add_same_cancel2, less_add_same_cancel1, less_add_same_cancel2, minus_add_cancel, uminus_add_conv_diff. These correspondingly have been taken away from fact collections algebra_simps and field_simps. INCOMPATIBILITY. To restore proofs, the following patterns are helpful: a) Arbitrary failing proof not involving "diff_def": Consider simplification with algebra_simps or field_simps. b) Lifting rules from addition to subtraction: Try with "using of [... "- _" ...]" by simp". c) Simplification with "diff_def": just drop "diff_def". Consider simplification with algebra_simps or field_simps; or the brute way with "simp add: diff_conv_add_uminus del: add_uminus_conv_diff". * Introduce bdd_above and bdd_below in theory Conditionally_Complete_Lattices, use them instead of explicitly stating boundedness of sets. * ccpo.admissible quantifies only over non-empty chains to allow more syntax-directed proof rules; the case of the empty chain shows up as additional case in fixpoint induction proofs. INCOMPATIBILITY. * Removed and renamed theorems in Series: summable_le ~> suminf_le suminf_le ~> suminf_le_const series_pos_le ~> setsum_le_suminf series_pos_less ~> setsum_less_suminf suminf_ge_zero ~> suminf_nonneg suminf_gt_zero ~> suminf_pos suminf_gt_zero_iff ~> suminf_pos_iff summable_sumr_LIMSEQ_suminf ~> summable_LIMSEQ suminf_0_le ~> suminf_nonneg [rotate] pos_summable ~> summableI_nonneg_bounded ratio_test ~> summable_ratio_test removed series_zero, replaced by sums_finite removed auxiliary lemmas: sumr_offset, sumr_offset2, sumr_offset3, sumr_offset4, sumr_group, half, le_Suc_ex_iff, lemma_realpow_diff_sumr, real_setsum_nat_ivl_bounded, summable_le2, ratio_test_lemma2, sumr_minus_one_realpow_zerom, sumr_one_lb_realpow_zero, summable_convergent_sumr_iff, sumr_diff_mult_const INCOMPATIBILITY. * Replace (F)DERIV syntax by has_derivative: - "(f has_derivative f') (at x within s)" replaces "FDERIV f x : s : f'" - "(f has_field_derivative f') (at x within s)" replaces "DERIV f x : s : f'" - "f differentiable at x within s" replaces "_ differentiable _ in _" syntax - removed constant isDiff - "DERIV f x : f'" and "FDERIV f x : f'" syntax is only available as input syntax. - "DERIV f x : s : f'" and "FDERIV f x : s : f'" syntax removed. - Renamed FDERIV_... lemmas to has_derivative_... - renamed deriv (the syntax constant used for "DERIV _ _ :> _") to DERIV - removed DERIV_intros, has_derivative_eq_intros - introduced derivative_intros and deriative_eq_intros which includes now rules for DERIV, has_derivative and has_vector_derivative. - Other renamings: differentiable_def ~> real_differentiable_def differentiableE ~> real_differentiableE fderiv_def ~> has_derivative_at field_fderiv_def ~> field_has_derivative_at isDiff_der ~> differentiable_def deriv_fderiv ~> has_field_derivative_def deriv_def ~> DERIV_def INCOMPATIBILITY. * Include more theorems in continuous_intros. Remove the continuous_on_intros, isCont_intros collections, these facts are now in continuous_intros. * Theorems about complex numbers are now stated only using Re and Im, the Complex constructor is not used anymore. It is possible to use primcorec to defined the behaviour of a complex-valued function. Removed theorems about the Complex constructor from the simpset, they are available as the lemma collection legacy_Complex_simps. This especially removes i_complex_of_real: "ii * complex_of_real r = Complex 0 r". Instead the reverse direction is supported with Complex_eq: "Complex a b = a + \ * b" Moved csqrt from Fundamental_Algebra_Theorem to Complex. Renamings: Re/Im ~> complex.sel complex_Re/Im_zero ~> zero_complex.sel complex_Re/Im_add ~> plus_complex.sel complex_Re/Im_minus ~> uminus_complex.sel complex_Re/Im_diff ~> minus_complex.sel complex_Re/Im_one ~> one_complex.sel complex_Re/Im_mult ~> times_complex.sel complex_Re/Im_inverse ~> inverse_complex.sel complex_Re/Im_scaleR ~> scaleR_complex.sel complex_Re/Im_i ~> ii.sel complex_Re/Im_cnj ~> cnj.sel Re/Im_cis ~> cis.sel complex_divide_def ~> divide_complex_def complex_norm_def ~> norm_complex_def cmod_def ~> norm_complex_de Removed theorems: complex_zero_def complex_add_def complex_minus_def complex_diff_def complex_one_def complex_mult_def complex_inverse_def complex_scaleR_def INCOMPATIBILITY. * Theory Lubs moved HOL image to HOL-Library. It is replaced by Conditionally_Complete_Lattices. INCOMPATIBILITY. * HOL-Library: new theory src/HOL/Library/Tree.thy. * HOL-Library: removed theory src/HOL/Library/Kleene_Algebra.thy; it is subsumed by session Kleene_Algebra in AFP. * HOL-Library / theory RBT: various constants and facts are hidden; lifting setup is unregistered. INCOMPATIBILITY. * HOL-Cardinals: new theory src/HOL/Cardinals/Ordinal_Arithmetic.thy. * HOL-Word: bit representations prefer type bool over type bit. INCOMPATIBILITY. * HOL-Word: - Abandoned fact collection "word_arith_alts", which is a duplicate of "word_arith_wis". - Dropped first (duplicated) element in fact collections "sint_word_ariths", "word_arith_alts", "uint_word_ariths", "uint_word_arith_bintrs". * HOL-Number_Theory: - consolidated the proofs of the binomial theorem - the function fib is again of type nat => nat and not overloaded - no more references to Old_Number_Theory in the HOL libraries (except the AFP) INCOMPATIBILITY. * HOL-Multivariate_Analysis: - Type class ordered_real_vector for ordered vector spaces. - New theory Complex_Basic_Analysis defining complex derivatives, holomorphic functions, etc., ported from HOL Light's canal.ml. - Changed order of ordered_euclidean_space to be compatible with pointwise ordering on products. Therefore instance of conditionally_complete_lattice and ordered_real_vector. INCOMPATIBILITY: use box instead of greaterThanLessThan or explicit set-comprehensions with eucl_less for other (half-)open intervals. - removed dependencies on type class ordered_euclidean_space with introduction of "cbox" on euclidean_space - renamed theorems: interval ~> box mem_interval ~> mem_box interval_eq_empty ~> box_eq_empty interval_ne_empty ~> box_ne_empty interval_sing(1) ~> cbox_sing interval_sing(2) ~> box_sing subset_interval_imp ~> subset_box_imp subset_interval ~> subset_box open_interval ~> open_box closed_interval ~> closed_cbox interior_closed_interval ~> interior_cbox bounded_closed_interval ~> bounded_cbox compact_interval ~> compact_cbox bounded_subset_closed_interval_symmetric ~> bounded_subset_cbox_symmetric bounded_subset_closed_interval ~> bounded_subset_cbox mem_interval_componentwiseI ~> mem_box_componentwiseI convex_box ~> convex_prod rel_interior_real_interval ~> rel_interior_real_box convex_interval ~> convex_box convex_hull_eq_real_interval ~> convex_hull_eq_real_cbox frechet_derivative_within_closed_interval ~> frechet_derivative_within_cbox content_closed_interval' ~> content_cbox' elementary_subset_interval ~> elementary_subset_box diameter_closed_interval ~> diameter_cbox frontier_closed_interval ~> frontier_cbox frontier_open_interval ~> frontier_box bounded_subset_open_interval_symmetric ~> bounded_subset_box_symmetric closure_open_interval ~> closure_box open_closed_interval_convex ~> open_cbox_convex open_interval_midpoint ~> box_midpoint content_image_affinity_interval ~> content_image_affinity_cbox is_interval_interval ~> is_interval_cbox + is_interval_box + is_interval_closed_interval bounded_interval ~> bounded_closed_interval + bounded_boxes - respective theorems for intervals over the reals: content_closed_interval + content_cbox has_integral + has_integral_real fine_division_exists + fine_division_exists_real has_integral_null + has_integral_null_real tagged_division_union_interval + tagged_division_union_interval_real has_integral_const + has_integral_const_real integral_const + integral_const_real has_integral_bound + has_integral_bound_real integrable_continuous + integrable_continuous_real integrable_subinterval + integrable_subinterval_real has_integral_reflect_lemma + has_integral_reflect_lemma_real integrable_reflect + integrable_reflect_real integral_reflect + integral_reflect_real image_affinity_interval + image_affinity_cbox image_smult_interval + image_smult_cbox integrable_const + integrable_const_ivl integrable_on_subinterval + integrable_on_subcbox - renamed theorems: derivative_linear ~> has_derivative_bounded_linear derivative_is_linear ~> has_derivative_linear bounded_linear_imp_linear ~> bounded_linear.linear * HOL-Probability: - Renamed positive_integral to nn_integral: . Renamed all lemmas "*positive_integral*" to *nn_integral*" positive_integral_positive ~> nn_integral_nonneg . Renamed abbreviation integral\<^sup>P to integral\<^sup>N. - replaced the Lebesgue integral on real numbers by the more general Bochner integral for functions into a real-normed vector space. integral_zero ~> integral_zero / integrable_zero integral_minus ~> integral_minus / integrable_minus integral_add ~> integral_add / integrable_add integral_diff ~> integral_diff / integrable_diff integral_setsum ~> integral_setsum / integrable_setsum integral_multc ~> integral_mult_left / integrable_mult_left integral_cmult ~> integral_mult_right / integrable_mult_right integral_triangle_inequality~> integral_norm_bound integrable_nonneg ~> integrableI_nonneg integral_positive ~> integral_nonneg_AE integrable_abs_iff ~> integrable_abs_cancel positive_integral_lim_INF ~> nn_integral_liminf lebesgue_real_affine ~> lborel_real_affine borel_integral_has_integral ~> has_integral_lebesgue_integral integral_indicator ~> integral_real_indicator / integrable_real_indicator positive_integral_fst ~> nn_integral_fst' positive_integral_fst_measurable ~> nn_integral_fst positive_integral_snd_measurable ~> nn_integral_snd integrable_fst_measurable ~> integral_fst / integrable_fst / AE_integrable_fst integrable_snd_measurable ~> integral_snd / integrable_snd / AE_integrable_snd integral_monotone_convergence ~> integral_monotone_convergence / integrable_monotone_convergence integral_monotone_convergence_at_top ~> integral_monotone_convergence_at_top / integrable_monotone_convergence_at_top has_integral_iff_positive_integral_lebesgue ~> has_integral_iff_has_bochner_integral_lebesgue_nonneg lebesgue_integral_has_integral ~> has_integral_integrable_lebesgue_nonneg positive_integral_lebesgue_has_integral ~> integral_has_integral_lebesgue_nonneg / integrable_has_integral_lebesgue_nonneg lebesgue_integral_real_affine ~> nn_integral_real_affine has_integral_iff_positive_integral_lborel ~> integral_has_integral_nonneg / integrable_has_integral_nonneg The following theorems where removed: lebesgue_integral_nonneg lebesgue_integral_uminus lebesgue_integral_cmult lebesgue_integral_multc lebesgue_integral_cmult_nonneg integral_cmul_indicator integral_real - Formalized properties about exponentially, Erlang, and normal distributed random variables. * HOL-Decision_Procs: Separate command 'approximate' for approximative computation in src/HOL/Decision_Procs/Approximation. Minor INCOMPATIBILITY. *** Scala *** * The signature and semantics of Document.Snapshot.cumulate_markup / select_markup have been clarified. Markup is now traversed in the order of reports given by the prover: later markup is usually more specific and may override results accumulated so far. The elements guard is mandatory and checked precisely. Subtle INCOMPATIBILITY. * Substantial reworking of internal PIDE protocol communication channels. INCOMPATIBILITY. *** ML *** * Subtle change of semantics of Thm.eq_thm: theory stamps are not compared (according to Thm.thm_ord), but assumed to be covered by the current background theory. Thus equivalent data produced in different branches of the theory graph usually coincides (e.g. relevant for theory merge). Note that the softer Thm.eq_thm_prop is often more appropriate than Thm.eq_thm. * Proper context for basic Simplifier operations: rewrite_rule, rewrite_goals_rule, rewrite_goals_tac etc. INCOMPATIBILITY, need to pass runtime Proof.context (and ensure that the simplified entity actually belongs to it). * Proper context discipline for read_instantiate and instantiate_tac: variables that are meant to become schematic need to be given as fixed, and are generalized by the explicit context of local variables. This corresponds to Isar attributes "where" and "of" with 'for' declaration. INCOMPATIBILITY, also due to potential change of indices of schematic variables. * Moved ML_Compiler.exn_trace and other operations on exceptions to structure Runtime. Minor INCOMPATIBILITY. * Discontinued old Toplevel.debug in favour of system option "ML_exception_trace", which may be also declared within the context via "declare [[ML_exception_trace = true]]". Minor INCOMPATIBILITY. * Renamed configuration option "ML_trace" to "ML_source_trace". Minor INCOMPATIBILITY. * Configuration option "ML_print_depth" controls the pretty-printing depth of the ML compiler within the context. The old print_depth in ML is still available as default_print_depth, but rarely used. Minor INCOMPATIBILITY. * Toplevel function "use" refers to raw ML bootstrap environment, without Isar context nor antiquotations. Potential INCOMPATIBILITY. Note that 'ML_file' is the canonical command to load ML files into the formal context. * Simplified programming interface to define ML antiquotations, see structure ML_Antiquotation. Minor INCOMPATIBILITY. * ML antiquotation @{here} refers to its source position, which is occasionally useful for experimentation and diagnostic purposes. * ML antiquotation @{path} produces a Path.T value, similarly to Path.explode, but with compile-time check against the file-system and some PIDE markup. Note that unlike theory source, ML does not have a well-defined master directory, so an absolute symbolic path specification is usually required, e.g. "~~/src/HOL". * ML antiquotation @{print} inlines a function to print an arbitrary ML value, which is occasionally useful for diagnostic or demonstration purposes. *** System *** * Proof General with its traditional helper scripts is now an optional Isabelle component, e.g. see ProofGeneral-4.2-2 from the Isabelle component repository http://isabelle.in.tum.de/components/. Note that the "system" manual provides general explanations about add-on components, especially those that are not bundled with the release. * The raw Isabelle process executable has been renamed from "isabelle-process" to "isabelle_process", which conforms to common shell naming conventions, and allows to define a shell function within the Isabelle environment to avoid dynamic path lookup. Rare incompatibility for old tools that do not use the ISABELLE_PROCESS settings variable. * Former "isabelle tty" has been superseded by "isabelle console", with implicit build like "isabelle jedit", and without the mostly obsolete Isar TTY loop. * Simplified "isabelle display" tool. Settings variables DVI_VIEWER and PDF_VIEWER now refer to the actual programs, not shell command-lines. Discontinued option -c: invocation may be asynchronous via desktop environment, without any special precautions. Potential INCOMPATIBILITY with ambitious private settings. * Removed obsolete "isabelle unsymbolize". Note that the usual format for email communication is the Unicode rendering of Isabelle symbols, as produced by Isabelle/jEdit, for example. * Removed obsolete tool "wwwfind". Similar functionality may be integrated into Isabelle/jEdit eventually. * Improved 'display_drafts' concerning desktop integration and repeated invocation in PIDE front-end: re-use single file $ISABELLE_HOME_USER/tmp/drafts.pdf and corresponding views. * Session ROOT specifications require explicit 'document_files' for robust dependencies on LaTeX sources. Only these explicitly given files are copied to the document output directory, before document processing is started. * Windows: support for regular TeX installation (e.g. MiKTeX) instead of TeX Live from Cygwin. New in Isabelle2013-2 (December 2013) ------------------------------------- *** Prover IDE -- Isabelle/Scala/jEdit *** * More robust editing of running commands with internal forks, e.g. non-terminating 'by' steps. * More relaxed Sledgehammer panel: avoid repeated application of query after edits surrounding the command location. * More status information about commands that are interrupted accidentally (via physical event or Poly/ML runtime system signal, e.g. out-of-memory). *** System *** * More robust termination of external processes managed by Isabelle/ML: support cancellation of tasks within the range of milliseconds, as required for PIDE document editing with automatically tried tools (e.g. Sledgehammer). * Reactivated Isabelle/Scala kill command for external processes on Mac OS X, which was accidentally broken in Isabelle2013-1 due to a workaround for some Debian/Ubuntu Linux versions from 2013. New in Isabelle2013-1 (November 2013) ------------------------------------- *** General *** * Discontinued obsolete 'uses' within theory header. Note that commands like 'ML_file' work without separate declaration of file dependencies. Minor INCOMPATIBILITY. * Discontinued redundant 'use' command, which was superseded by 'ML_file' in Isabelle2013. Minor INCOMPATIBILITY. * Simplified subscripts within identifiers, using plain \<^sub> instead of the second copy \<^isub> and \<^isup>. Superscripts are only for literal tokens within notation; explicit mixfix annotations for consts or fixed variables may be used as fall-back for unusual names. Obsolete \ has been expanded to \<^sup>2 in Isabelle/HOL. INCOMPATIBILITY, use "isabelle update_sub_sup" to standardize symbols as a starting point for further manual cleanup. The ML reference variable "legacy_isub_isup" may be set as temporary workaround, to make the prover accept a subset of the old identifier syntax. * Document antiquotations: term style "isub" has been renamed to "sub". Minor INCOMPATIBILITY. * Uniform management of "quick_and_dirty" as system option (see also "isabelle options"), configuration option within the context (see also Config.get in Isabelle/ML), and attribute in Isabelle/Isar. Minor INCOMPATIBILITY, need to use more official Isabelle means to access quick_and_dirty, instead of historical poking into mutable reference. * Renamed command 'print_configs' to 'print_options'. Minor INCOMPATIBILITY. * Proper diagnostic command 'print_state'. Old 'pr' (with its implicit change of some global references) is retained for now as control command, e.g. for ProofGeneral 3.7.x. * Discontinued 'print_drafts' command with its old-fashioned PS output and Unix command-line print spooling. Minor INCOMPATIBILITY: use 'display_drafts' instead and print via the regular document viewer. * Updated and extended "isar-ref" and "implementation" manual, eliminated old "ref" manual. *** Prover IDE -- Isabelle/Scala/jEdit *** * New manual "jedit" for Isabelle/jEdit, see isabelle doc or Documentation panel. * Dockable window "Documentation" provides access to Isabelle documentation. * Dockable window "Find" provides query operations for formal entities (GUI front-end to 'find_theorems' command). * Dockable window "Sledgehammer" manages asynchronous / parallel sledgehammer runs over existing document sources, independently of normal editing and checking process. * Dockable window "Timing" provides an overview of relevant command timing information, depending on option jedit_timing_threshold. The same timing information is shown in the extended tooltip of the command keyword, when hovering the mouse over it while the CONTROL or COMMAND modifier is pressed. * Improved dockable window "Theories": Continuous checking of proof document (visible and required parts) may be controlled explicitly, using check box or shortcut "C+e ENTER". Individual theory nodes may be marked explicitly as required and checked in full, using check box or shortcut "C+e SPACE". * Improved completion mechanism, which is now managed by the Isabelle/jEdit plugin instead of SideKick. Refined table of Isabelle symbol abbreviations (see $ISABELLE_HOME/etc/symbols). * Standard jEdit keyboard shortcut C+b complete-word is remapped to isabelle.complete for explicit completion in Isabelle sources. INCOMPATIBILITY wrt. jEdit defaults, may have to invent new shortcuts to resolve conflict. * Improved support of various "minor modes" for Isabelle NEWS, options, session ROOT etc., with completion and SideKick tree view. * Strictly monotonic document update, without premature cancellation of running transactions that are still needed: avoid reset/restart of such command executions while editing. * Support for asynchronous print functions, as overlay to existing document content. * Support for automatic tools in HOL, which try to prove or disprove toplevel theorem statements. * Action isabelle.reset-font-size resets main text area font size according to Isabelle/Scala plugin option "jedit_font_reset_size" (see also "Plugin Options / Isabelle / General"). It can be bound to some keyboard shortcut by the user (e.g. C+0 and/or C+NUMPAD0). * File specifications in jEdit (e.g. file browser) may refer to $ISABELLE_HOME and $ISABELLE_HOME_USER on all platforms. Discontinued obsolete $ISABELLE_HOME_WINDOWS variable. * Improved support for Linux look-and-feel "GTK+", see also "Utilities / Global Options / Appearance". * Improved support of native Mac OS X functionality via "MacOSX" plugin, which is now enabled by default. *** Pure *** * Commands 'interpretation' and 'sublocale' are now target-sensitive. In particular, 'interpretation' allows for non-persistent interpretation within "context ... begin ... end" blocks offering a light-weight alternative to 'sublocale'. See "isar-ref" manual for details. * Improved locales diagnostic command 'print_dependencies'. * Discontinued obsolete 'axioms' command, which has been marked as legacy since Isabelle2009-2. INCOMPATIBILITY, use 'axiomatization' instead, while observing its uniform scope for polymorphism. * Discontinued empty name bindings in 'axiomatization'. INCOMPATIBILITY. * System option "proofs" has been discontinued. Instead the global state of Proofterm.proofs is persistently compiled into logic images as required, notably HOL-Proofs. Users no longer need to change Proofterm.proofs dynamically. Minor INCOMPATIBILITY. * Syntax translation functions (print_translation etc.) always depend on Proof.context. Discontinued former "(advanced)" option -- this is now the default. Minor INCOMPATIBILITY. * Former global reference trace_unify_fail is now available as configuration option "unify_trace_failure" (global context only). * SELECT_GOAL now retains the syntactic context of the overall goal state (schematic variables etc.). Potential INCOMPATIBILITY in rare situations. *** HOL *** * Stronger precedence of syntax for big intersection and union on sets, in accordance with corresponding lattice operations. INCOMPATIBILITY. * Notation "{p:A. P}" now allows tuple patterns as well. * Nested case expressions are now translated in a separate check phase rather than during parsing. The data for case combinators is separated from the datatype package. The declaration attribute "case_translation" can be used to register new case combinators: declare [[case_translation case_combinator constructor1 ... constructorN]] * Code generator: - 'code_printing' unifies 'code_const' / 'code_type' / 'code_class' / 'code_instance'. - 'code_identifier' declares name hints for arbitrary identifiers in generated code, subsuming 'code_modulename'. See the isar-ref manual for syntax diagrams, and the HOL theories for examples. * Attibute 'code': 'code' now declares concrete and abstract code equations uniformly. Use explicit 'code equation' and 'code abstract' to distinguish both when desired. * Discontinued theories Code_Integer and Efficient_Nat by a more fine-grain stack of theories Code_Target_Int, Code_Binary_Nat, Code_Target_Nat and Code_Target_Numeral. See the tutorial on code generation for details. INCOMPATIBILITY. * Numeric types are mapped by default to target language numerals: natural (replaces former code_numeral) and integer (replaces former code_int). Conversions are available as integer_of_natural / natural_of_integer / integer_of_nat / nat_of_integer (in HOL) and Code_Numeral.integer_of_natural / Code_Numeral.natural_of_integer (in ML). INCOMPATIBILITY. * Function package: For mutually recursive functions f and g, separate cases rules f.cases and g.cases are generated instead of unusable f_g.cases which exposed internal sum types. Potential INCOMPATIBILITY, in the case that the unusable rule was used nevertheless. * Function package: For each function f, new rules f.elims are generated, which eliminate equalities of the form "f x = t". * New command 'fun_cases' derives ad-hoc elimination rules for function equations as simplified instances of f.elims, analogous to inductive_cases. See ~~/src/HOL/ex/Fundefs.thy for some examples. * Lifting: - parametrized correspondence relations are now supported: + parametricity theorems for the raw term can be specified in the command lift_definition, which allow us to generate stronger transfer rules + setup_lifting generates stronger transfer rules if parametric correspondence relation can be generated + various new properties of the relator must be specified to support parametricity + parametricity theorem for the Quotient relation can be specified - setup_lifting generates domain rules for the Transfer package - stronger reflexivity prover of respectfulness theorems for type copies - ===> and --> are now local. The symbols can be introduced by interpreting the locale lifting_syntax (typically in an anonymous context) - Lifting/Transfer relevant parts of Library/Quotient_* are now in Main. Potential INCOMPATIBILITY - new commands for restoring and deleting Lifting/Transfer context: lifting_forget, lifting_update - the command print_quotmaps was renamed to print_quot_maps. INCOMPATIBILITY * Transfer: - better support for domains in Transfer: replace Domainp T by the actual invariant in a transferred goal - transfer rules can have as assumptions other transfer rules - Experimental support for transferring from the raw level to the abstract level: Transfer.transferred attribute - Attribute version of the transfer method: untransferred attribute * Reification and reflection: - Reification is now directly available in HOL-Main in structure "Reification". - Reflection now handles multiple lists with variables also. - The whole reflection stack has been decomposed into conversions. INCOMPATIBILITY. * Revised devices for recursive definitions over finite sets: - Only one fundamental fold combinator on finite set remains: Finite_Set.fold :: ('a => 'b => 'b) => 'b => 'a set => 'b This is now identity on infinite sets. - Locales ("mini packages") for fundamental definitions with Finite_Set.fold: folding, folding_idem. - Locales comm_monoid_set, semilattice_order_set and semilattice_neutr_order_set for big operators on sets. See theory Big_Operators for canonical examples. Note that foundational constants comm_monoid_set.F and semilattice_set.F correspond to former combinators fold_image and fold1 respectively. These are now gone. You may use those foundational constants as substitutes, but it is preferable to interpret the above locales accordingly. - Dropped class ab_semigroup_idem_mult (special case of lattice, no longer needed in connection with Finite_Set.fold etc.) - Fact renames: card.union_inter ~> card_Un_Int [symmetric] card.union_disjoint ~> card_Un_disjoint INCOMPATIBILITY. * Locale hierarchy for abstract orderings and (semi)lattices. * Complete_Partial_Order.admissible is defined outside the type class ccpo, but with mandatory prefix ccpo. Admissibility theorems lose the class predicate assumption or sort constraint when possible. INCOMPATIBILITY. * Introduce type class "conditionally_complete_lattice": Like a complete lattice but does not assume the existence of the top and bottom elements. Allows to generalize some lemmas about reals and extended reals. Removed SupInf and replaced it by the instantiation of conditionally_complete_lattice for real. Renamed lemmas about conditionally-complete lattice from Sup_... to cSup_... and from Inf_... to cInf_... to avoid hidding of similar complete lattice lemmas. * Introduce type class linear_continuum as combination of conditionally-complete lattices and inner dense linorders which have more than one element. INCOMPATIBILITY. * Introduced type classes order_top and order_bot. The old classes top and bot only contain the syntax without assumptions. INCOMPATIBILITY: Rename bot -> order_bot, top -> order_top * Introduce type classes "no_top" and "no_bot" for orderings without top and bottom elements. * Split dense_linorder into inner_dense_order and no_top, no_bot. * Complex_Main: Unify and move various concepts from HOL-Multivariate_Analysis to HOL-Complex_Main. - Introduce type class (lin)order_topology and linear_continuum_topology. Allows to generalize theorems about limits and order. Instances are reals and extended reals. - continuous and continuos_on from Multivariate_Analysis: "continuous" is the continuity of a function at a filter. "isCont" is now an abbrevitation: "isCont x f == continuous (at _) f". Generalized continuity lemmas from isCont to continuous on an arbitrary filter. - compact from Multivariate_Analysis. Use Bolzano's lemma to prove compactness of closed intervals on reals. Continuous functions attain infimum and supremum on compact sets. The inverse of a continuous function is continuous, when the function is continuous on a compact set. - connected from Multivariate_Analysis. Use it to prove the intermediate value theorem. Show connectedness of intervals on linear_continuum_topology). - first_countable_topology from Multivariate_Analysis. Is used to show equivalence of properties on the neighbourhood filter of x and on all sequences converging to x. - FDERIV: Definition of has_derivative moved to Deriv.thy. Moved theorems from Library/FDERIV.thy to Deriv.thy and base the definition of DERIV on FDERIV. Add variants of DERIV and FDERIV which are restricted to sets, i.e. to represent derivatives from left or right. - Removed the within-filter. It is replaced by the principal filter: F within X = inf F (principal X) - Introduce "at x within U" as a single constant, "at x" is now an abbreviation for "at x within UNIV" - Introduce named theorem collections tendsto_intros, continuous_intros, continuous_on_intros and FDERIV_intros. Theorems in tendsto_intros (or FDERIV_intros) are also available as tendsto_eq_intros (or FDERIV_eq_intros) where the right-hand side is replaced by a congruence rule. This allows to apply them as intro rules and then proving equivalence by the simplifier. - Restructured theories in HOL-Complex_Main: + Moved RealDef and RComplete into Real + Introduced Topological_Spaces and moved theorems about topological spaces, filters, limits and continuity to it + Renamed RealVector to Real_Vector_Spaces + Split Lim, SEQ, Series into Topological_Spaces, Real_Vector_Spaces, and Limits + Moved Ln and Log to Transcendental + Moved theorems about continuity from Deriv to Topological_Spaces - Remove various auxiliary lemmas. INCOMPATIBILITY. * Nitpick: - Added option "spy". - Reduce incidence of "too high arity" errors. * Sledgehammer: - Renamed option: isar_shrink ~> isar_compress INCOMPATIBILITY. - Added options "isar_try0", "spy". - Better support for "isar_proofs". - MaSh has been fined-tuned and now runs as a local server. * Improved support for ad hoc overloading of constants (see also isar-ref manual and ~~/src/HOL/ex/Adhoc_Overloading_Examples.thy). * Library/Polynomial.thy: - Use lifting for primitive definitions. - Explicit conversions from and to lists of coefficients, used for generated code. - Replaced recursion operator poly_rec by fold_coeffs. - Prefer pre-existing gcd operation for gcd. - Fact renames: poly_eq_iff ~> poly_eq_poly_eq_iff poly_ext ~> poly_eqI expand_poly_eq ~> poly_eq_iff IMCOMPATIBILITY. * New Library/Simps_Case_Conv.thy: Provides commands simps_of_case and case_of_simps to convert function definitions between a list of equations with patterns on the lhs and a single equation with case expressions on the rhs. See also Ex/Simps_Case_Conv_Examples.thy. * New Library/FSet.thy: type of finite sets defined as a subtype of sets defined by Lifting/Transfer. * Discontinued theory src/HOL/Library/Eval_Witness. INCOMPATIBILITY. * Consolidation of library theories on product orders: Product_Lattice ~> Product_Order -- pointwise order on products Product_ord ~> Product_Lexorder -- lexicographic order on products INCOMPATIBILITY. * Imperative-HOL: The MREC combinator is considered legacy and no longer included by default. INCOMPATIBILITY, use partial_function instead, or import theory Legacy_Mrec as a fallback. * HOL-Algebra: Discontinued theories ~~/src/HOL/Algebra/abstract and ~~/src/HOL/Algebra/poly. Existing theories should be based on ~~/src/HOL/Library/Polynomial instead. The latter provides integration with HOL's type classes for rings. INCOMPATIBILITY. * HOL-BNF: - Various improvements to BNF-based (co)datatype package, including new commands "primrec_new", "primcorec", and "datatype_new_compat", as well as documentation. See "datatypes.pdf" for details. - New "coinduction" method to avoid some boilerplate (compared to coinduct). - Renamed keywords: data ~> datatype_new codata ~> codatatype bnf_def ~> bnf - Renamed many generated theorems, including discs ~> disc map_comp' ~> map_comp map_id' ~> map_id sels ~> sel set_map' ~> set_map sets ~> set IMCOMPATIBILITY. *** ML *** * Spec_Check is a Quickcheck tool for Isabelle/ML. The ML function "check_property" allows to check specifications of the form "ALL x y z. prop x y z". See also ~~/src/Tools/Spec_Check/ with its Examples.thy in particular. * Improved printing of exception trace in Poly/ML 5.5.1, with regular tracing output in the command transaction context instead of physical stdout. See also Toplevel.debug, Toplevel.debugging and ML_Compiler.exn_trace. * ML type "theory" is now immutable, without any special treatment of drafts or linear updates (which could lead to "stale theory" errors in the past). Discontinued obsolete operations like Theory.copy, Theory.checkpoint, and the auxiliary type theory_ref. Minor INCOMPATIBILITY. * More uniform naming of goal functions for skipped proofs: Skip_Proof.prove ~> Goal.prove_sorry Skip_Proof.prove_global ~> Goal.prove_sorry_global Minor INCOMPATIBILITY. * Simplifier tactics and tools use proper Proof.context instead of historic type simpset. Old-style declarations like addsimps, addsimprocs etc. operate directly on Proof.context. Raw type simpset retains its use as snapshot of the main Simplifier context, using simpset_of and put_simpset on Proof.context. INCOMPATIBILITY -- port old tools by making them depend on (ctxt : Proof.context) instead of (ss : simpset), then turn (simpset_of ctxt) into ctxt. * Modifiers for classical wrappers (e.g. addWrapper, delWrapper) operate on Proof.context instead of claset, for uniformity with addIs, addEs, addDs etc. Note that claset_of and put_claset allow to manage clasets separately from the context. * Discontinued obsolete ML antiquotations @{claset} and @{simpset}. INCOMPATIBILITY, use @{context} instead. * Antiquotation @{theory_context A} is similar to @{theory A}, but presents the result as initial Proof.context. *** System *** * Discontinued obsolete isabelle usedir, mkdir, make -- superseded by "isabelle build" in Isabelle2013. INCOMPATIBILITY. * Discontinued obsolete isabelle-process options -f and -u (former administrative aliases of option -e). Minor INCOMPATIBILITY. * Discontinued obsolete isabelle print tool, and PRINT_COMMAND settings variable. * Discontinued ISABELLE_DOC_FORMAT settings variable and historic document formats: dvi.gz, ps, ps.gz -- the default document format is always pdf. * Isabelle settings variable ISABELLE_BUILD_JAVA_OPTIONS allows to specify global resources of the JVM process run by isabelle build. * Toplevel executable $ISABELLE_HOME/bin/isabelle_scala_script allows to run Isabelle/Scala source files as standalone programs. * Improved "isabelle keywords" tool (for old-style ProofGeneral keyword tables): use Isabelle/Scala operations, which inspect outer syntax without requiring to build sessions first. * Sessions may be organized via 'chapter' specifications in the ROOT file, which determines a two-level hierarchy of browser info. The old tree-like organization via implicit sub-session relation (with its tendency towards erratic fluctuation of URLs) has been discontinued. The default chapter is called "Unsorted". Potential INCOMPATIBILITY for HTML presentation of theories. New in Isabelle2013 (February 2013) ----------------------------------- *** General *** * Theorem status about oracles and unfinished/failed future proofs is no longer printed by default, since it is incompatible with incremental / parallel checking of the persistent document model. ML function Thm.peek_status may be used to inspect a snapshot of the ongoing evaluation process. Note that in batch mode --- notably isabelle build --- the system ensures that future proofs of all accessible theorems in the theory context are finished (as before). * Configuration option show_markup controls direct inlining of markup into the printed representation of formal entities --- notably type and sort constraints. This enables Prover IDE users to retrieve that information via tooltips in the output window, for example. * Command 'ML_file' evaluates ML text from a file directly within the theory, without any predeclaration via 'uses' in the theory header. * Old command 'use' command and corresponding keyword 'uses' in the theory header are legacy features and will be discontinued soon. Tools that load their additional source files may imitate the 'ML_file' implementation, such that the system can take care of dependencies properly. * Discontinued obsolete method fastsimp / tactic fast_simp_tac, which is called fastforce / fast_force_tac already since Isabelle2011-1. * Updated and extended "isar-ref" and "implementation" manual, reduced remaining material in old "ref" manual. * Improved support for auxiliary contexts that indicate block structure for specifications. Nesting of "context fixes ... context assumes ..." and "class ... context ...". * Attribute "consumes" allows a negative value as well, which is interpreted relatively to the total number of premises of the rule in the target context. This form of declaration is stable when exported from a nested 'context' with additional assumptions. It is the preferred form for definitional packages, notably cases/rules produced in HOL/inductive and HOL/function. * More informative error messages for Isar proof commands involving lazy enumerations (method applications etc.). * Refined 'help' command to retrieve outer syntax commands according to name patterns (with clickable results). *** Prover IDE -- Isabelle/Scala/jEdit *** * Parallel terminal proofs ('by') are enabled by default, likewise proofs that are built into packages like 'datatype', 'function'. This allows to "run ahead" checking the theory specifications on the surface, while the prover is still crunching on internal justifications. Unfinished / cancelled proofs are restarted as required to complete full proof checking eventually. * Improved output panel with tooltips, hyperlinks etc. based on the same Rich_Text_Area as regular Isabelle/jEdit buffers. Activation of tooltips leads to some window that supports the same recursively, which can lead to stacks of tooltips as the semantic document content is explored. ESCAPE closes the whole stack, individual windows may be closed separately, or detached to become independent jEdit dockables. * Improved support for commands that produce graph output: the text message contains a clickable area to open a new instance of the graph browser on demand. * More robust incremental parsing of outer syntax (partial comments, malformed symbols). Changing the balance of open/close quotes and comment delimiters works more conveniently with unfinished situations that frequently occur in user interaction. * More efficient painting and improved reactivity when editing large files. More scalable management of formal document content. * Smarter handling of tracing messages: prover process pauses after certain number of messages per command transaction, with some user dialog to stop or continue. This avoids swamping the front-end with potentially infinite message streams. * More plugin options and preferences, based on Isabelle/Scala. The jEdit plugin option panel provides access to some Isabelle/Scala options, including tuning parameters for editor reactivity and color schemes. * Dockable window "Symbols" provides some editing support for Isabelle symbols. * Dockable window "Monitor" shows ML runtime statistics. Note that continuous display of the chart slows down the system. * Improved editing support for control styles: subscript, superscript, bold, reset of style -- operating on single symbols or text selections. Cf. keyboard shortcuts C+e DOWN/UP/RIGHT/LEFT. * Actions isabelle.increase-font-size and isabelle.decrease-font-size adjust the main text area font size, and its derivatives for output, tooltips etc. Cf. keyboard shortcuts C-PLUS and C-MINUS, which often need to be adapted to local keyboard layouts. * More reactive completion popup by default: use \t (TAB) instead of \n (NEWLINE) to minimize intrusion into regular flow of editing. See also "Plugin Options / SideKick / General / Code Completion Options". * Implicit check and build dialog of the specified logic session image. For example, HOL, HOLCF, HOL-Nominal can be produced on demand, without bundling big platform-dependent heap images in the Isabelle distribution. * Uniform Java 7 platform on Linux, Mac OS X, Windows: recent updates from Oracle provide better multi-platform experience. This version is now bundled exclusively with Isabelle. *** Pure *** * Code generation for Haskell: restrict unqualified imports from Haskell Prelude to a small set of fundamental operations. * Command 'export_code': relative file names are interpreted relatively to master directory of current theory rather than the rather arbitrary current working directory. INCOMPATIBILITY. * Discontinued obsolete attribute "COMP". Potential INCOMPATIBILITY, use regular rule composition via "OF" / "THEN", or explicit proof structure instead. Note that Isabelle/ML provides a variety of operators like COMP, INCR_COMP, COMP_INCR, which need to be applied with some care where this is really required. * Command 'typ' supports an additional variant with explicit sort constraint, to infer and check the most general type conforming to a given sort. Example (in HOL): typ "_ * _ * bool * unit" :: finite * Command 'locale_deps' visualizes all locales and their relations as a Hasse diagram. *** HOL *** * Sledgehammer: - Added MaSh relevance filter based on machine-learning; see the Sledgehammer manual for details. - Polished Isar proofs generated with "isar_proofs" option. - Rationalized type encodings ("type_enc" option). - Renamed "kill_provers" subcommand to "kill_all". - Renamed options: isar_proof ~> isar_proofs isar_shrink_factor ~> isar_shrink max_relevant ~> max_facts relevance_thresholds ~> fact_thresholds * Quickcheck: added an optimisation for equality premises. It is switched on by default, and can be switched off by setting the configuration quickcheck_optimise_equality to false. * Quotient: only one quotient can be defined by quotient_type INCOMPATIBILITY. * Lifting: - generation of an abstraction function equation in lift_definition - quot_del attribute - renamed no_abs_code -> no_code (INCOMPATIBILITY.) * Simproc "finite_Collect" rewrites set comprehensions into pointfree expressions. * Preprocessing of the code generator rewrites set comprehensions into pointfree expressions. * The SMT solver Z3 has now by default a restricted set of directly supported features. For the full set of features (div/mod, nonlinear arithmetic, datatypes/records) with potential proof reconstruction failures, enable the configuration option "z3_with_extensions". Minor INCOMPATIBILITY. * Simplified 'typedef' specifications: historical options for implicit set definition and alternative name have been discontinued. The former behavior of "typedef (open) t = A" is now the default, but written just "typedef t = A". INCOMPATIBILITY, need to adapt theories accordingly. * Removed constant "chars"; prefer "Enum.enum" on type "char" directly. INCOMPATIBILITY. * Moved operation product, sublists and n_lists from theory Enum to List. INCOMPATIBILITY. * Theorem UN_o generalized to SUP_comp. INCOMPATIBILITY. * Class "comm_monoid_diff" formalises properties of bounded subtraction, with natural numbers and multisets as typical instances. * Added combinator "Option.these" with type "'a option set => 'a set". * Theory "Transitive_Closure": renamed lemmas reflcl_tranclp -> reflclp_tranclp rtranclp_reflcl -> rtranclp_reflclp INCOMPATIBILITY. * Theory "Rings": renamed lemmas (in class semiring) left_distrib ~> distrib_right right_distrib ~> distrib_left INCOMPATIBILITY. * Generalized the definition of limits: - Introduced the predicate filterlim (LIM x F. f x :> G) which expresses that when the input values x converge to F then the output f x converges to G. - Added filters for convergence to positive (at_top) and negative infinity (at_bot). - Moved infinity in the norm (at_infinity) from Multivariate_Analysis to Complex_Main. - Removed real_tendsto_inf, it is superseded by "LIM x F. f x :> at_top". INCOMPATIBILITY. * Theory "Library/Option_ord" provides instantiation of option type to lattice type classes. * Theory "Library/Multiset": renamed constant fold_mset ~> Multiset.fold fact fold_mset_commute ~> fold_mset_comm INCOMPATIBILITY. * Renamed theory Library/List_Prefix to Library/Sublist, with related changes as follows. - Renamed constants (and related lemmas) prefix ~> prefixeq strict_prefix ~> prefix - Replaced constant "postfix" by "suffixeq" with swapped argument order (i.e., "postfix xs ys" is now "suffixeq ys xs") and dropped old infix syntax "xs >>= ys"; use "suffixeq ys xs" instead. Renamed lemmas accordingly. - Added constant "list_hembeq" for homeomorphic embedding on lists. Added abbreviation "sublisteq" for special case "list_hembeq (op =)". - Theory Library/Sublist no longer provides "order" and "bot" type class instances for the prefix order (merely corresponding locale interpretations). The type class instances are now in theory Library/Prefix_Order. - The sublist relation of theory Library/Sublist_Order is now based on "Sublist.sublisteq". Renamed lemmas accordingly: le_list_append_le_same_iff ~> Sublist.sublisteq_append_le_same_iff le_list_append_mono ~> Sublist.list_hembeq_append_mono le_list_below_empty ~> Sublist.list_hembeq_Nil, Sublist.list_hembeq_Nil2 le_list_Cons_EX ~> Sublist.list_hembeq_ConsD le_list_drop_Cons2 ~> Sublist.sublisteq_Cons2' le_list_drop_Cons_neq ~> Sublist.sublisteq_Cons2_neq le_list_drop_Cons ~> Sublist.sublisteq_Cons' le_list_drop_many ~> Sublist.sublisteq_drop_many le_list_filter_left ~> Sublist.sublisteq_filter_left le_list_rev_drop_many ~> Sublist.sublisteq_rev_drop_many le_list_rev_take_iff ~> Sublist.sublisteq_append le_list_same_length ~> Sublist.sublisteq_same_length le_list_take_many_iff ~> Sublist.sublisteq_append' less_eq_list.drop ~> less_eq_list_drop less_eq_list.induct ~> less_eq_list_induct not_le_list_length ~> Sublist.not_sublisteq_length INCOMPATIBILITY. * New theory Library/Countable_Set. * Theory Library/Debug and Library/Parallel provide debugging and parallel execution for code generated towards Isabelle/ML. * Theory Library/FuncSet: Extended support for Pi and extensional and introduce the extensional dependent function space "PiE". Replaced extensional_funcset by an abbreviation, and renamed lemmas from extensional_funcset to PiE as follows: extensional_empty ~> PiE_empty extensional_funcset_empty_domain ~> PiE_empty_domain extensional_funcset_empty_range ~> PiE_empty_range extensional_funcset_arb ~> PiE_arb extensional_funcset_mem ~> PiE_mem extensional_funcset_extend_domainI ~> PiE_fun_upd extensional_funcset_restrict_domain ~> fun_upd_in_PiE extensional_funcset_extend_domain_eq ~> PiE_insert_eq card_extensional_funcset ~> card_PiE finite_extensional_funcset ~> finite_PiE INCOMPATIBILITY. * Theory Library/FinFun: theory of almost everywhere constant functions (supersedes the AFP entry "Code Generation for Functions as Data"). * Theory Library/Phantom: generic phantom type to make a type parameter appear in a constant's type. This alternative to adding TYPE('a) as another parameter avoids unnecessary closures in generated code. * Theory Library/RBT_Impl: efficient construction of red-black trees from sorted associative lists. Merging two trees with rbt_union may return a structurally different tree than before. Potential INCOMPATIBILITY. * Theory Library/IArray: immutable arrays with code generation. * Theory Library/Finite_Lattice: theory of finite lattices. * HOL/Multivariate_Analysis: replaced "basis :: 'a::euclidean_space => nat => real" "\\ :: (nat => real) => 'a::euclidean_space" on euclidean spaces by using the inner product "_ \ _" with vectors from the Basis set: "\\ i. f i" is superseded by "SUM i : Basis. f i * r i". With this change the following constants are also changed or removed: DIM('a) :: nat ~> card (Basis :: 'a set) (is an abbreviation) a $$ i ~> inner a i (where i : Basis) cart_base i removed \, \' removed Theorems about these constants where removed. Renamed lemmas: component_le_norm ~> Basis_le_norm euclidean_eq ~> euclidean_eq_iff differential_zero_maxmin_component ~> differential_zero_maxmin_cart euclidean_simps ~> inner_simps independent_basis ~> independent_Basis span_basis ~> span_Basis in_span_basis ~> in_span_Basis norm_bound_component_le ~> norm_boound_Basis_le norm_bound_component_lt ~> norm_boound_Basis_lt component_le_infnorm ~> Basis_le_infnorm INCOMPATIBILITY. * HOL/Probability: - Added simproc "measurable" to automatically prove measurability. - Added induction rules for sigma sets with disjoint union (sigma_sets_induct_disjoint) and for Borel-measurable functions (borel_measurable_induct). - Added the Daniell-Kolmogorov theorem (the existence the limit of a projective family). * HOL/Cardinals: Theories of ordinals and cardinals (supersedes the AFP entry "Ordinals_and_Cardinals"). * HOL/BNF: New (co)datatype package based on bounded natural functors with support for mixed, nested recursion and interesting non-free datatypes. * HOL/Finite_Set and Relation: added new set and relation operations expressed by Finite_Set.fold. * New theory HOL/Library/RBT_Set: implementation of sets by red-black trees for the code generator. * HOL/Library/RBT and HOL/Library/Mapping have been converted to Lifting/Transfer. possible INCOMPATIBILITY. * HOL/Set: renamed Set.project -> Set.filter INCOMPATIBILITY. *** Document preparation *** * Dropped legacy antiquotations "term_style" and "thm_style", since styles may be given as arguments to "term" and "thm" already. Discontinued legacy styles "prem1" .. "prem19". * Default LaTeX rendering for \ is now based on eurosym package, instead of slightly exotic babel/greek. * Document variant NAME may use different LaTeX entry point document/root_NAME.tex if that file exists, instead of the common document/root.tex. * Simplified custom document/build script, instead of old-style document/IsaMakefile. Minor INCOMPATIBILITY. *** ML *** * The default limit for maximum number of worker threads is now 8, instead of 4, in correspondence to capabilities of contemporary hardware and Poly/ML runtime system. * Type Seq.results and related operations support embedded error messages within lazy enumerations, and thus allow to provide informative errors in the absence of any usable results. * Renamed Position.str_of to Position.here to emphasize that this is a formal device to inline positions into message text, but not necessarily printing visible text. *** System *** * Advanced support for Isabelle sessions and build management, see "system" manual for the chapter of that name, especially the "isabelle build" tool and its examples. The "isabelle mkroot" tool prepares session root directories for use with "isabelle build", similar to former "isabelle mkdir" for "isabelle usedir". Note that this affects document preparation as well. INCOMPATIBILITY, isabelle usedir / mkdir / make are rendered obsolete. * Discontinued obsolete Isabelle/build script, it is superseded by the regular isabelle build tool. For example: isabelle build -s -b HOL * Discontinued obsolete "isabelle makeall". * Discontinued obsolete IsaMakefile and ROOT.ML files from the Isabelle distribution, except for rudimentary src/HOL/IsaMakefile that provides some traditional targets that invoke "isabelle build". Note that this is inefficient! Applications of Isabelle/HOL involving "isabelle make" should be upgraded to use "isabelle build" directly. * The "isabelle options" tool prints Isabelle system options, as required for "isabelle build", for example. * The "isabelle logo" tool produces EPS and PDF format simultaneously. Minor INCOMPATIBILITY in command-line options. * The "isabelle install" tool has now a simpler command-line. Minor INCOMPATIBILITY. * The "isabelle components" tool helps to resolve add-on components that are not bundled, or referenced from a bare-bones repository version of Isabelle. * Settings variable ISABELLE_PLATFORM_FAMILY refers to the general platform family: "linux", "macos", "windows". * The ML system is configured as regular component, and no longer picked up from some surrounding directory. Potential INCOMPATIBILITY for home-made settings. * Improved ML runtime statistics (heap, threads, future tasks etc.). * Discontinued support for Poly/ML 5.2.1, which was the last version without exception positions and advanced ML compiler/toplevel configuration. * Discontinued special treatment of Proof General -- no longer guess PROOFGENERAL_HOME based on accidental file-system layout. Minor INCOMPATIBILITY: provide PROOFGENERAL_HOME and PROOFGENERAL_OPTIONS settings manually, or use a Proof General version that has been bundled as Isabelle component. New in Isabelle2012 (May 2012) ------------------------------ *** General *** * Prover IDE (PIDE) improvements: - more robust Sledgehammer integration (as before the sledgehammer command-line needs to be typed into the source buffer) - markup for bound variables - markup for types of term variables (displayed as tooltips) - support for user-defined Isar commands within the running session - improved support for Unicode outside original 16bit range e.g. glyph for \ (thanks to jEdit 4.5.1) * Forward declaration of outer syntax keywords within the theory header -- minor INCOMPATIBILITY for user-defined commands. Allow new commands to be used in the same theory where defined. * Auxiliary contexts indicate block structure for specifications with additional parameters and assumptions. Such unnamed contexts may be nested within other targets, like 'theory', 'locale', 'class', 'instantiation' etc. Results from the local context are generalized accordingly and applied to the enclosing target context. Example: context fixes x y z :: 'a assumes xy: "x = y" and yz: "y = z" begin lemma my_trans: "x = z" using xy yz by simp end thm my_trans The most basic application is to factor-out context elements of several fixes/assumes/shows theorem statements, e.g. see ~~/src/HOL/Isar_Examples/Group_Context.thy Any other local theory specification element works within the "context ... begin ... end" block as well. * Bundled declarations associate attributed fact expressions with a given name in the context. These may be later included in other contexts. This allows to manage context extensions casually, without the logical dependencies of locales and locale interpretation. See commands 'bundle', 'include', 'including' etc. in the isar-ref manual. * Commands 'lemmas' and 'theorems' allow local variables using 'for' declaration, and results are standardized before being stored. Thus old-style "standard" after instantiation or composition of facts becomes obsolete. Minor INCOMPATIBILITY, due to potential change of indices of schematic variables. * Rule attributes in local theory declarations (e.g. locale or class) are now statically evaluated: the resulting theorem is stored instead of the original expression. INCOMPATIBILITY in rare situations, where the historic accident of dynamic re-evaluation in interpretations etc. was exploited. * New tutorial "Programming and Proving in Isabelle/HOL" ("prog-prove"). It completely supersedes "A Tutorial Introduction to Structured Isar Proofs" ("isar-overview"), which has been removed. It also supersedes "Isabelle/HOL, A Proof Assistant for Higher-Order Logic" as the recommended beginners tutorial, but does not cover all of the material of that old tutorial. * Updated and extended reference manuals: "isar-ref", "implementation", "system"; reduced remaining material in old "ref" manual. *** Pure *** * Command 'definition' no longer exports the foundational "raw_def" into the user context. Minor INCOMPATIBILITY, may use the regular "def" result with attribute "abs_def" to imitate the old version. * Attribute "abs_def" turns an equation of the form "f x y == t" into "f == %x y. t", which ensures that "simp" or "unfold" steps always expand it. This also works for object-logic equality. (Formerly undocumented feature.) * Sort constraints are now propagated in simultaneous statements, just like type constraints. INCOMPATIBILITY in rare situations, where distinct sorts used to be assigned accidentally. For example: lemma "P (x::'a::foo)" and "Q (y::'a::bar)" -- "now illegal" lemma "P (x::'a)" and "Q (y::'a::bar)" -- "now uniform 'a::bar instead of default sort for first occurrence (!)" * Rule composition via attribute "OF" (or ML functions OF/MRS) is more tolerant against multiple unifiers, as long as the final result is unique. (As before, rules are composed in canonical right-to-left order to accommodate newly introduced premises.) * Renamed some inner syntax categories: num ~> num_token xnum ~> xnum_token xstr ~> str_token Minor INCOMPATIBILITY. Note that in practice "num_const" or "num_position" etc. are mainly used instead (which also include position information via constraints). * Simplified configuration options for syntax ambiguity: see "syntax_ambiguity_warning" and "syntax_ambiguity_limit" in isar-ref manual. Minor INCOMPATIBILITY. * Discontinued configuration option "syntax_positions": atomic terms in parse trees are always annotated by position constraints. * Old code generator for SML and its commands 'code_module', 'code_library', 'consts_code', 'types_code' have been discontinued. Use commands of the generic code generator instead. INCOMPATIBILITY. * Redundant attribute "code_inline" has been discontinued. Use "code_unfold" instead. INCOMPATIBILITY. * Dropped attribute "code_unfold_post" in favor of the its dual "code_abbrev", which yields a common pattern in definitions like definition [code_abbrev]: "f = t" INCOMPATIBILITY. * Obsolete 'types' command has been discontinued. Use 'type_synonym' instead. INCOMPATIBILITY. * Discontinued old "prems" fact, which used to refer to the accidental collection of foundational premises in the context (already marked as legacy since Isabelle2011). *** HOL *** * Type 'a set is now a proper type constructor (just as before Isabelle2008). Definitions mem_def and Collect_def have disappeared. Non-trivial INCOMPATIBILITY. For developments keeping predicates and sets separate, it is often sufficient to rephrase some set S that has been accidentally used as predicates by "%x. x : S", and some predicate P that has been accidentally used as set by "{x. P x}". Corresponding proofs in a first step should be pruned from any tinkering with former theorems mem_def and Collect_def as far as possible. For developments which deliberately mix predicates and sets, a planning step is necessary to determine what should become a predicate and what a set. It can be helpful to carry out that step in Isabelle2011-1 before jumping right into the current release. * Code generation by default implements sets as container type rather than predicates. INCOMPATIBILITY. * New type synonym 'a rel = ('a * 'a) set * The representation of numerals has changed. Datatype "num" represents strictly positive binary numerals, along with functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to represent positive and negated numeric literals, respectively. See also definitions in ~~/src/HOL/Num.thy. Potential INCOMPATIBILITY, some user theories may require adaptations as follows: - Theorems with number_ring or number_semiring constraints: These classes are gone; use comm_ring_1 or comm_semiring_1 instead. - Theories defining numeric types: Remove number, number_semiring, and number_ring instances. Defer all theorems about numerals until after classes one and semigroup_add have been instantiated. - Numeral-only simp rules: Replace each rule having a "number_of v" pattern with two copies, one for numeral and one for neg_numeral. - Theorems about subclasses of semiring_1 or ring_1: These classes automatically support numerals now, so more simp rules and simprocs may now apply within the proof. - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1: Redefine using other integer operations. * Transfer: New package intended to generalize the existing "descending" method and related theorem attributes from the Quotient package. (Not all functionality is implemented yet, but future development will focus on Transfer as an eventual replacement for the corresponding parts of the Quotient package.) - transfer_rule attribute: Maintains a collection of transfer rules, which relate constants at two different types. Transfer rules may relate different type instances of the same polymorphic constant, or they may relate an operation on a raw type to a corresponding operation on an abstract type (quotient or subtype). For example: ((A ===> B) ===> list_all2 A ===> list_all2 B) map map (cr_int ===> cr_int ===> cr_int) (%(x,y) (u,v). (x+u, y+v)) plus_int - transfer method: Replaces a subgoal on abstract types with an equivalent subgoal on the corresponding raw types. Constants are replaced with corresponding ones according to the transfer rules. Goals are generalized over all free variables by default; this is necessary for variables whose types change, but can be overridden for specific variables with e.g. "transfer fixing: x y z". The variant transfer' method allows replacing a subgoal with one that is logically stronger (rather than equivalent). - relator_eq attribute: Collects identity laws for relators of various type constructors, e.g. "list_all2 (op =) = (op =)". The transfer method uses these lemmas to infer transfer rules for non-polymorphic constants on the fly. - transfer_prover method: Assists with proving a transfer rule for a new constant, provided the constant is defined in terms of other constants that already have transfer rules. It should be applied after unfolding the constant definitions. - HOL/ex/Transfer_Int_Nat.thy: Example theory demonstrating transfer from type nat to type int. * Lifting: New package intended to generalize the quotient_definition facility of the Quotient package; designed to work with Transfer. - lift_definition command: Defines operations on an abstract type in terms of a corresponding operation on a representation type. Example syntax: lift_definition dlist_insert :: "'a => 'a dlist => 'a dlist" is List.insert Users must discharge a respectfulness proof obligation when each constant is defined. (For a type copy, i.e. a typedef with UNIV, the proof is discharged automatically.) The obligation is presented in a user-friendly, readable form; a respectfulness theorem in the standard format and a transfer rule are generated by the package. - Integration with code_abstype: For typedefs (e.g. subtypes corresponding to a datatype invariant, such as dlist), lift_definition generates a code certificate theorem and sets up code generation for each constant. - setup_lifting command: Sets up the Lifting package to work with a user-defined type. The user must provide either a quotient theorem or a type_definition theorem. The package configures transfer rules for equality and quantifiers on the type, and sets up the lift_definition command to work with the type. - Usage examples: See Quotient_Examples/Lift_DList.thy, Quotient_Examples/Lift_RBT.thy, Quotient_Examples/Lift_FSet.thy, Word/Word.thy and Library/Float.thy. * Quotient package: - The 'quotient_type' command now supports a 'morphisms' option with rep and abs functions, similar to typedef. - 'quotient_type' sets up new types to work with the Lifting and Transfer packages, as with 'setup_lifting'. - The 'quotient_definition' command now requires the user to prove a respectfulness property at the point where the constant is defined, similar to lift_definition; INCOMPATIBILITY. - Renamed predicate 'Quotient' to 'Quotient3', and renamed theorems accordingly, INCOMPATIBILITY. * New diagnostic command 'find_unused_assms' to find potentially superfluous assumptions in theorems using Quickcheck. * Quickcheck: - Quickcheck returns variable assignments as counterexamples, which allows to reveal the underspecification of functions under test. For example, refuting "hd xs = x", it presents the variable assignment xs = [] and x = a1 as a counterexample, assuming that any property is false whenever "hd []" occurs in it. These counterexample are marked as potentially spurious, as Quickcheck also returns "xs = []" as a counterexample to the obvious theorem "hd xs = hd xs". After finding a potentially spurious counterexample, Quickcheck continues searching for genuine ones. By default, Quickcheck shows potentially spurious and genuine counterexamples. The option "genuine_only" sets quickcheck to only show genuine counterexamples. - The command 'quickcheck_generator' creates random and exhaustive value generators for a given type and operations. It generates values by using the operations as if they were constructors of that type. - Support for multisets. - Added "use_subtype" options. - Added "quickcheck_locale" configuration to specify how to process conjectures in a locale context. * Nitpick: Fixed infinite loop caused by the 'peephole_optim' option and affecting 'rat' and 'real'. * Sledgehammer: - Integrated more tightly with SPASS, as described in the ITP 2012 paper "More SPASS with Isabelle". - Made it try "smt" as a fallback if "metis" fails or times out. - Added support for the following provers: Alt-Ergo (via Why3 and TFF1), iProver, iProver-Eq. - Sped up the minimizer. - Added "lam_trans", "uncurry_aliases", and "minimize" options. - Renamed "slicing" ("no_slicing") option to "slice" ("dont_slice"). - Renamed "sound" option to "strict". * Metis: Added possibility to specify lambda translations scheme as a parenthesized argument (e.g., "by (metis (lifting) ...)"). * SMT: Renamed "smt_fixed" option to "smt_read_only_certificates". * Command 'try0': Renamed from 'try_methods'. INCOMPATIBILITY. * New "case_product" attribute to generate a case rule doing multiple case distinctions at the same time. E.g. list.exhaust [case_product nat.exhaust] produces a rule which can be used to perform case distinction on both a list and a nat. * New "eventually_elim" method as a generalized variant of the eventually_elim* rules. Supports structured proofs. * Typedef with implicit set definition is considered legacy. Use "typedef (open)" form instead, which will eventually become the default. * Record: code generation can be switched off manually with declare [[record_coden = false]] -- "default true" * Datatype: type parameters allow explicit sort constraints. * Concrete syntax for case expressions includes constraints for source positions, and thus produces Prover IDE markup for its bindings. INCOMPATIBILITY for old-style syntax translations that augment the pattern notation; e.g. see src/HOL/HOLCF/One.thy for translations of one_case. * Clarified attribute "mono_set": pure declaration without modifying the result of the fact expression. * More default pred/set conversions on a couple of relation operations and predicates. Added powers of predicate relations. Consolidation of some relation theorems: converse_def ~> converse_unfold rel_comp_def ~> relcomp_unfold symp_def ~> (modified, use symp_def and sym_def instead) transp_def ~> transp_trans Domain_def ~> Domain_unfold Range_def ~> Domain_converse [symmetric] Generalized theorems INF_INT_eq, INF_INT_eq2, SUP_UN_eq, SUP_UN_eq2. See theory "Relation" for examples for making use of pred/set conversions by means of attributes "to_set" and "to_pred". INCOMPATIBILITY. * Renamed facts about the power operation on relations, i.e., relpow to match the constant's name: rel_pow_1 ~> relpow_1 rel_pow_0_I ~> relpow_0_I rel_pow_Suc_I ~> relpow_Suc_I rel_pow_Suc_I2 ~> relpow_Suc_I2 rel_pow_0_E ~> relpow_0_E rel_pow_Suc_E ~> relpow_Suc_E rel_pow_E ~> relpow_E rel_pow_Suc_D2 ~> relpow_Suc_D2 rel_pow_Suc_E2 ~> relpow_Suc_E2 rel_pow_Suc_D2' ~> relpow_Suc_D2' rel_pow_E2 ~> relpow_E2 rel_pow_add ~> relpow_add rel_pow_commute ~> relpow rel_pow_empty ~> relpow_empty: rtrancl_imp_UN_rel_pow ~> rtrancl_imp_UN_relpow rel_pow_imp_rtrancl ~> relpow_imp_rtrancl rtrancl_is_UN_rel_pow ~> rtrancl_is_UN_relpow rtrancl_imp_rel_pow ~> rtrancl_imp_relpow rel_pow_fun_conv ~> relpow_fun_conv rel_pow_finite_bounded1 ~> relpow_finite_bounded1 rel_pow_finite_bounded ~> relpow_finite_bounded rtrancl_finite_eq_rel_pow ~> rtrancl_finite_eq_relpow trancl_finite_eq_rel_pow ~> trancl_finite_eq_relpow single_valued_rel_pow ~> single_valued_relpow INCOMPATIBILITY. * Theory Relation: Consolidated constant name for relation composition and corresponding theorem names: - Renamed constant rel_comp to relcomp. - Dropped abbreviation pred_comp. Use relcompp instead. - Renamed theorems: rel_compI ~> relcompI rel_compEpair ~> relcompEpair rel_compE ~> relcompE pred_comp_rel_comp_eq ~> relcompp_relcomp_eq rel_comp_empty1 ~> relcomp_empty1 rel_comp_mono ~> relcomp_mono rel_comp_subset_Sigma ~> relcomp_subset_Sigma rel_comp_distrib ~> relcomp_distrib rel_comp_distrib2 ~> relcomp_distrib2 rel_comp_UNION_distrib ~> relcomp_UNION_distrib rel_comp_UNION_distrib2 ~> relcomp_UNION_distrib2 single_valued_rel_comp ~> single_valued_relcomp rel_comp_def ~> relcomp_unfold converse_rel_comp ~> converse_relcomp pred_compI ~> relcomppI pred_compE ~> relcomppE pred_comp_bot1 ~> relcompp_bot1 pred_comp_bot2 ~> relcompp_bot2 transp_pred_comp_less_eq ~> transp_relcompp_less_eq pred_comp_mono ~> relcompp_mono pred_comp_distrib ~> relcompp_distrib pred_comp_distrib2 ~> relcompp_distrib2 converse_pred_comp ~> converse_relcompp finite_rel_comp ~> finite_relcomp set_rel_comp ~> set_relcomp INCOMPATIBILITY. * Theory Divides: Discontinued redundant theorems about div and mod. INCOMPATIBILITY, use the corresponding generic theorems instead. DIVISION_BY_ZERO ~> div_by_0, mod_by_0 zdiv_self ~> div_self zmod_self ~> mod_self zdiv_zero ~> div_0 zmod_zero ~> mod_0 zdiv_zmod_equality ~> div_mod_equality2 zdiv_zmod_equality2 ~> div_mod_equality zmod_zdiv_trivial ~> mod_div_trivial zdiv_zminus_zminus ~> div_minus_minus zmod_zminus_zminus ~> mod_minus_minus zdiv_zminus2 ~> div_minus_right zmod_zminus2 ~> mod_minus_right zdiv_minus1_right ~> div_minus1_right zmod_minus1_right ~> mod_minus1_right zdvd_mult_div_cancel ~> dvd_mult_div_cancel zmod_zmult1_eq ~> mod_mult_right_eq zpower_zmod ~> power_mod zdvd_zmod ~> dvd_mod zdvd_zmod_imp_zdvd ~> dvd_mod_imp_dvd mod_mult_distrib ~> mult_mod_left mod_mult_distrib2 ~> mult_mod_right * Removed redundant theorems nat_mult_2 and nat_mult_2_right; use generic mult_2 and mult_2_right instead. INCOMPATIBILITY. * Finite_Set.fold now qualified. INCOMPATIBILITY. * Consolidated theorem names concerning fold combinators: inf_INFI_fold_inf ~> inf_INF_fold_inf sup_SUPR_fold_sup ~> sup_SUP_fold_sup INFI_fold_inf ~> INF_fold_inf SUPR_fold_sup ~> SUP_fold_sup union_set ~> union_set_fold minus_set ~> minus_set_fold INFI_set_fold ~> INF_set_fold SUPR_set_fold ~> SUP_set_fold INF_code ~> INF_set_foldr SUP_code ~> SUP_set_foldr foldr.simps ~> foldr.simps (in point-free formulation) foldr_fold_rev ~> foldr_conv_fold foldl_fold ~> foldl_conv_fold foldr_foldr ~> foldr_conv_foldl foldl_foldr ~> foldl_conv_foldr fold_set_remdups ~> fold_set_fold_remdups fold_set ~> fold_set_fold fold1_set ~> fold1_set_fold INCOMPATIBILITY. * Dropped rarely useful theorems concerning fold combinators: foldl_apply, foldl_fun_comm, foldl_rev, fold_weak_invariant, rev_foldl_cons, fold_set_remdups, fold_set, fold_set1, concat_conv_foldl, foldl_weak_invariant, foldl_invariant, foldr_invariant, foldl_absorb0, foldl_foldr1_lemma, foldl_foldr1, listsum_conv_fold, listsum_foldl, sort_foldl_insort, foldl_assoc, foldr_conv_foldl, start_le_sum, elem_le_sum, sum_eq_0_conv. INCOMPATIBILITY. For the common phrases "%xs. List.foldr plus xs 0" and "List.foldl plus 0", prefer "List.listsum". Otherwise it can be useful to boil down "List.foldr" and "List.foldl" to "List.fold" by unfolding "foldr_conv_fold" and "foldl_conv_fold". * Dropped lemmas minus_set_foldr, union_set_foldr, union_coset_foldr, inter_coset_foldr, Inf_fin_set_foldr, Sup_fin_set_foldr, Min_fin_set_foldr, Max_fin_set_foldr, Inf_set_foldr, Sup_set_foldr, INF_set_foldr, SUP_set_foldr. INCOMPATIBILITY. Prefer corresponding lemmas over fold rather than foldr, or make use of lemmas fold_conv_foldr and fold_rev. * Congruence rules Option.map_cong and Option.bind_cong for recursion through option types. * "Transitive_Closure.ntrancl": bounded transitive closure on relations. * Constant "Set.not_member" now qualified. INCOMPATIBILITY. * Theory Int: Discontinued many legacy theorems specific to type int. INCOMPATIBILITY, use the corresponding generic theorems instead. zminus_zminus ~> minus_minus zminus_0 ~> minus_zero zminus_zadd_distrib ~> minus_add_distrib zadd_commute ~> add_commute zadd_assoc ~> add_assoc zadd_left_commute ~> add_left_commute zadd_ac ~> add_ac zmult_ac ~> mult_ac zadd_0 ~> add_0_left zadd_0_right ~> add_0_right zadd_zminus_inverse2 ~> left_minus zmult_zminus ~> mult_minus_left zmult_commute ~> mult_commute zmult_assoc ~> mult_assoc zadd_zmult_distrib ~> left_distrib zadd_zmult_distrib2 ~> right_distrib zdiff_zmult_distrib ~> left_diff_distrib zdiff_zmult_distrib2 ~> right_diff_distrib zmult_1 ~> mult_1_left zmult_1_right ~> mult_1_right zle_refl ~> order_refl zle_trans ~> order_trans zle_antisym ~> order_antisym zle_linear ~> linorder_linear zless_linear ~> linorder_less_linear zadd_left_mono ~> add_left_mono zadd_strict_right_mono ~> add_strict_right_mono zadd_zless_mono ~> add_less_le_mono int_0_less_1 ~> zero_less_one int_0_neq_1 ~> zero_neq_one zless_le ~> less_le zpower_zadd_distrib ~> power_add zero_less_zpower_abs_iff ~> zero_less_power_abs_iff zero_le_zpower_abs ~> zero_le_power_abs * Theory Deriv: Renamed DERIV_nonneg_imp_nonincreasing ~> DERIV_nonneg_imp_nondecreasing * Theory Library/Multiset: Improved code generation of multisets. * Theory HOL/Library/Set_Algebras: Addition and multiplication on sets are expressed via type classes again. The special syntax \/\ has been replaced by plain +/*. Removed constant setsum_set, which is now subsumed by Big_Operators.setsum. INCOMPATIBILITY. * Theory HOL/Library/Diagonalize has been removed. INCOMPATIBILITY, use theory HOL/Library/Nat_Bijection instead. * Theory HOL/Library/RBT_Impl: Backing implementation of red-black trees is now inside a type class context. Names of affected operations and lemmas have been prefixed by rbt_. INCOMPATIBILITY for theories working directly with raw red-black trees, adapt the names as follows: Operations: bulkload -> rbt_bulkload del_from_left -> rbt_del_from_left del_from_right -> rbt_del_from_right del -> rbt_del delete -> rbt_delete ins -> rbt_ins insert -> rbt_insert insertw -> rbt_insert_with insert_with_key -> rbt_insert_with_key map_entry -> rbt_map_entry lookup -> rbt_lookup sorted -> rbt_sorted tree_greater -> rbt_greater tree_less -> rbt_less tree_less_symbol -> rbt_less_symbol union -> rbt_union union_with -> rbt_union_with union_with_key -> rbt_union_with_key Lemmas: balance_left_sorted -> balance_left_rbt_sorted balance_left_tree_greater -> balance_left_rbt_greater balance_left_tree_less -> balance_left_rbt_less balance_right_sorted -> balance_right_rbt_sorted balance_right_tree_greater -> balance_right_rbt_greater balance_right_tree_less -> balance_right_rbt_less balance_sorted -> balance_rbt_sorted balance_tree_greater -> balance_rbt_greater balance_tree_less -> balance_rbt_less bulkload_is_rbt -> rbt_bulkload_is_rbt combine_sorted -> combine_rbt_sorted combine_tree_greater -> combine_rbt_greater combine_tree_less -> combine_rbt_less delete_in_tree -> rbt_delete_in_tree delete_is_rbt -> rbt_delete_is_rbt del_from_left_tree_greater -> rbt_del_from_left_rbt_greater del_from_left_tree_less -> rbt_del_from_left_rbt_less del_from_right_tree_greater -> rbt_del_from_right_rbt_greater del_from_right_tree_less -> rbt_del_from_right_rbt_less del_in_tree -> rbt_del_in_tree del_inv1_inv2 -> rbt_del_inv1_inv2 del_sorted -> rbt_del_rbt_sorted del_tree_greater -> rbt_del_rbt_greater del_tree_less -> rbt_del_rbt_less dom_lookup_Branch -> dom_rbt_lookup_Branch entries_lookup -> entries_rbt_lookup finite_dom_lookup -> finite_dom_rbt_lookup insert_sorted -> rbt_insert_rbt_sorted insertw_is_rbt -> rbt_insertw_is_rbt insertwk_is_rbt -> rbt_insertwk_is_rbt insertwk_sorted -> rbt_insertwk_rbt_sorted insertw_sorted -> rbt_insertw_rbt_sorted ins_sorted -> ins_rbt_sorted ins_tree_greater -> ins_rbt_greater ins_tree_less -> ins_rbt_less is_rbt_sorted -> is_rbt_rbt_sorted lookup_balance -> rbt_lookup_balance lookup_bulkload -> rbt_lookup_rbt_bulkload lookup_delete -> rbt_lookup_rbt_delete lookup_Empty -> rbt_lookup_Empty lookup_from_in_tree -> rbt_lookup_from_in_tree lookup_in_tree -> rbt_lookup_in_tree lookup_ins -> rbt_lookup_ins lookup_insert -> rbt_lookup_rbt_insert lookup_insertw -> rbt_lookup_rbt_insertw lookup_insertwk -> rbt_lookup_rbt_insertwk lookup_keys -> rbt_lookup_keys lookup_map -> rbt_lookup_map lookup_map_entry -> rbt_lookup_rbt_map_entry lookup_tree_greater -> rbt_lookup_rbt_greater lookup_tree_less -> rbt_lookup_rbt_less lookup_union -> rbt_lookup_rbt_union map_entry_color_of -> rbt_map_entry_color_of map_entry_inv1 -> rbt_map_entry_inv1 map_entry_inv2 -> rbt_map_entry_inv2 map_entry_is_rbt -> rbt_map_entry_is_rbt map_entry_sorted -> rbt_map_entry_rbt_sorted map_entry_tree_greater -> rbt_map_entry_rbt_greater map_entry_tree_less -> rbt_map_entry_rbt_less map_tree_greater -> map_rbt_greater map_tree_less -> map_rbt_less map_sorted -> map_rbt_sorted paint_sorted -> paint_rbt_sorted paint_lookup -> paint_rbt_lookup paint_tree_greater -> paint_rbt_greater paint_tree_less -> paint_rbt_less sorted_entries -> rbt_sorted_entries tree_greater_eq_trans -> rbt_greater_eq_trans tree_greater_nit -> rbt_greater_nit tree_greater_prop -> rbt_greater_prop tree_greater_simps -> rbt_greater_simps tree_greater_trans -> rbt_greater_trans tree_less_eq_trans -> rbt_less_eq_trans tree_less_nit -> rbt_less_nit tree_less_prop -> rbt_less_prop tree_less_simps -> rbt_less_simps tree_less_trans -> rbt_less_trans tree_ord_props -> rbt_ord_props union_Branch -> rbt_union_Branch union_is_rbt -> rbt_union_is_rbt unionw_is_rbt -> rbt_unionw_is_rbt unionwk_is_rbt -> rbt_unionwk_is_rbt unionwk_sorted -> rbt_unionwk_rbt_sorted * Theory HOL/Library/Float: Floating point numbers are now defined as a subset of the real numbers. All operations are defined using the lifing-framework and proofs use the transfer method. INCOMPATIBILITY. Changed Operations: float_abs -> abs float_nprt -> nprt float_pprt -> pprt pow2 -> use powr round_down -> float_round_down round_up -> float_round_up scale -> exponent Removed Operations: ceiling_fl, lb_mult, lb_mod, ub_mult, ub_mod Renamed Lemmas: abs_float_def -> Float.compute_float_abs bitlen_ge0 -> bitlen_nonneg bitlen.simps -> Float.compute_bitlen float_components -> Float_mantissa_exponent float_divl.simps -> Float.compute_float_divl float_divr.simps -> Float.compute_float_divr float_eq_odd -> mult_powr_eq_mult_powr_iff float_power -> real_of_float_power lapprox_posrat_def -> Float.compute_lapprox_posrat lapprox_rat.simps -> Float.compute_lapprox_rat le_float_def' -> Float.compute_float_le le_float_def -> less_eq_float.rep_eq less_float_def' -> Float.compute_float_less less_float_def -> less_float.rep_eq normfloat_def -> Float.compute_normfloat normfloat_imp_odd_or_zero -> mantissa_not_dvd and mantissa_noteq_0 normfloat -> normfloat_def normfloat_unique -> use normfloat_def number_of_float_Float -> Float.compute_float_numeral, Float.compute_float_neg_numeral one_float_def -> Float.compute_float_one plus_float_def -> Float.compute_float_plus rapprox_posrat_def -> Float.compute_rapprox_posrat rapprox_rat.simps -> Float.compute_rapprox_rat real_of_float_0 -> zero_float.rep_eq real_of_float_1 -> one_float.rep_eq real_of_float_abs -> abs_float.rep_eq real_of_float_add -> plus_float.rep_eq real_of_float_minus -> uminus_float.rep_eq real_of_float_mult -> times_float.rep_eq real_of_float_simp -> Float.rep_eq real_of_float_sub -> minus_float.rep_eq round_down.simps -> Float.compute_float_round_down round_up.simps -> Float.compute_float_round_up times_float_def -> Float.compute_float_times uminus_float_def -> Float.compute_float_uminus zero_float_def -> Float.compute_float_zero Lemmas not necessary anymore, use the transfer method: bitlen_B0, bitlen_B1, bitlen_ge1, bitlen_Min, bitlen_Pls, float_divl, float_divr, float_le_simp, float_less1_mantissa_bound, float_less_simp, float_less_zero, float_le_zero, float_pos_less1_e_neg, float_pos_m_pos, float_split, float_split2, floor_pos_exp, lapprox_posrat, lapprox_posrat_bottom, lapprox_rat, lapprox_rat_bottom, normalized_float, rapprox_posrat, rapprox_posrat_le1, rapprox_rat, real_of_float_ge0_exp, real_of_float_neg_exp, real_of_float_nge0_exp, round_down floor_fl, round_up, zero_le_float, zero_less_float * New theory HOL/Library/DAList provides an abstract type for association lists with distinct keys. * Session HOL/IMP: Added new theory of abstract interpretation of annotated commands. * Session HOL-Import: Re-implementation from scratch is faster, simpler, and more scalable. Requires a proof bundle, which is available as an external component. Discontinued old (and mostly dead) Importer for HOL4 and HOL Light. INCOMPATIBILITY. * Session HOL-Word: Discontinued many redundant theorems specific to type 'a word. INCOMPATIBILITY, use the corresponding generic theorems instead. word_sub_alt ~> word_sub_wi word_add_alt ~> word_add_def word_mult_alt ~> word_mult_def word_minus_alt ~> word_minus_def word_0_alt ~> word_0_wi word_1_alt ~> word_1_wi word_add_0 ~> add_0_left word_add_0_right ~> add_0_right word_mult_1 ~> mult_1_left word_mult_1_right ~> mult_1_right word_add_commute ~> add_commute word_add_assoc ~> add_assoc word_add_left_commute ~> add_left_commute word_mult_commute ~> mult_commute word_mult_assoc ~> mult_assoc word_mult_left_commute ~> mult_left_commute word_left_distrib ~> left_distrib word_right_distrib ~> right_distrib word_left_minus ~> left_minus word_diff_0_right ~> diff_0_right word_diff_self ~> diff_self word_sub_def ~> diff_minus word_diff_minus ~> diff_minus word_add_ac ~> add_ac word_mult_ac ~> mult_ac word_plus_ac0 ~> add_0_left add_0_right add_ac word_times_ac1 ~> mult_1_left mult_1_right mult_ac word_order_trans ~> order_trans word_order_refl ~> order_refl word_order_antisym ~> order_antisym word_order_linear ~> linorder_linear lenw1_zero_neq_one ~> zero_neq_one word_number_of_eq ~> number_of_eq word_of_int_add_hom ~> wi_hom_add word_of_int_sub_hom ~> wi_hom_sub word_of_int_mult_hom ~> wi_hom_mult word_of_int_minus_hom ~> wi_hom_neg word_of_int_succ_hom ~> wi_hom_succ word_of_int_pred_hom ~> wi_hom_pred word_of_int_0_hom ~> word_0_wi word_of_int_1_hom ~> word_1_wi * Session HOL-Word: New proof method "word_bitwise" for splitting machine word equalities and inequalities into logical circuits, defined in HOL/Word/WordBitwise.thy. Supports addition, subtraction, multiplication, shifting by constants, bitwise operators and numeric constants. Requires fixed-length word types, not 'a word. Solves many standard word identities outright and converts more into first order problems amenable to blast or similar. See also examples in HOL/Word/Examples/WordExamples.thy. * Session HOL-Probability: Introduced the type "'a measure" to represent measures, this replaces the records 'a algebra and 'a measure_space. The locales based on subset_class now have two locale-parameters the space \ and the set of measurable sets M. The product of probability spaces uses now the same constant as the finite product of sigma-finite measure spaces "PiM :: ('i => 'a) measure". Most constants are defined now outside of locales and gain an additional parameter, like null_sets, almost_eventually or \'. Measure space constructions for distributions and densities now got their own constants distr and density. Instead of using locales to describe measure spaces with a finite space, the measure count_space and point_measure is introduced. INCOMPATIBILITY. Renamed constants: measure -> emeasure finite_measure.\' -> measure product_algebra_generator -> prod_algebra product_prob_space.emb -> prod_emb product_prob_space.infprod_algebra -> PiM Removed locales: completeable_measure_space finite_measure_space finite_prob_space finite_product_finite_prob_space finite_product_sigma_algebra finite_sigma_algebra measure_space pair_finite_prob_space pair_finite_sigma_algebra pair_finite_space pair_sigma_algebra product_sigma_algebra Removed constants: conditional_space distribution -> use distr measure, or distributed predicate image_space joint_distribution -> use distr measure, or distributed predicate pair_measure_generator product_prob_space.infprod_algebra -> use PiM subvimage Replacement theorems: finite_additivity_sufficient -> ring_of_sets.countably_additiveI_finite finite_measure.empty_measure -> measure_empty finite_measure.finite_continuity_from_above -> finite_measure.finite_Lim_measure_decseq finite_measure.finite_continuity_from_below -> finite_measure.finite_Lim_measure_incseq finite_measure.finite_measure_countably_subadditive -> finite_measure.finite_measure_subadditive_countably finite_measure.finite_measure_eq -> finite_measure.emeasure_eq_measure finite_measure.finite_measure -> finite_measure.emeasure_finite finite_measure.finite_measure_finite_singleton -> finite_measure.finite_measure_eq_setsum_singleton finite_measure.positive_measure' -> measure_nonneg finite_measure.real_measure -> finite_measure.emeasure_real finite_product_prob_space.finite_measure_times -> finite_product_prob_space.finite_measure_PiM_emb finite_product_sigma_algebra.in_P -> sets_PiM_I_finite finite_product_sigma_algebra.P_empty -> space_PiM_empty, sets_PiM_empty information_space.conditional_entropy_eq -> information_space.conditional_entropy_simple_distributed information_space.conditional_entropy_positive -> information_space.conditional_entropy_nonneg_simple information_space.conditional_mutual_information_eq_mutual_information -> information_space.conditional_mutual_information_eq_mutual_information_simple information_space.conditional_mutual_information_generic_positive -> information_space.conditional_mutual_information_nonneg_simple information_space.conditional_mutual_information_positive -> information_space.conditional_mutual_information_nonneg_simple information_space.entropy_commute -> information_space.entropy_commute_simple information_space.entropy_eq -> information_space.entropy_simple_distributed information_space.entropy_generic_eq -> information_space.entropy_simple_distributed information_space.entropy_positive -> information_space.entropy_nonneg_simple information_space.entropy_uniform_max -> information_space.entropy_uniform information_space.KL_eq_0_imp -> information_space.KL_eq_0_iff_eq information_space.KL_eq_0 -> information_space.KL_same_eq_0 information_space.KL_ge_0 -> information_space.KL_nonneg information_space.mutual_information_eq -> information_space.mutual_information_simple_distributed information_space.mutual_information_positive -> information_space.mutual_information_nonneg_simple Int_stable_cuboids -> Int_stable_atLeastAtMost Int_stable_product_algebra_generator -> positive_integral measure_preserving -> equality "distr M N f = N" "f : measurable M N" measure_space.additive -> emeasure_additive measure_space.AE_iff_null_set -> AE_iff_null measure_space.almost_everywhere_def -> eventually_ae_filter measure_space.almost_everywhere_vimage -> AE_distrD measure_space.continuity_from_above -> INF_emeasure_decseq measure_space.continuity_from_above_Lim -> Lim_emeasure_decseq measure_space.continuity_from_below_Lim -> Lim_emeasure_incseq measure_space.continuity_from_below -> SUP_emeasure_incseq measure_space_density -> emeasure_density measure_space.density_is_absolutely_continuous -> absolutely_continuousI_density measure_space.integrable_vimage -> integrable_distr measure_space.integral_translated_density -> integral_density measure_space.integral_vimage -> integral_distr measure_space.measure_additive -> plus_emeasure measure_space.measure_compl -> emeasure_compl measure_space.measure_countable_increasing -> emeasure_countable_increasing measure_space.measure_countably_subadditive -> emeasure_subadditive_countably measure_space.measure_decseq -> decseq_emeasure measure_space.measure_Diff -> emeasure_Diff measure_space.measure_Diff_null_set -> emeasure_Diff_null_set measure_space.measure_eq_0 -> emeasure_eq_0 measure_space.measure_finitely_subadditive -> emeasure_subadditive_finite measure_space.measure_finite_singleton -> emeasure_eq_setsum_singleton measure_space.measure_incseq -> incseq_emeasure measure_space.measure_insert -> emeasure_insert measure_space.measure_mono -> emeasure_mono measure_space.measure_not_negative -> emeasure_not_MInf measure_space.measure_preserving_Int_stable -> measure_eqI_generator_eq measure_space.measure_setsum -> setsum_emeasure measure_space.measure_setsum_split -> setsum_emeasure_cover measure_space.measure_space_vimage -> emeasure_distr measure_space.measure_subadditive_finite -> emeasure_subadditive_finite measure_space.measure_subadditive -> subadditive measure_space.measure_top -> emeasure_space measure_space.measure_UN_eq_0 -> emeasure_UN_eq_0 measure_space.measure_Un_null_set -> emeasure_Un_null_set measure_space.positive_integral_translated_density -> positive_integral_density measure_space.positive_integral_vimage -> positive_integral_distr measure_space.real_continuity_from_above -> Lim_measure_decseq measure_space.real_continuity_from_below -> Lim_measure_incseq measure_space.real_measure_countably_subadditive -> measure_subadditive_countably measure_space.real_measure_Diff -> measure_Diff measure_space.real_measure_finite_Union -> measure_finite_Union measure_space.real_measure_setsum_singleton -> measure_eq_setsum_singleton measure_space.real_measure_subadditive -> measure_subadditive measure_space.real_measure_Union -> measure_Union measure_space.real_measure_UNION -> measure_UNION measure_space.simple_function_vimage -> simple_function_comp measure_space.simple_integral_vimage -> simple_integral_distr measure_space.simple_integral_vimage -> simple_integral_distr measure_unique_Int_stable -> measure_eqI_generator_eq measure_unique_Int_stable_vimage -> measure_eqI_generator_eq pair_sigma_algebra.measurable_cut_fst -> sets_Pair1 pair_sigma_algebra.measurable_cut_snd -> sets_Pair2 pair_sigma_algebra.measurable_pair_image_fst -> measurable_Pair1 pair_sigma_algebra.measurable_pair_image_snd -> measurable_Pair2 pair_sigma_algebra.measurable_product_swap -> measurable_pair_swap_iff pair_sigma_algebra.pair_sigma_algebra_measurable -> measurable_pair_swap pair_sigma_algebra.pair_sigma_algebra_swap_measurable -> measurable_pair_swap' pair_sigma_algebra.sets_swap -> sets_pair_swap pair_sigma_finite.measure_cut_measurable_fst -> pair_sigma_finite.measurable_emeasure_Pair1 pair_sigma_finite.measure_cut_measurable_snd -> pair_sigma_finite.measurable_emeasure_Pair2 pair_sigma_finite.measure_preserving_swap -> pair_sigma_finite.distr_pair_swap pair_sigma_finite.pair_measure_alt2 -> pair_sigma_finite.emeasure_pair_measure_alt2 pair_sigma_finite.pair_measure_alt -> pair_sigma_finite.emeasure_pair_measure_alt pair_sigma_finite.pair_measure_times -> pair_sigma_finite.emeasure_pair_measure_Times prob_space.indep_distribution_eq_measure -> prob_space.indep_vars_iff_distr_eq_PiM prob_space.indep_var_distributionD -> prob_space.indep_var_distribution_eq prob_space.measure_space_1 -> prob_space.emeasure_space_1 prob_space.prob_space_vimage -> prob_space_distr prob_space.random_variable_restrict -> measurable_restrict prob_space_unique_Int_stable -> measure_eqI_prob_space product_algebraE -> prod_algebraE_all product_algebra_generator_der -> prod_algebra_eq_finite product_algebra_generator_into_space -> prod_algebra_sets_into_space product_algebraI -> sets_PiM_I_finite product_measure_exists -> product_sigma_finite.sigma_finite product_prob_space.finite_index_eq_finite_product -> product_prob_space.sets_PiM_generator product_prob_space.finite_measure_infprod_emb_Pi -> product_prob_space.measure_PiM_emb product_prob_space.infprod_spec -> product_prob_space.emeasure_PiM_emb_not_empty product_prob_space.measurable_component -> measurable_component_singleton product_prob_space.measurable_emb -> measurable_prod_emb product_prob_space.measurable_into_infprod_algebra -> measurable_PiM_single product_prob_space.measurable_singleton_infprod -> measurable_component_singleton product_prob_space.measure_emb -> emeasure_prod_emb product_prob_space.measure_preserving_restrict -> product_prob_space.distr_restrict product_sigma_algebra.product_algebra_into_space -> space_closed product_sigma_finite.measure_fold -> product_sigma_finite.distr_merge product_sigma_finite.measure_preserving_component_singelton -> product_sigma_finite.distr_singleton product_sigma_finite.measure_preserving_merge -> product_sigma_finite.distr_merge sequence_space.measure_infprod -> sequence_space.measure_PiM_countable sets_product_algebra -> sets_PiM sigma_algebra.measurable_sigma -> measurable_measure_of sigma_finite_measure.disjoint_sigma_finite -> sigma_finite_disjoint sigma_finite_measure.RN_deriv_vimage -> sigma_finite_measure.RN_deriv_distr sigma_product_algebra_sigma_eq -> sigma_prod_algebra_sigma_eq space_product_algebra -> space_PiM * Session HOL-TPTP: support to parse and import TPTP problems (all languages) into Isabelle/HOL. *** FOL *** * New "case_product" attribute (see HOL). *** ZF *** * Greater support for structured proofs involving induction or case analysis. * Much greater use of mathematical symbols. * Removal of many ML theorem bindings. INCOMPATIBILITY. *** ML *** * Antiquotation @{keyword "name"} produces a parser for outer syntax from a minor keyword introduced via theory header declaration. * Antiquotation @{command_spec "name"} produces the Outer_Syntax.command_spec from a major keyword introduced via theory header declaration; it can be passed to Outer_Syntax.command etc. * Local_Theory.define no longer hard-wires default theorem name "foo_def", but retains the binding as given. If that is Binding.empty / Attrib.empty_binding, the result is not registered as user-level fact. The Local_Theory.define_internal variant allows to specify a non-empty name (used for the foundation in the background theory), while omitting the fact binding in the user-context. Potential INCOMPATIBILITY for derived definitional packages: need to specify naming policy for primitive definitions more explicitly. * Renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic. * Antiquotation @{attributes [...]} embeds attribute source representation into the ML text, which is particularly useful with declarations like Local_Theory.note. * Structure Proof_Context follows standard naming scheme. Old ProofContext has been discontinued. INCOMPATIBILITY. * Refined Local_Theory.declaration {syntax, pervasive}, with subtle change of semantics: update is applied to auxiliary local theory context as well. * Modernized some old-style infix operations: addeqcongs ~> Simplifier.add_eqcong deleqcongs ~> Simplifier.del_eqcong addcongs ~> Simplifier.add_cong delcongs ~> Simplifier.del_cong setmksimps ~> Simplifier.set_mksimps setmkcong ~> Simplifier.set_mkcong setmksym ~> Simplifier.set_mksym setmkeqTrue ~> Simplifier.set_mkeqTrue settermless ~> Simplifier.set_termless setsubgoaler ~> Simplifier.set_subgoaler addsplits ~> Splitter.add_split delsplits ~> Splitter.del_split *** System *** * USER_HOME settings variable points to cross-platform user home directory, which coincides with HOME on POSIX systems only. Likewise, the Isabelle path specification "~" now expands to $USER_HOME, instead of former $HOME. A different default for USER_HOME may be set explicitly in shell environment, before Isabelle settings are evaluated. Minor INCOMPATIBILITY: need to adapt Isabelle path where the generic user home was intended. * ISABELLE_HOME_WINDOWS refers to ISABELLE_HOME in windows file name notation, which is useful for the jEdit file browser, for example. * ISABELLE_JDK_HOME settings variable points to JDK with javac and jar (not just JRE). New in Isabelle2011-1 (October 2011) ------------------------------------ *** General *** * Improved Isabelle/jEdit Prover IDE (PIDE), which can be invoked as "isabelle jedit" or "ISABELLE_HOME/Isabelle" on the command line. - Management of multiple theory files directly from the editor buffer store -- bypassing the file-system (no requirement to save files for checking). - Markup of formal entities within the text buffer, with semantic highlighting, tooltips and hyperlinks to jump to defining source positions. - Improved text rendering, with sub/superscripts in the source buffer (including support for copy/paste wrt. output panel, HTML theory output and other non-Isabelle text boxes). - Refined scheduling of proof checking and printing of results, based on interactive editor view. (Note: jEdit folding and narrowing allows to restrict buffer perspectives explicitly.) - Reduced CPU performance requirements, usable on machines with few cores. - Reduced memory requirements due to pruning of unused document versions (garbage collection). See also ~~/src/Tools/jEdit/README.html for further information, including some remaining limitations. * Theory loader: source files are exclusively located via the master directory of each theory node (where the .thy file itself resides). The global load path (such as src/HOL/Library) has been discontinued. Note that the path element ~~ may be used to reference theories in the Isabelle home folder -- for instance, "~~/src/HOL/Library/FuncSet". INCOMPATIBILITY. * Theory loader: source files are identified by content via SHA1 digests. Discontinued former path/modtime identification and optional ISABELLE_FILE_IDENT plugin scripts. * Parallelization of nested Isar proofs is subject to Goal.parallel_proofs_threshold (default 100). See also isabelle usedir option -Q. * Name space: former unsynchronized references are now proper configuration options, with more conventional names: long_names ~> names_long short_names ~> names_short unique_names ~> names_unique Minor INCOMPATIBILITY, need to declare options in context like this: declare [[names_unique = false]] * Literal facts `prop` may contain dummy patterns, e.g. `_ = _`. Note that the result needs to be unique, which means fact specifications may have to be refined after enriching a proof context. * Attribute "case_names" has been refined: the assumptions in each case can be named now by following the case name with [name1 name2 ...]. * Isabelle/Isar reference manual has been updated and extended: - "Synopsis" provides a catalog of main Isar language concepts. - Formal references in syntax diagrams, via @{rail} antiquotation. - Updated material from classic "ref" manual, notably about "Classical Reasoner". *** HOL *** * Class bot and top require underlying partial order rather than preorder: uniqueness of bot and top is guaranteed. INCOMPATIBILITY. * Class complete_lattice: generalized a couple of lemmas from sets; generalized theorems INF_cong and SUP_cong. New type classes for complete boolean algebras and complete linear orders. Lemmas Inf_less_iff, less_Sup_iff, INF_less_iff, less_SUP_iff now reside in class complete_linorder. Changed proposition of lemmas Inf_bool_def, Sup_bool_def, Inf_fun_def, Sup_fun_def, Inf_apply, Sup_apply. Removed redundant lemmas (the right hand side gives hints how to replace them for (metis ...), or (simp only: ...) proofs): Inf_singleton ~> Inf_insert [where A="{}", unfolded Inf_empty inf_top_right] Sup_singleton ~> Sup_insert [where A="{}", unfolded Sup_empty sup_bot_right] Inf_binary ~> Inf_insert, Inf_empty, and inf_top_right Sup_binary ~> Sup_insert, Sup_empty, and sup_bot_right Int_eq_Inter ~> Inf_insert, Inf_empty, and inf_top_right Un_eq_Union ~> Sup_insert, Sup_empty, and sup_bot_right Inter_def ~> INF_def, image_def Union_def ~> SUP_def, image_def INT_eq ~> INF_def, and image_def UN_eq ~> SUP_def, and image_def INF_subset ~> INF_superset_mono [OF _ order_refl] More consistent and comprehensive names: INTER_eq_Inter_image ~> INF_def UNION_eq_Union_image ~> SUP_def INFI_def ~> INF_def SUPR_def ~> SUP_def INF_leI ~> INF_lower INF_leI2 ~> INF_lower2 le_INFI ~> INF_greatest le_SUPI ~> SUP_upper le_SUPI2 ~> SUP_upper2 SUP_leI ~> SUP_least INFI_bool_eq ~> INF_bool_eq SUPR_bool_eq ~> SUP_bool_eq INFI_apply ~> INF_apply SUPR_apply ~> SUP_apply INTER_def ~> INTER_eq UNION_def ~> UNION_eq INCOMPATIBILITY. * Renamed theory Complete_Lattice to Complete_Lattices. INCOMPATIBILITY. * Theory Complete_Lattices: lemmas Inf_eq_top_iff, INF_eq_top_iff, INF_image, Inf_insert, INF_top, Inf_top_conv, INF_top_conv, SUP_bot, Sup_bot_conv, SUP_bot_conv, Sup_eq_top_iff, SUP_eq_top_iff, SUP_image, Sup_insert are now declared as [simp]. INCOMPATIBILITY. * Theory Lattice: lemmas compl_inf_bot, compl_le_comp_iff, compl_sup_top, inf_idem, inf_left_idem, inf_sup_absorb, sup_idem, sup_inf_absob, sup_left_idem are now declared as [simp]. Minor INCOMPATIBILITY. * Added syntactic classes "inf" and "sup" for the respective constants. INCOMPATIBILITY: Changes in the argument order of the (mostly internal) locale predicates for some derived classes. * Theorem collections ball_simps and bex_simps do not contain theorems referring to UNION any longer; these have been moved to collection UN_ball_bex_simps. INCOMPATIBILITY. * Theory Archimedean_Field: floor now is defined as parameter of a separate type class floor_ceiling. * Theory Finite_Set: more coherent development of fold_set locales: locale fun_left_comm ~> locale comp_fun_commute locale fun_left_comm_idem ~> locale comp_fun_idem Both use point-free characterization; interpretation proofs may need adjustment. INCOMPATIBILITY. * Theory Limits: Type "'a net" has been renamed to "'a filter", in accordance with standard mathematical terminology. INCOMPATIBILITY. * Theory Complex_Main: The locale interpretations for the bounded_linear and bounded_bilinear locales have been removed, in order to reduce the number of duplicate lemmas. Users must use the original names for distributivity theorems, potential INCOMPATIBILITY. divide.add ~> add_divide_distrib divide.diff ~> diff_divide_distrib divide.setsum ~> setsum_divide_distrib mult.add_right ~> right_distrib mult.diff_right ~> right_diff_distrib mult_right.setsum ~> setsum_right_distrib mult_left.diff ~> left_diff_distrib * Theory Complex_Main: Several redundant theorems have been removed or replaced by more general versions. INCOMPATIBILITY. real_diff_def ~> minus_real_def real_divide_def ~> divide_real_def real_less_def ~> less_le real_abs_def ~> abs_real_def real_sgn_def ~> sgn_real_def real_mult_commute ~> mult_commute real_mult_assoc ~> mult_assoc real_mult_1 ~> mult_1_left real_add_mult_distrib ~> left_distrib real_zero_not_eq_one ~> zero_neq_one real_mult_inverse_left ~> left_inverse INVERSE_ZERO ~> inverse_zero real_le_refl ~> order_refl real_le_antisym ~> order_antisym real_le_trans ~> order_trans real_le_linear ~> linear real_le_eq_diff ~> le_iff_diff_le_0 real_add_left_mono ~> add_left_mono real_mult_order ~> mult_pos_pos real_mult_less_mono2 ~> mult_strict_left_mono real_of_int_real_of_nat ~> real_of_int_of_nat_eq real_0_le_divide_iff ~> zero_le_divide_iff realpow_two_disj ~> power2_eq_iff real_squared_diff_one_factored ~> square_diff_one_factored realpow_two_diff ~> square_diff_square_factored reals_complete2 ~> complete_real real_sum_squared_expand ~> power2_sum exp_ln_eq ~> ln_unique expi_add ~> exp_add expi_zero ~> exp_zero lemma_DERIV_subst ~> DERIV_cong LIMSEQ_Zfun_iff ~> tendsto_Zfun_iff LIMSEQ_const ~> tendsto_const LIMSEQ_norm ~> tendsto_norm LIMSEQ_add ~> tendsto_add LIMSEQ_minus ~> tendsto_minus LIMSEQ_minus_cancel ~> tendsto_minus_cancel LIMSEQ_diff ~> tendsto_diff bounded_linear.LIMSEQ ~> bounded_linear.tendsto bounded_bilinear.LIMSEQ ~> bounded_bilinear.tendsto LIMSEQ_mult ~> tendsto_mult LIMSEQ_inverse ~> tendsto_inverse LIMSEQ_divide ~> tendsto_divide LIMSEQ_pow ~> tendsto_power LIMSEQ_setsum ~> tendsto_setsum LIMSEQ_setprod ~> tendsto_setprod LIMSEQ_norm_zero ~> tendsto_norm_zero_iff LIMSEQ_rabs_zero ~> tendsto_rabs_zero_iff LIMSEQ_imp_rabs ~> tendsto_rabs LIMSEQ_add_minus ~> tendsto_add [OF _ tendsto_minus] LIMSEQ_add_const ~> tendsto_add [OF _ tendsto_const] LIMSEQ_diff_const ~> tendsto_diff [OF _ tendsto_const] LIMSEQ_Complex ~> tendsto_Complex LIM_ident ~> tendsto_ident_at LIM_const ~> tendsto_const LIM_add ~> tendsto_add LIM_add_zero ~> tendsto_add_zero LIM_minus ~> tendsto_minus LIM_diff ~> tendsto_diff LIM_norm ~> tendsto_norm LIM_norm_zero ~> tendsto_norm_zero LIM_norm_zero_cancel ~> tendsto_norm_zero_cancel LIM_norm_zero_iff ~> tendsto_norm_zero_iff LIM_rabs ~> tendsto_rabs LIM_rabs_zero ~> tendsto_rabs_zero LIM_rabs_zero_cancel ~> tendsto_rabs_zero_cancel LIM_rabs_zero_iff ~> tendsto_rabs_zero_iff LIM_compose ~> tendsto_compose LIM_mult ~> tendsto_mult LIM_scaleR ~> tendsto_scaleR LIM_of_real ~> tendsto_of_real LIM_power ~> tendsto_power LIM_inverse ~> tendsto_inverse LIM_sgn ~> tendsto_sgn isCont_LIM_compose ~> isCont_tendsto_compose bounded_linear.LIM ~> bounded_linear.tendsto bounded_linear.LIM_zero ~> bounded_linear.tendsto_zero bounded_bilinear.LIM ~> bounded_bilinear.tendsto bounded_bilinear.LIM_prod_zero ~> bounded_bilinear.tendsto_zero bounded_bilinear.LIM_left_zero ~> bounded_bilinear.tendsto_left_zero bounded_bilinear.LIM_right_zero ~> bounded_bilinear.tendsto_right_zero LIM_inverse_fun ~> tendsto_inverse [OF tendsto_ident_at] * Theory Complex_Main: The definition of infinite series was generalized. Now it is defined on the type class {topological_space, comm_monoid_add}. Hence it is useable also for extended real numbers. * Theory Complex_Main: The complex exponential function "expi" is now a type-constrained abbreviation for "exp :: complex => complex"; thus several polymorphic lemmas about "exp" are now applicable to "expi". * Code generation: - Theory Library/Code_Char_ord provides native ordering of characters in the target language. - Commands code_module and code_library are legacy, use export_code instead. - Method "evaluation" is legacy, use method "eval" instead. - Legacy evaluator "SML" is deactivated by default. May be reactivated by the following theory command: setup {* Value.add_evaluator ("SML", Codegen.eval_term) *} * Declare ext [intro] by default. Rare INCOMPATIBILITY. * New proof method "induction" that gives induction hypotheses the name "IH", thus distinguishing them from further hypotheses that come from rule induction. The latter are still called "hyps". Method "induction" is a thin wrapper around "induct" and follows the same syntax. * Method "fastsimp" has been renamed to "fastforce", but "fastsimp" is still available as a legacy feature for some time. * Nitpick: - Added "need" and "total_consts" options. - Reintroduced "show_skolems" option by popular demand. - Renamed attribute: nitpick_def ~> nitpick_unfold. INCOMPATIBILITY. * Sledgehammer: - Use quasi-sound (and efficient) translations by default. - Added support for the following provers: E-ToFoF, LEO-II, Satallax, SNARK, Waldmeister, and Z3 with TPTP syntax. - Automatically preplay and minimize proofs before showing them if this can be done within reasonable time. - sledgehammer available_provers ~> sledgehammer supported_provers. INCOMPATIBILITY. - Added "preplay_timeout", "slicing", "type_enc", "sound", "max_mono_iters", and "max_new_mono_instances" options. - Removed "explicit_apply" and "full_types" options as well as "Full Types" Proof General menu item. INCOMPATIBILITY. * Metis: - Removed "metisF" -- use "metis" instead. INCOMPATIBILITY. - Obsoleted "metisFT" -- use "metis (full_types)" instead. INCOMPATIBILITY. * Command 'try': - Renamed 'try_methods' and added "simp:", "intro:", "dest:", and "elim:" options. INCOMPATIBILITY. - Introduced 'try' that not only runs 'try_methods' but also 'solve_direct', 'sledgehammer', 'quickcheck', and 'nitpick'. * Quickcheck: - Added "eval" option to evaluate terms for the found counterexample (currently only supported by the default (exhaustive) tester). - Added post-processing of terms to obtain readable counterexamples (currently only supported by the default (exhaustive) tester). - New counterexample generator quickcheck[narrowing] enables narrowing-based testing. Requires the Glasgow Haskell compiler with its installation location defined in the Isabelle settings environment as ISABELLE_GHC. - Removed quickcheck tester "SML" based on the SML code generator (formly in HOL/Library). * Function package: discontinued option "tailrec". INCOMPATIBILITY, use 'partial_function' instead. * Theory Library/Extended_Reals replaces now the positive extended reals found in probability theory. This file is extended by Multivariate_Analysis/Extended_Real_Limits. * Theory Library/Old_Recdef: old 'recdef' package has been moved here, from where it must be imported explicitly if it is really required. INCOMPATIBILITY. * Theory Library/Wfrec: well-founded recursion combinator "wfrec" has been moved here. INCOMPATIBILITY. * Theory Library/Saturated provides type of numbers with saturated arithmetic. * Theory Library/Product_Lattice defines a pointwise ordering for the product type 'a * 'b, and provides instance proofs for various order and lattice type classes. * Theory Library/Countable now provides the "countable_datatype" proof method for proving "countable" class instances for datatypes. * Theory Library/Cset_Monad allows do notation for computable sets (cset) via the generic monad ad-hoc overloading facility. * Library: Theories of common data structures are split into theories for implementation, an invariant-ensuring type, and connection to an abstract type. INCOMPATIBILITY. - RBT is split into RBT and RBT_Mapping. - AssocList is split and renamed into AList and AList_Mapping. - DList is split into DList_Impl, DList, and DList_Cset. - Cset is split into Cset and List_Cset. * Theory Library/Nat_Infinity has been renamed to Library/Extended_Nat, with name changes of the following types and constants: type inat ~> type enat Fin ~> enat Infty ~> infinity (overloaded) iSuc ~> eSuc the_Fin ~> the_enat Every theorem name containing "inat", "Fin", "Infty", or "iSuc" has been renamed accordingly. INCOMPATIBILITY. * Session Multivariate_Analysis: The euclidean_space type class now fixes a constant "Basis :: 'a set" consisting of the standard orthonormal basis for the type. Users now have the option of quantifying over this set instead of using the "basis" function, e.g. "ALL x:Basis. P x" vs "ALL i vec_eq_iff dist_nth_le_cart ~> dist_vec_nth_le tendsto_vector ~> vec_tendstoI Cauchy_vector ~> vec_CauchyI * Session Multivariate_Analysis: Several duplicate theorems have been removed, and other theorems have been renamed or replaced with more general versions. INCOMPATIBILITY. finite_choice ~> finite_set_choice eventually_conjI ~> eventually_conj eventually_and ~> eventually_conj_iff eventually_false ~> eventually_False setsum_norm ~> norm_setsum Lim_sequentially ~> LIMSEQ_def Lim_ident_at ~> LIM_ident Lim_const ~> tendsto_const Lim_cmul ~> tendsto_scaleR [OF tendsto_const] Lim_neg ~> tendsto_minus Lim_add ~> tendsto_add Lim_sub ~> tendsto_diff Lim_mul ~> tendsto_scaleR Lim_vmul ~> tendsto_scaleR [OF _ tendsto_const] Lim_null_norm ~> tendsto_norm_zero_iff [symmetric] Lim_linear ~> bounded_linear.tendsto Lim_component ~> tendsto_euclidean_component Lim_component_cart ~> tendsto_vec_nth Lim_inner ~> tendsto_inner [OF tendsto_const] dot_lsum ~> inner_setsum_left dot_rsum ~> inner_setsum_right continuous_cmul ~> continuous_scaleR [OF continuous_const] continuous_neg ~> continuous_minus continuous_sub ~> continuous_diff continuous_vmul ~> continuous_scaleR [OF _ continuous_const] continuous_mul ~> continuous_scaleR continuous_inv ~> continuous_inverse continuous_at_within_inv ~> continuous_at_within_inverse continuous_at_inv ~> continuous_at_inverse continuous_at_norm ~> continuous_norm [OF continuous_at_id] continuous_at_infnorm ~> continuous_infnorm [OF continuous_at_id] continuous_at_component ~> continuous_component [OF continuous_at_id] continuous_on_neg ~> continuous_on_minus continuous_on_sub ~> continuous_on_diff continuous_on_cmul ~> continuous_on_scaleR [OF continuous_on_const] continuous_on_vmul ~> continuous_on_scaleR [OF _ continuous_on_const] continuous_on_mul ~> continuous_on_scaleR continuous_on_mul_real ~> continuous_on_mult continuous_on_inner ~> continuous_on_inner [OF continuous_on_const] continuous_on_norm ~> continuous_on_norm [OF continuous_on_id] continuous_on_inverse ~> continuous_on_inv uniformly_continuous_on_neg ~> uniformly_continuous_on_minus uniformly_continuous_on_sub ~> uniformly_continuous_on_diff subset_interior ~> interior_mono subset_closure ~> closure_mono closure_univ ~> closure_UNIV real_arch_lt ~> reals_Archimedean2 real_arch ~> reals_Archimedean3 real_abs_norm ~> abs_norm_cancel real_abs_sub_norm ~> norm_triangle_ineq3 norm_cauchy_schwarz_abs ~> Cauchy_Schwarz_ineq2 * Session HOL-Probability: - Caratheodory's extension lemma is now proved for ring_of_sets. - Infinite products of probability measures are now available. - Sigma closure is independent, if the generator is independent - Use extended reals instead of positive extended reals. INCOMPATIBILITY. * Session HOLCF: Discontinued legacy theorem names, INCOMPATIBILITY. expand_fun_below ~> fun_below_iff below_fun_ext ~> fun_belowI expand_cfun_eq ~> cfun_eq_iff ext_cfun ~> cfun_eqI expand_cfun_below ~> cfun_below_iff below_cfun_ext ~> cfun_belowI monofun_fun_fun ~> fun_belowD monofun_fun_arg ~> monofunE monofun_lub_fun ~> adm_monofun [THEN admD] cont_lub_fun ~> adm_cont [THEN admD] cont2cont_Rep_CFun ~> cont2cont_APP cont_Rep_CFun_app ~> cont_APP_app cont_Rep_CFun_app_app ~> cont_APP_app_app cont_cfun_fun ~> cont_Rep_cfun1 [THEN contE] cont_cfun_arg ~> cont_Rep_cfun2 [THEN contE] contlub_cfun ~> lub_APP [symmetric] contlub_LAM ~> lub_LAM [symmetric] thelubI ~> lub_eqI UU_I ~> bottomI lift_distinct1 ~> lift.distinct(1) lift_distinct2 ~> lift.distinct(2) Def_not_UU ~> lift.distinct(2) Def_inject ~> lift.inject below_UU_iff ~> below_bottom_iff eq_UU_iff ~> eq_bottom_iff *** Document preparation *** * Antiquotation @{rail} layouts railroad syntax diagrams, see also isar-ref manual, both for description and actual application of the same. * Antiquotation @{value} evaluates the given term and presents its result. * Antiquotations: term style "isub" provides ad-hoc conversion of variables x1, y23 into subscripted form x\<^isub>1, y\<^isub>2\<^isub>3. * Predefined LaTeX macros for Isabelle symbols \ and \ (e.g. see ~~/src/HOL/Library/Monad_Syntax.thy). * Localized \isabellestyle switch can be used within blocks or groups like this: \isabellestyle{it} %preferred default {\isabellestylett @{text "typewriter stuff"}} * Discontinued special treatment of hard tabulators. Implicit tab-width is now defined as 1. Potential INCOMPATIBILITY for visual layouts. *** ML *** * The inner syntax of sort/type/term/prop supports inlined YXML representations within quoted string tokens. By encoding logical entities via Term_XML (in ML or Scala) concrete syntax can be bypassed, which is particularly useful for producing bits of text under external program control. * Antiquotations for ML and document preparation are managed as theory data, which requires explicit setup. * Isabelle_Process.is_active allows tools to check if the official process wrapper is running (Isabelle/Scala/jEdit) or the old TTY loop (better known as Proof General). * Structure Proof_Context follows standard naming scheme. Old ProofContext is still available for some time as legacy alias. * Structure Timing provides various operations for timing; supersedes former start_timing/end_timing etc. * Path.print is the official way to show file-system paths to users (including quotes etc.). * Inner syntax: identifiers in parse trees of generic categories "logic", "aprop", "idt" etc. carry position information (disguised as type constraints). Occasional INCOMPATIBILITY with non-compliant translations that choke on unexpected type constraints. Positions can be stripped in ML translations via Syntax.strip_positions / Syntax.strip_positions_ast, or via the syntax constant "_strip_positions" within parse trees. As last resort, positions can be disabled via the configuration option Syntax.positions, which is called "syntax_positions" in Isar attribute syntax. * Discontinued special status of various ML structures that contribute to structure Syntax (Ast, Lexicon, Mixfix, Parser, Printer etc.): less pervasive content, no inclusion in structure Syntax. INCOMPATIBILITY, refer directly to Ast.Constant, Lexicon.is_identifier, Syntax_Trans.mk_binder_tr etc. * Typed print translation: discontinued show_sorts argument, which is already available via context of "advanced" translation. * Refined PARALLEL_GOALS tactical: degrades gracefully for schematic goal states; body tactic needs to address all subgoals uniformly. * Slightly more special eq_list/eq_set, with shortcut involving pointer equality (assumes that eq relation is reflexive). * Classical tactics use proper Proof.context instead of historic types claset/clasimpset. Old-style declarations like addIs, addEs, addDs operate directly on Proof.context. Raw type claset retains its use as snapshot of the classical context, which can be recovered via (put_claset HOL_cs) etc. Type clasimpset has been discontinued. INCOMPATIBILITY, classical tactics and derived proof methods require proper Proof.context. *** System *** * Discontinued support for Poly/ML 5.2, which was the last version without proper multithreading and TimeLimit implementation. * Discontinued old lib/scripts/polyml-platform, which has been obsolete since Isabelle2009-2. * Various optional external tools are referenced more robustly and uniformly by explicit Isabelle settings as follows: ISABELLE_CSDP (formerly CSDP_EXE) ISABELLE_GHC (formerly EXEC_GHC or GHC_PATH) ISABELLE_OCAML (formerly EXEC_OCAML) ISABELLE_SWIPL (formerly EXEC_SWIPL) ISABELLE_YAP (formerly EXEC_YAP) Note that automated detection from the file-system or search path has been discontinued. INCOMPATIBILITY. * Scala layer provides JVM method invocation service for static methods of type (String)String, see Invoke_Scala.method in ML. For example: Invoke_Scala.method "java.lang.System.getProperty" "java.home" Together with YXML.string_of_body/parse_body and XML.Encode/Decode this allows to pass structured values between ML and Scala. * The IsabelleText fonts includes some further glyphs to support the Prover IDE. Potential INCOMPATIBILITY: users who happen to have installed a local copy (which is normally *not* required) need to delete or update it from ~~/lib/fonts/. New in Isabelle2011 (January 2011) ---------------------------------- *** General *** * Experimental Prover IDE based on Isabelle/Scala and jEdit (see src/Tools/jEdit). This also serves as IDE for Isabelle/ML, with useful tooltips and hyperlinks produced from its static analysis. The bundled component provides an executable Isabelle tool that can be run like this: Isabelle2011/bin/isabelle jedit * Significantly improved Isabelle/Isar implementation manual. * System settings: ISABELLE_HOME_USER now includes ISABELLE_IDENTIFIER (and thus refers to something like $HOME/.isabelle/Isabelle2011), while the default heap location within that directory lacks that extra suffix. This isolates multiple Isabelle installations from each other, avoiding problems with old settings in new versions. INCOMPATIBILITY, need to copy/upgrade old user settings manually. * Source files are always encoded as UTF-8, instead of old-fashioned ISO-Latin-1. INCOMPATIBILITY. Isabelle LaTeX documents might require the following package declarations: \usepackage[utf8]{inputenc} \usepackage{textcomp} * Explicit treatment of UTF-8 sequences as Isabelle symbols, such that a Unicode character is treated as a single symbol, not a sequence of non-ASCII bytes as before. Since Isabelle/ML string literals may contain symbols without further backslash escapes, Unicode can now be used here as well. Recall that Symbol.explode in ML provides a consistent view on symbols, while raw explode (or String.explode) merely give a byte-oriented representation. * Theory loader: source files are primarily located via the master directory of each theory node (where the .thy file itself resides). The global load path is still partially available as legacy feature. Minor INCOMPATIBILITY due to subtle change in file lookup: use explicit paths, relatively to the theory. * Special treatment of ML file names has been discontinued. Historically, optional extensions .ML or .sml were added on demand -- at the cost of clarity of file dependencies. Recall that Isabelle/ML files exclusively use the .ML extension. Minor INCOMPATIBILITY. * Various options that affect pretty printing etc. are now properly handled within the context via configuration options, instead of unsynchronized references or print modes. There are both ML Config.T entities and Isar declaration attributes to access these. ML (Config.T) Isar (attribute) eta_contract eta_contract show_brackets show_brackets show_sorts show_sorts show_types show_types show_question_marks show_question_marks show_consts show_consts show_abbrevs show_abbrevs Syntax.ast_trace syntax_ast_trace Syntax.ast_stat syntax_ast_stat Syntax.ambiguity_level syntax_ambiguity_level Goal_Display.goals_limit goals_limit Goal_Display.show_main_goal show_main_goal Method.rule_trace rule_trace Thy_Output.display thy_output_display Thy_Output.quotes thy_output_quotes Thy_Output.indent thy_output_indent Thy_Output.source thy_output_source Thy_Output.break thy_output_break Note that corresponding "..._default" references in ML may only be changed globally at the ROOT session setup, but *not* within a theory. The option "show_abbrevs" supersedes the former print mode "no_abbrevs" with inverted meaning. * More systematic naming of some configuration options. INCOMPATIBILITY. trace_simp ~> simp_trace debug_simp ~> simp_debug * Support for real valued configuration options, using simplistic floating-point notation that coincides with the inner syntax for float_token. * Support for real valued preferences (with approximative PGIP type): front-ends need to accept "pgint" values in float notation. INCOMPATIBILITY. * The IsabelleText font now includes Cyrillic, Hebrew, Arabic from DejaVu Sans. * Discontinued support for Poly/ML 5.0 and 5.1 versions. *** Pure *** * Command 'type_synonym' (with single argument) replaces somewhat outdated 'types', which is still available as legacy feature for some time. * Command 'nonterminal' (with 'and' separated list of arguments) replaces somewhat outdated 'nonterminals'. INCOMPATIBILITY. * Command 'notepad' replaces former 'example_proof' for experimentation in Isar without any result. INCOMPATIBILITY. * Locale interpretation commands 'interpret' and 'sublocale' accept lists of equations to map definitions in a locale to appropriate entities in the context of the interpretation. The 'interpretation' command already provided this functionality. * Diagnostic command 'print_dependencies' prints the locale instances that would be activated if the specified expression was interpreted in the current context. Variant "print_dependencies!" assumes a context without interpretations. * Diagnostic command 'print_interps' prints interpretations in proofs in addition to interpretations in theories. * Discontinued obsolete 'global' and 'local' commands to manipulate the theory name space. Rare INCOMPATIBILITY. The ML functions Sign.root_path and Sign.local_path may be applied directly where this feature is still required for historical reasons. * Discontinued obsolete 'constdefs' command. INCOMPATIBILITY, use 'definition' instead. * The "prems" fact, which refers to the accidental collection of foundational premises in the context, is now explicitly marked as legacy feature and will be discontinued soon. Consider using "assms" of the head statement or reference facts by explicit names. * Document antiquotations @{class} and @{type} print classes and type constructors. * Document antiquotation @{file} checks file/directory entries within the local file system. *** HOL *** * Coercive subtyping: functions can be declared as coercions and type inference will add them as necessary upon input of a term. Theory Complex_Main declares real :: nat => real and real :: int => real as coercions. A coercion function f is declared like this: declare [[coercion f]] To lift coercions through type constructors (e.g. from nat => real to nat list => real list), map functions can be declared, e.g. declare [[coercion_map map]] Currently coercion inference is activated only in theories including real numbers, i.e. descendants of Complex_Main. This is controlled by the configuration option "coercion_enabled", e.g. it can be enabled in other theories like this: declare [[coercion_enabled]] * Command 'partial_function' provides basic support for recursive function definitions over complete partial orders. Concrete instances are provided for i) the option type, ii) tail recursion on arbitrary types, and iii) the heap monad of Imperative_HOL. See src/HOL/ex/Fundefs.thy and src/HOL/Imperative_HOL/ex/Linked_Lists.thy for examples. * Function package: f.psimps rules are no longer implicitly declared as [simp]. INCOMPATIBILITY. * Datatype package: theorems generated for executable equality (class "eq") carry proper names and are treated as default code equations. * Inductive package: now offers command 'inductive_simps' to automatically derive instantiated and simplified equations for inductive predicates, similar to 'inductive_cases'. * Command 'enriched_type' allows to register properties of the functorial structure of types. * Improved infrastructure for term evaluation using code generator techniques, in particular static evaluation conversions. * Code generator: Scala (2.8 or higher) has been added to the target languages. * Code generator: globbing constant expressions "*" and "Theory.*" have been replaced by the more idiomatic "_" and "Theory._". INCOMPATIBILITY. * Code generator: export_code without explicit file declaration prints to standard output. INCOMPATIBILITY. * Code generator: do not print function definitions for case combinators any longer. * Code generator: simplification with rules determined with src/Tools/Code/code_simp.ML and method "code_simp". * Code generator for records: more idiomatic representation of record types. Warning: records are not covered by ancient SML code generation any longer. INCOMPATIBILITY. In cases of need, a suitable rep_datatype declaration helps to succeed then: record 'a foo = ... ... rep_datatype foo_ext ... * Records: logical foundation type for records does not carry a '_type' suffix any longer (obsolete due to authentic syntax). INCOMPATIBILITY. * Quickcheck now by default uses exhaustive testing instead of random testing. Random testing can be invoked by "quickcheck [random]", exhaustive testing by "quickcheck [exhaustive]". * Quickcheck instantiates polymorphic types with small finite datatypes by default. This enables a simple execution mechanism to handle quantifiers and function equality over the finite datatypes. * Quickcheck random generator has been renamed from "code" to "random". INCOMPATIBILITY. * Quickcheck now has a configurable time limit which is set to 30 seconds by default. This can be changed by adding [timeout = n] to the quickcheck command. The time limit for Auto Quickcheck is still set independently. * Quickcheck in locales considers interpretations of that locale for counter example search. * Sledgehammer: - Added "smt" and "remote_smt" provers based on the "smt" proof method. See the Sledgehammer manual for details ("isabelle doc sledgehammer"). - Renamed commands: sledgehammer atp_info ~> sledgehammer running_provers sledgehammer atp_kill ~> sledgehammer kill_provers sledgehammer available_atps ~> sledgehammer available_provers INCOMPATIBILITY. - Renamed options: sledgehammer [atps = ...] ~> sledgehammer [provers = ...] sledgehammer [atp = ...] ~> sledgehammer [prover = ...] sledgehammer [timeout = 77 s] ~> sledgehammer [timeout = 77] (and "ms" and "min" are no longer supported) INCOMPATIBILITY. * Nitpick: - Renamed options: nitpick [timeout = 77 s] ~> nitpick [timeout = 77] nitpick [tac_timeout = 777 ms] ~> nitpick [tac_timeout = 0.777] INCOMPATIBILITY. - Added support for partial quotient types. - Added local versions of the "Nitpick.register_xxx" functions. - Added "whack" option. - Allow registration of quotient types as codatatypes. - Improved "merge_type_vars" option to merge more types. - Removed unsound "fast_descrs" option. - Added custom symmetry breaking for datatypes, making it possible to reach higher cardinalities. - Prevent the expansion of too large definitions. * Proof methods "metis" and "meson" now have configuration options "meson_trace", "metis_trace", and "metis_verbose" that can be enabled to diagnose these tools. E.g. using [[metis_trace = true]] * Auto Solve: Renamed "Auto Solve Direct". The tool is now available manually as command 'solve_direct'. * The default SMT solver Z3 must be enabled explicitly (due to licensing issues) by setting the environment variable Z3_NON_COMMERCIAL in etc/settings of the component, for example. For commercial applications, the SMT solver CVC3 is provided as fall-back; changing the SMT solver is done via the configuration option "smt_solver". * Remote SMT solvers need to be referred to by the "remote_" prefix, i.e. "remote_cvc3" and "remote_z3". * Added basic SMT support for datatypes, records, and typedefs using the oracle mode (no proofs). Direct support of pairs has been dropped in exchange (pass theorems fst_conv snd_conv pair_collapse to the SMT support for a similar behavior). Minor INCOMPATIBILITY. * Changed SMT configuration options: - Renamed: z3_proofs ~> smt_oracle (with inverted meaning) z3_trace_assms ~> smt_trace_used_facts INCOMPATIBILITY. - Added: smt_verbose smt_random_seed smt_datatypes smt_infer_triggers smt_monomorph_limit cvc3_options remote_cvc3_options remote_z3_options yices_options * Boogie output files (.b2i files) need to be declared in the theory header. * Simplification procedure "list_to_set_comprehension" rewrites list comprehensions applied to List.set to set comprehensions. Occasional INCOMPATIBILITY, may be deactivated like this: declare [[simproc del: list_to_set_comprehension]] * Removed old version of primrec package. INCOMPATIBILITY. * Removed simplifier congruence rule of "prod_case", as has for long been the case with "split". INCOMPATIBILITY. * String.literal is a type, but not a datatype. INCOMPATIBILITY. * Removed [split_format ... and ... and ...] version of [split_format]. Potential INCOMPATIBILITY. * Predicate "sorted" now defined inductively, with nice induction rules. INCOMPATIBILITY: former sorted.simps now named sorted_simps. * Constant "contents" renamed to "the_elem", to free the generic name contents for other uses. INCOMPATIBILITY. * Renamed class eq and constant eq (for code generation) to class equal and constant equal, plus renaming of related facts and various tuning. INCOMPATIBILITY. * Dropped type classes mult_mono and mult_mono1. INCOMPATIBILITY. * Removed output syntax "'a ~=> 'b" for "'a => 'b option". INCOMPATIBILITY. * Renamed theory Fset to Cset, type Fset.fset to Cset.set, in order to avoid confusion with finite sets. INCOMPATIBILITY. * Abandoned locales equiv, congruent and congruent2 for equivalence relations. INCOMPATIBILITY: use equivI rather than equiv_intro (same for congruent(2)). * Some previously unqualified names have been qualified: types bool ~> HOL.bool nat ~> Nat.nat constants Trueprop ~> HOL.Trueprop True ~> HOL.True False ~> HOL.False op & ~> HOL.conj op | ~> HOL.disj op --> ~> HOL.implies op = ~> HOL.eq Not ~> HOL.Not The ~> HOL.The All ~> HOL.All Ex ~> HOL.Ex Ex1 ~> HOL.Ex1 Let ~> HOL.Let If ~> HOL.If Ball ~> Set.Ball Bex ~> Set.Bex Suc ~> Nat.Suc Pair ~> Product_Type.Pair fst ~> Product_Type.fst snd ~> Product_Type.snd curry ~> Product_Type.curry op : ~> Set.member Collect ~> Set.Collect INCOMPATIBILITY. * More canonical naming convention for some fundamental definitions: bot_bool_eq ~> bot_bool_def top_bool_eq ~> top_bool_def inf_bool_eq ~> inf_bool_def sup_bool_eq ~> sup_bool_def bot_fun_eq ~> bot_fun_def top_fun_eq ~> top_fun_def inf_fun_eq ~> inf_fun_def sup_fun_eq ~> sup_fun_def INCOMPATIBILITY. * More stylized fact names: expand_fun_eq ~> fun_eq_iff expand_set_eq ~> set_eq_iff set_ext ~> set_eqI nat_number ~> eval_nat_numeral INCOMPATIBILITY. * Refactoring of code-generation specific operations in theory List: constants null ~> List.null facts mem_iff ~> member_def null_empty ~> null_def INCOMPATIBILITY. Note that these were not supposed to be used regularly unless for striking reasons; their main purpose was code generation. Various operations from the Haskell prelude are used for generating Haskell code. * Term "bij f" is now an abbreviation of "bij_betw f UNIV UNIV". Term "surj f" is now an abbreviation of "range f = UNIV". The theorems bij_def and surj_def are unchanged. INCOMPATIBILITY. * Abolished some non-alphabetic type names: "prod" and "sum" replace "*" and "+" respectively. INCOMPATIBILITY. * Name "Plus" of disjoint sum operator "<+>" is now hidden. Write "Sum_Type.Plus" instead. * Constant "split" has been merged with constant "prod_case"; names of ML functions, facts etc. involving split have been retained so far, though. INCOMPATIBILITY. * Dropped old infix syntax "_ mem _" for List.member; use "_ : set _" instead. INCOMPATIBILITY. * Removed lemma "Option.is_none_none" which duplicates "is_none_def". INCOMPATIBILITY. * Former theory Library/Enum is now part of the HOL-Main image. INCOMPATIBILITY: all constants of the Enum theory now have to be referred to by its qualified name. enum ~> Enum.enum nlists ~> Enum.nlists product ~> Enum.product * Theory Library/Monad_Syntax provides do-syntax for monad types. Syntax in Library/State_Monad has been changed to avoid ambiguities. INCOMPATIBILITY. * Theory Library/SetsAndFunctions has been split into Library/Function_Algebras and Library/Set_Algebras; canonical names for instance definitions for functions; various improvements. INCOMPATIBILITY. * Theory Library/Multiset provides stable quicksort implementation of sort_key. * Theory Library/Multiset: renamed empty_idemp ~> empty_neutral. INCOMPATIBILITY. * Session Multivariate_Analysis: introduced a type class for euclidean space. Most theorems are now stated in terms of euclidean spaces instead of finite cartesian products. types real ^ 'n ~> 'a::real_vector ~> 'a::euclidean_space ~> 'a::ordered_euclidean_space (depends on your needs) constants _ $ _ ~> _ $$ _ \ x. _ ~> \\ x. _ CARD('n) ~> DIM('a) Also note that the indices are now natural numbers and not from some finite type. Finite cartesian products of euclidean spaces, products of euclidean spaces the real and complex numbers are instantiated to be euclidean_spaces. INCOMPATIBILITY. * Session Probability: introduced pextreal as positive extended real numbers. Use pextreal as value for measures. Introduce the Radon-Nikodym derivative, product spaces and Fubini's theorem for arbitrary sigma finite measures. Introduces Lebesgue measure based on the integral in Multivariate Analysis. INCOMPATIBILITY. * Session Imperative_HOL: revamped, corrected dozens of inadequacies. INCOMPATIBILITY. * Session SPARK (with image HOL-SPARK) provides commands to load and prove verification conditions generated by the SPARK Ada program verifier. See also src/HOL/SPARK and src/HOL/SPARK/Examples. *** HOL-Algebra *** * Theorems for additive ring operations (locale abelian_monoid and descendants) are generated by interpretation from their multiplicative counterparts. Names (in particular theorem names) have the mandatory qualifier 'add'. Previous theorem names are redeclared for compatibility. * Structure "int_ring" is now an abbreviation (previously a definition). This fits more natural with advanced interpretations. *** HOLCF *** * The domain package now runs in definitional mode by default: The former command 'new_domain' is now called 'domain'. To use the domain package in its original axiomatic mode, use 'domain (unsafe)'. INCOMPATIBILITY. * The new class "domain" is now the default sort. Class "predomain" is an unpointed version of "domain". Theories can be updated by replacing sort annotations as shown below. INCOMPATIBILITY. 'a::type ~> 'a::countable 'a::cpo ~> 'a::predomain 'a::pcpo ~> 'a::domain * The old type class "rep" has been superseded by class "domain". Accordingly, users of the definitional package must remove any "default_sort rep" declarations. INCOMPATIBILITY. * The domain package (definitional mode) now supports unpointed predomain argument types, as long as they are marked 'lazy'. (Strict arguments must be in class "domain".) For example, the following domain definition now works: domain natlist = nil | cons (lazy "nat discr") (lazy "natlist") * Theory HOLCF/Library/HOL_Cpo provides cpo and predomain class instances for types from main HOL: bool, nat, int, char, 'a + 'b, 'a option, and 'a list. Additionally, it configures fixrec and the domain package to work with these types. For example: fixrec isInl :: "('a + 'b) u -> tr" where "isInl$(up$(Inl x)) = TT" | "isInl$(up$(Inr y)) = FF" domain V = VFun (lazy "V -> V") | VCon (lazy "nat") (lazy "V list") * The "(permissive)" option of fixrec has been replaced with a per-equation "(unchecked)" option. See src/HOL/HOLCF/Tutorial/Fixrec_ex.thy for examples. INCOMPATIBILITY. * The "bifinite" class no longer fixes a constant "approx"; the class now just asserts that such a function exists. INCOMPATIBILITY. * Former type "alg_defl" has been renamed to "defl". HOLCF no longer defines an embedding of type 'a defl into udom by default; instances of "bifinite" and "domain" classes are available in src/HOL/HOLCF/Library/Defl_Bifinite.thy. * The syntax "REP('a)" has been replaced with "DEFL('a)". * The predicate "directed" has been removed. INCOMPATIBILITY. * The type class "finite_po" has been removed. INCOMPATIBILITY. * The function "cprod_map" has been renamed to "prod_map". INCOMPATIBILITY. * The monadic bind operator on each powerdomain has new binder syntax similar to sets, e.g. "\\x\xs. t" represents "upper_bind\xs\(\ x. t)". * The infix syntax for binary union on each powerdomain has changed from e.g. "+\" to "\\", for consistency with set syntax. INCOMPATIBILITY. * The constant "UU" has been renamed to "bottom". The syntax "UU" is still supported as an input translation. * Renamed some theorems (the original names are also still available). expand_fun_below ~> fun_below_iff below_fun_ext ~> fun_belowI expand_cfun_eq ~> cfun_eq_iff ext_cfun ~> cfun_eqI expand_cfun_below ~> cfun_below_iff below_cfun_ext ~> cfun_belowI cont2cont_Rep_CFun ~> cont2cont_APP * The Abs and Rep functions for various types have changed names. Related theorem names have also changed to match. INCOMPATIBILITY. Rep_CFun ~> Rep_cfun Abs_CFun ~> Abs_cfun Rep_Sprod ~> Rep_sprod Abs_Sprod ~> Abs_sprod Rep_Ssum ~> Rep_ssum Abs_Ssum ~> Abs_ssum * Lemmas with names of the form *_defined_iff or *_strict_iff have been renamed to *_bottom_iff. INCOMPATIBILITY. * Various changes to bisimulation/coinduction with domain package: - Definitions of "bisim" constants no longer mention definedness. - With mutual recursion, "bisim" predicate is now curried. - With mutual recursion, each type gets a separate coind theorem. - Variable names in bisim_def and coinduct rules have changed. INCOMPATIBILITY. * Case combinators generated by the domain package for type "foo" are now named "foo_case" instead of "foo_when". INCOMPATIBILITY. * Several theorems have been renamed to more accurately reflect the names of constants and types involved. INCOMPATIBILITY. thelub_const ~> lub_const lub_const ~> is_lub_const thelubI ~> lub_eqI is_lub_lub ~> is_lubD2 lubI ~> is_lub_lub unique_lub ~> is_lub_unique is_ub_lub ~> is_lub_rangeD1 lub_bin_chain ~> is_lub_bin_chain lub_fun ~> is_lub_fun thelub_fun ~> lub_fun thelub_cfun ~> lub_cfun thelub_Pair ~> lub_Pair lub_cprod ~> is_lub_prod thelub_cprod ~> lub_prod minimal_cprod ~> minimal_prod inst_cprod_pcpo ~> inst_prod_pcpo UU_I ~> bottomI compact_UU ~> compact_bottom deflation_UU ~> deflation_bottom finite_deflation_UU ~> finite_deflation_bottom * Many legacy theorem names have been discontinued. INCOMPATIBILITY. sq_ord_less_eq_trans ~> below_eq_trans sq_ord_eq_less_trans ~> eq_below_trans refl_less ~> below_refl trans_less ~> below_trans antisym_less ~> below_antisym antisym_less_inverse ~> po_eq_conv [THEN iffD1] box_less ~> box_below rev_trans_less ~> rev_below_trans not_less2not_eq ~> not_below2not_eq less_UU_iff ~> below_UU_iff flat_less_iff ~> flat_below_iff adm_less ~> adm_below adm_not_less ~> adm_not_below adm_compact_not_less ~> adm_compact_not_below less_fun_def ~> below_fun_def expand_fun_less ~> fun_below_iff less_fun_ext ~> fun_belowI less_discr_def ~> below_discr_def discr_less_eq ~> discr_below_eq less_unit_def ~> below_unit_def less_cprod_def ~> below_prod_def prod_lessI ~> prod_belowI Pair_less_iff ~> Pair_below_iff fst_less_iff ~> fst_below_iff snd_less_iff ~> snd_below_iff expand_cfun_less ~> cfun_below_iff less_cfun_ext ~> cfun_belowI injection_less ~> injection_below less_up_def ~> below_up_def not_Iup_less ~> not_Iup_below Iup_less ~> Iup_below up_less ~> up_below Def_inject_less_eq ~> Def_below_Def Def_less_is_eq ~> Def_below_iff spair_less_iff ~> spair_below_iff less_sprod ~> below_sprod spair_less ~> spair_below sfst_less_iff ~> sfst_below_iff ssnd_less_iff ~> ssnd_below_iff fix_least_less ~> fix_least_below dist_less_one ~> dist_below_one less_ONE ~> below_ONE ONE_less_iff ~> ONE_below_iff less_sinlD ~> below_sinlD less_sinrD ~> below_sinrD *** FOL and ZF *** * All constant names are now qualified internally and use proper identifiers, e.g. "IFOL.eq" instead of "op =". INCOMPATIBILITY. *** ML *** * Antiquotation @{assert} inlines a function bool -> unit that raises Fail if the argument is false. Due to inlining the source position of failed assertions is included in the error output. * Discontinued antiquotation @{theory_ref}, which is obsolete since ML text is in practice always evaluated with a stable theory checkpoint. Minor INCOMPATIBILITY, use (Theory.check_thy @{theory}) instead. * Antiquotation @{theory A} refers to theory A from the ancestry of the current context, not any accidental theory loader state as before. Potential INCOMPATIBILITY, subtle change in semantics. * Syntax.pretty_priority (default 0) configures the required priority of pretty-printed output and thus affects insertion of parentheses. * Syntax.default_root (default "any") configures the inner syntax category (nonterminal symbol) for parsing of terms. * Former exception Library.UnequalLengths now coincides with ListPair.UnequalLengths. * Renamed structure MetaSimplifier to Raw_Simplifier. Note that the main functionality is provided by structure Simplifier. * Renamed raw "explode" function to "raw_explode" to emphasize its meaning. Note that internally to Isabelle, Symbol.explode is used in almost all situations. * Discontinued obsolete function sys_error and exception SYS_ERROR. See implementation manual for further details on exceptions in Isabelle/ML. * Renamed setmp_noncritical to Unsynchronized.setmp to emphasize its meaning. * Renamed structure PureThy to Pure_Thy and moved most of its operations to structure Global_Theory, to emphasize that this is rarely-used global-only stuff. * Discontinued Output.debug. Minor INCOMPATIBILITY, use plain writeln instead (or tracing for high-volume output). * Configuration option show_question_marks only affects regular pretty printing of types and terms, not raw Term.string_of_vname. * ML_Context.thm and ML_Context.thms are no longer pervasive. Rare INCOMPATIBILITY, superseded by static antiquotations @{thm} and @{thms} for most purposes. * ML structure Unsynchronized is never opened, not even in Isar interaction mode as before. Old Unsynchronized.set etc. have been discontinued -- use plain := instead. This should be *rare* anyway, since modern tools always work via official context data, notably configuration options. * Parallel and asynchronous execution requires special care concerning interrupts. Structure Exn provides some convenience functions that avoid working directly with raw Interrupt. User code must not absorb interrupts -- intermediate handling (for cleanup etc.) needs to be followed by re-raising of the original exception. Another common source of mistakes are "handle _" patterns, which make the meaning of the program subject to physical effects of the environment. New in Isabelle2009-2 (June 2010) --------------------------------- *** General *** * Authentic syntax for *all* logical entities (type classes, type constructors, term constants): provides simple and robust correspondence between formal entities and concrete syntax. Within the parse tree / AST representations, "constants" are decorated by their category (class, type, const) and spelled out explicitly with their full internal name. Substantial INCOMPATIBILITY concerning low-level syntax declarations and translations (translation rules and translation functions in ML). Some hints on upgrading: - Many existing uses of 'syntax' and 'translations' can be replaced by more modern 'type_notation', 'notation' and 'abbreviation', which are independent of this issue. - 'translations' require markup within the AST; the term syntax provides the following special forms: CONST c -- produces syntax version of constant c from context XCONST c -- literally c, checked as constant from context c -- literally c, if declared by 'syntax' Plain identifiers are treated as AST variables -- occasionally the system indicates accidental variables via the error "rhs contains extra variables". Type classes and type constructors are marked according to their concrete syntax. Some old translations rules need to be written for the "type" category, using type constructor application instead of pseudo-term application of the default category "logic". - 'parse_translation' etc. in ML may use the following antiquotations: @{class_syntax c} -- type class c within parse tree / AST @{term_syntax c} -- type constructor c within parse tree / AST @{const_syntax c} -- ML version of "CONST c" above @{syntax_const c} -- literally c (checked wrt. 'syntax' declarations) - Literal types within 'typed_print_translations', i.e. those *not* represented as pseudo-terms are represented verbatim. Use @{class c} or @{type_name c} here instead of the above syntax antiquotations. Note that old non-authentic syntax was based on unqualified base names, so all of the above "constant" names would coincide. Recall that 'print_syntax' and ML_command "set Syntax.trace_ast" help to diagnose syntax problems. * Type constructors admit general mixfix syntax, not just infix. * Concrete syntax may be attached to local entities without a proof body, too. This works via regular mixfix annotations for 'fix', 'def', 'obtain' etc. or via the explicit 'write' command, which is similar to the 'notation' command in theory specifications. * Discontinued unnamed infix syntax (legacy feature for many years) -- need to specify constant name and syntax separately. Internal ML datatype constructors have been renamed from InfixName to Infix etc. Minor INCOMPATIBILITY. * Schematic theorem statements need to be explicitly markup as such, via commands 'schematic_lemma', 'schematic_theorem', 'schematic_corollary'. Thus the relevance of the proof is made syntactically clear, which impacts performance in a parallel or asynchronous interactive environment. Minor INCOMPATIBILITY. * Use of cumulative prems via "!" in some proof methods has been discontinued (old legacy feature). * References 'trace_simp' and 'debug_simp' have been replaced by configuration options stored in the context. Enabling tracing (the case of debugging is similar) in proofs works via using [[trace_simp = true]] Tracing is then active for all invocations of the simplifier in subsequent goal refinement steps. Tracing may also still be enabled or disabled via the ProofGeneral settings menu. * Separate commands 'hide_class', 'hide_type', 'hide_const', 'hide_fact' replace the former 'hide' KIND command. Minor INCOMPATIBILITY. * Improved parallelism of proof term normalization: usedir -p2 -q0 is more efficient than combinations with -q1 or -q2. *** Pure *** * Proofterms record type-class reasoning explicitly, using the "unconstrain" operation internally. This eliminates all sort constraints from a theorem and proof, introducing explicit OFCLASS-premises. On the proof term level, this operation is automatically applied at theorem boundaries, such that closed proofs are always free of sort constraints. INCOMPATIBILITY for tools that inspect proof terms. * Local theory specifications may depend on extra type variables that are not present in the result type -- arguments TYPE('a) :: 'a itself are added internally. For example: definition unitary :: bool where "unitary = (ALL (x::'a) y. x = y)" * Predicates of locales introduced by classes carry a mandatory "class" prefix. INCOMPATIBILITY. * Vacuous class specifications observe default sort. INCOMPATIBILITY. * Old 'axclass' command has been discontinued. INCOMPATIBILITY, use 'class' instead. * Command 'code_reflect' allows to incorporate generated ML code into runtime environment; replaces immature code_datatype antiquotation. INCOMPATIBILITY. * Code generator: simple concept for abstract datatypes obeying invariants. * Code generator: details of internal data cache have no impact on the user space functionality any longer. * Methods "unfold_locales" and "intro_locales" ignore non-locale subgoals. This is more appropriate for interpretations with 'where'. INCOMPATIBILITY. * Command 'example_proof' opens an empty proof body. This allows to experiment with Isar, without producing any persistent result. * Commands 'type_notation' and 'no_type_notation' declare type syntax within a local theory context, with explicit checking of the constructors involved (in contrast to the raw 'syntax' versions). * Commands 'types' and 'typedecl' now work within a local theory context -- without introducing dependencies on parameters or assumptions, which is not possible in Isabelle/Pure. * Command 'defaultsort' has been renamed to 'default_sort', it works within a local theory context. Minor INCOMPATIBILITY. *** HOL *** * Command 'typedef' now works within a local theory context -- without introducing dependencies on parameters or assumptions, which is not possible in Isabelle/Pure/HOL. Note that the logical environment may contain multiple interpretations of local typedefs (with different non-emptiness proofs), even in a global theory context. * New package for quotient types. Commands 'quotient_type' and 'quotient_definition' may be used for defining types and constants by quotient constructions. An example is the type of integers created by quotienting pairs of natural numbers: fun intrel :: "(nat * nat) => (nat * nat) => bool" where "intrel (x, y) (u, v) = (x + v = u + y)" quotient_type int = "nat * nat" / intrel by (auto simp add: equivp_def expand_fun_eq) quotient_definition "0::int" is "(0::nat, 0::nat)" The method "lifting" can be used to lift of theorems from the underlying "raw" type to the quotient type. The example src/HOL/Quotient_Examples/FSet.thy includes such a quotient construction and provides a reasoning infrastructure for finite sets. * Renamed Library/Quotient.thy to Library/Quotient_Type.thy to avoid clash with new theory Quotient in Main HOL. * Moved the SMT binding into the main HOL session, eliminating separate HOL-SMT session. * List membership infix mem operation is only an input abbreviation. INCOMPATIBILITY. * Theory Library/Word.thy has been removed. Use library Word/Word.thy for future developements; former Library/Word.thy is still present in the AFP entry RSAPPS. * Theorem Int.int_induct renamed to Int.int_of_nat_induct and is no longer shadowed. INCOMPATIBILITY. * Dropped theorem duplicate comp_arith; use semiring_norm instead. INCOMPATIBILITY. * Dropped theorem RealPow.real_sq_order; use power2_le_imp_le instead. INCOMPATIBILITY. * Dropped normalizing_semiring etc; use the facts in semiring classes instead. INCOMPATIBILITY. * Dropped several real-specific versions of lemmas about floor and ceiling; use the generic lemmas from theory "Archimedean_Field" instead. INCOMPATIBILITY. floor_number_of_eq ~> floor_number_of le_floor_eq_number_of ~> number_of_le_floor le_floor_eq_zero ~> zero_le_floor le_floor_eq_one ~> one_le_floor floor_less_eq_number_of ~> floor_less_number_of floor_less_eq_zero ~> floor_less_zero floor_less_eq_one ~> floor_less_one less_floor_eq_number_of ~> number_of_less_floor less_floor_eq_zero ~> zero_less_floor less_floor_eq_one ~> one_less_floor floor_le_eq_number_of ~> floor_le_number_of floor_le_eq_zero ~> floor_le_zero floor_le_eq_one ~> floor_le_one floor_subtract_number_of ~> floor_diff_number_of floor_subtract_one ~> floor_diff_one ceiling_number_of_eq ~> ceiling_number_of ceiling_le_eq_number_of ~> ceiling_le_number_of ceiling_le_zero_eq ~> ceiling_le_zero ceiling_le_eq_one ~> ceiling_le_one less_ceiling_eq_number_of ~> number_of_less_ceiling less_ceiling_eq_zero ~> zero_less_ceiling less_ceiling_eq_one ~> one_less_ceiling ceiling_less_eq_number_of ~> ceiling_less_number_of ceiling_less_eq_zero ~> ceiling_less_zero ceiling_less_eq_one ~> ceiling_less_one le_ceiling_eq_number_of ~> number_of_le_ceiling le_ceiling_eq_zero ~> zero_le_ceiling le_ceiling_eq_one ~> one_le_ceiling ceiling_subtract_number_of ~> ceiling_diff_number_of ceiling_subtract_one ~> ceiling_diff_one * Theory "Finite_Set": various folding_XXX locales facilitate the application of the various fold combinators on finite sets. * Library theory "RBT" renamed to "RBT_Impl"; new library theory "RBT" provides abstract red-black tree type which is backed by "RBT_Impl" as implementation. INCOMPATIBILITY. * Theory Library/Coinductive_List has been removed -- superseded by AFP/thys/Coinductive. * Theory PReal, including the type "preal" and related operations, has been removed. INCOMPATIBILITY. * Real: new development using Cauchy Sequences. * Split off theory "Big_Operators" containing setsum, setprod, Inf_fin, Sup_fin, Min, Max from theory Finite_Set. INCOMPATIBILITY. * Theory "Rational" renamed to "Rat", for consistency with "Nat", "Int" etc. INCOMPATIBILITY. * Constant Rat.normalize needs to be qualified. INCOMPATIBILITY. * New set of rules "ac_simps" provides combined assoc / commute rewrites for all interpretations of the appropriate generic locales. * Renamed theory "OrderedGroup" to "Groups" and split theory "Ring_and_Field" into theories "Rings" and "Fields"; for more appropriate and more consistent names suitable for name prefixes within the HOL theories. INCOMPATIBILITY. * Some generic constants have been put to appropriate theories: - less_eq, less: Orderings - zero, one, plus, minus, uminus, times, abs, sgn: Groups - inverse, divide: Rings INCOMPATIBILITY. * More consistent naming of type classes involving orderings (and lattices): lower_semilattice ~> semilattice_inf upper_semilattice ~> semilattice_sup dense_linear_order ~> dense_linorder pordered_ab_group_add ~> ordered_ab_group_add pordered_ab_group_add_abs ~> ordered_ab_group_add_abs pordered_ab_semigroup_add ~> ordered_ab_semigroup_add pordered_ab_semigroup_add_imp_le ~> ordered_ab_semigroup_add_imp_le pordered_cancel_ab_semigroup_add ~> ordered_cancel_ab_semigroup_add pordered_cancel_comm_semiring ~> ordered_cancel_comm_semiring pordered_cancel_semiring ~> ordered_cancel_semiring pordered_comm_monoid_add ~> ordered_comm_monoid_add pordered_comm_ring ~> ordered_comm_ring pordered_comm_semiring ~> ordered_comm_semiring pordered_ring ~> ordered_ring pordered_ring_abs ~> ordered_ring_abs pordered_semiring ~> ordered_semiring ordered_ab_group_add ~> linordered_ab_group_add ordered_ab_semigroup_add ~> linordered_ab_semigroup_add ordered_cancel_ab_semigroup_add ~> linordered_cancel_ab_semigroup_add ordered_comm_semiring_strict ~> linordered_comm_semiring_strict ordered_field ~> linordered_field ordered_field_no_lb ~> linordered_field_no_lb ordered_field_no_ub ~> linordered_field_no_ub ordered_field_dense_linear_order ~> dense_linordered_field ordered_idom ~> linordered_idom ordered_ring ~> linordered_ring ordered_ring_le_cancel_factor ~> linordered_ring_le_cancel_factor ordered_ring_less_cancel_factor ~> linordered_ring_less_cancel_factor ordered_ring_strict ~> linordered_ring_strict ordered_semidom ~> linordered_semidom ordered_semiring ~> linordered_semiring ordered_semiring_1 ~> linordered_semiring_1 ordered_semiring_1_strict ~> linordered_semiring_1_strict ordered_semiring_strict ~> linordered_semiring_strict The following slightly odd type classes have been moved to a separate theory Library/Lattice_Algebras: lordered_ab_group_add ~> lattice_ab_group_add lordered_ab_group_add_abs ~> lattice_ab_group_add_abs lordered_ab_group_add_meet ~> semilattice_inf_ab_group_add lordered_ab_group_add_join ~> semilattice_sup_ab_group_add lordered_ring ~> lattice_ring INCOMPATIBILITY. * Refined field classes: - classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero include rule inverse 0 = 0 -- subsumes former division_by_zero class; - numerous lemmas have been ported from field to division_ring. INCOMPATIBILITY. * Refined algebra theorem collections: - dropped theorem group group_simps, use algebra_simps instead; - dropped theorem group ring_simps, use field_simps instead; - proper theorem collection field_simps subsumes former theorem groups field_eq_simps and field_simps; - dropped lemma eq_minus_self_iff which is a duplicate for equal_neg_zero. INCOMPATIBILITY. * Theory Finite_Set and List: some lemmas have been generalized from sets to lattices: fun_left_comm_idem_inter ~> fun_left_comm_idem_inf fun_left_comm_idem_union ~> fun_left_comm_idem_sup inter_Inter_fold_inter ~> inf_Inf_fold_inf union_Union_fold_union ~> sup_Sup_fold_sup Inter_fold_inter ~> Inf_fold_inf Union_fold_union ~> Sup_fold_sup inter_INTER_fold_inter ~> inf_INFI_fold_inf union_UNION_fold_union ~> sup_SUPR_fold_sup INTER_fold_inter ~> INFI_fold_inf UNION_fold_union ~> SUPR_fold_sup * Theory "Complete_Lattice": lemmas top_def and bot_def have been replaced by the more convenient lemmas Inf_empty and Sup_empty. Dropped lemmas Inf_insert_simp and Sup_insert_simp, which are subsumed by Inf_insert and Sup_insert. Lemmas Inf_UNIV and Sup_UNIV replace former Inf_Univ and Sup_Univ. Lemmas inf_top_right and sup_bot_right subsume inf_top and sup_bot respectively. INCOMPATIBILITY. * Reorganized theory Multiset: swapped notation of pointwise and multiset order: - pointwise ordering is instance of class order with standard syntax <= and <; - multiset ordering has syntax <=# and <#; partial order properties are provided by means of interpretation with prefix multiset_order; - less duplication, less historical organization of sections, conversion from associations lists to multisets, rudimentary code generation; - use insert_DiffM2 [symmetric] instead of elem_imp_eq_diff_union, if needed. Renamed: multiset_eq_conv_count_eq ~> multiset_ext_iff multi_count_ext ~> multiset_ext diff_union_inverse2 ~> diff_union_cancelR INCOMPATIBILITY. * Theory Permutation: replaced local "remove" by List.remove1. * Code generation: ML and OCaml code is decorated with signatures. * Theory List: added transpose. * Library/Nat_Bijection.thy is a collection of bijective functions between nat and other types, which supersedes the older libraries Library/Nat_Int_Bij.thy and HOLCF/NatIso.thy. INCOMPATIBILITY. Constants: Nat_Int_Bij.nat2_to_nat ~> prod_encode Nat_Int_Bij.nat_to_nat2 ~> prod_decode Nat_Int_Bij.int_to_nat_bij ~> int_encode Nat_Int_Bij.nat_to_int_bij ~> int_decode Countable.pair_encode ~> prod_encode NatIso.prod2nat ~> prod_encode NatIso.nat2prod ~> prod_decode NatIso.sum2nat ~> sum_encode NatIso.nat2sum ~> sum_decode NatIso.list2nat ~> list_encode NatIso.nat2list ~> list_decode NatIso.set2nat ~> set_encode NatIso.nat2set ~> set_decode Lemmas: Nat_Int_Bij.bij_nat_to_int_bij ~> bij_int_decode Nat_Int_Bij.nat2_to_nat_inj ~> inj_prod_encode Nat_Int_Bij.nat2_to_nat_surj ~> surj_prod_encode Nat_Int_Bij.nat_to_nat2_inj ~> inj_prod_decode Nat_Int_Bij.nat_to_nat2_surj ~> surj_prod_decode Nat_Int_Bij.i2n_n2i_id ~> int_encode_inverse Nat_Int_Bij.n2i_i2n_id ~> int_decode_inverse Nat_Int_Bij.surj_nat_to_int_bij ~> surj_int_encode Nat_Int_Bij.surj_int_to_nat_bij ~> surj_int_decode Nat_Int_Bij.inj_nat_to_int_bij ~> inj_int_encode Nat_Int_Bij.inj_int_to_nat_bij ~> inj_int_decode Nat_Int_Bij.bij_nat_to_int_bij ~> bij_int_encode Nat_Int_Bij.bij_int_to_nat_bij ~> bij_int_decode * Sledgehammer: - Renamed ATP commands: atp_info ~> sledgehammer running_atps atp_kill ~> sledgehammer kill_atps atp_messages ~> sledgehammer messages atp_minimize ~> sledgehammer minimize print_atps ~> sledgehammer available_atps INCOMPATIBILITY. - Added user's manual ("isabelle doc sledgehammer"). - Added option syntax and "sledgehammer_params" to customize Sledgehammer's behavior. See the manual for details. - Modified the Isar proof reconstruction code so that it produces direct proofs rather than proofs by contradiction. (This feature is still experimental.) - Made Isar proof reconstruction work for SPASS, remote ATPs, and in full-typed mode. - Added support for TPTP syntax for SPASS via the "spass_tptp" ATP. * Nitpick: - Added and implemented "binary_ints" and "bits" options. - Added "std" option and implemented support for nonstandard models. - Added and implemented "finitize" option to improve the precision of infinite datatypes based on a monotonicity analysis. - Added support for quotient types. - Added support for "specification" and "ax_specification" constructs. - Added support for local definitions (for "function" and "termination" proofs). - Added support for term postprocessors. - Optimized "Multiset.multiset" and "FinFun.finfun". - Improved efficiency of "destroy_constrs" optimization. - Fixed soundness bugs related to "destroy_constrs" optimization and record getters. - Fixed soundness bug related to higher-order constructors. - Fixed soundness bug when "full_descrs" is enabled. - Improved precision of set constructs. - Added "atoms" option. - Added cache to speed up repeated Kodkod invocations on the same problems. - Renamed "MiniSatJNI", "zChaffJNI", "BerkMinAlloy", and "SAT4JLight" to "MiniSat_JNI", "zChaff_JNI", "BerkMin_Alloy", and "SAT4J_Light". INCOMPATIBILITY. - Removed "skolemize", "uncurry", "sym_break", "flatten_prop", "sharing_depth", and "show_skolems" options. INCOMPATIBILITY. - Removed "nitpick_intro" attribute. INCOMPATIBILITY. * Method "induct" now takes instantiations of the form t, where t is not a variable, as a shorthand for "x == t", where x is a fresh variable. If this is not intended, t has to be enclosed in parentheses. By default, the equalities generated by definitional instantiations are pre-simplified, which may cause parameters of inductive cases to disappear, or may even delete some of the inductive cases. Use "induct (no_simp)" instead of "induct" to restore the old behaviour. The (no_simp) option is also understood by the "cases" and "nominal_induct" methods, which now perform pre-simplification, too. INCOMPATIBILITY. *** HOLCF *** * Variable names in lemmas generated by the domain package have changed; the naming scheme is now consistent with the HOL datatype package. Some proof scripts may be affected, INCOMPATIBILITY. * The domain package no longer defines the function "foo_copy" for recursive domain "foo". The reach lemma is now stated directly in terms of "foo_take". Lemmas and proofs that mention "foo_copy" must be reformulated in terms of "foo_take", INCOMPATIBILITY. * Most definedness lemmas generated by the domain package (previously of the form "x ~= UU ==> foo$x ~= UU") now have an if-and-only-if form like "foo$x = UU <-> x = UU", which works better as a simp rule. Proofs that used definedness lemmas as intro rules may break, potential INCOMPATIBILITY. * Induction and casedist rules generated by the domain package now declare proper case_names (one called "bottom", and one named for each constructor). INCOMPATIBILITY. * For mutually-recursive domains, separate "reach" and "take_lemma" rules are generated for each domain, INCOMPATIBILITY. foo_bar.reach ~> foo.reach bar.reach foo_bar.take_lemmas ~> foo.take_lemma bar.take_lemma * Some lemmas generated by the domain package have been renamed for consistency with the datatype package, INCOMPATIBILITY. foo.ind ~> foo.induct foo.finite_ind ~> foo.finite_induct foo.coind ~> foo.coinduct foo.casedist ~> foo.exhaust foo.exhaust ~> foo.nchotomy * For consistency with other definition packages, the fixrec package now generates qualified theorem names, INCOMPATIBILITY. foo_simps ~> foo.simps foo_unfold ~> foo.unfold foo_induct ~> foo.induct * The "fixrec_simp" attribute has been removed. The "fixrec_simp" method and internal fixrec proofs now use the default simpset instead. INCOMPATIBILITY. * The "contlub" predicate has been removed. Proof scripts should use lemma contI2 in place of monocontlub2cont, INCOMPATIBILITY. * The "admw" predicate has been removed, INCOMPATIBILITY. * The constants cpair, cfst, and csnd have been removed in favor of Pair, fst, and snd from Isabelle/HOL, INCOMPATIBILITY. *** ML *** * Antiquotations for basic formal entities: @{class NAME} -- type class @{class_syntax NAME} -- syntax representation of the above @{type_name NAME} -- logical type @{type_abbrev NAME} -- type abbreviation @{nonterminal NAME} -- type of concrete syntactic category @{type_syntax NAME} -- syntax representation of any of the above @{const_name NAME} -- logical constant (INCOMPATIBILITY) @{const_abbrev NAME} -- abbreviated constant @{const_syntax NAME} -- syntax representation of any of the above * Antiquotation @{syntax_const NAME} ensures that NAME refers to a raw syntax constant (cf. 'syntax' command). * Antiquotation @{make_string} inlines a function to print arbitrary values similar to the ML toplevel. The result is compiler dependent and may fall back on "?" in certain situations. * Diagnostic commands 'ML_val' and 'ML_command' may refer to antiquotations @{Isar.state} and @{Isar.goal}. This replaces impure Isar.state() and Isar.goal(), which belong to the old TTY loop and do not work with the asynchronous Isar document model. * Configuration options now admit dynamic default values, depending on the context or even global references. * SHA1.digest digests strings according to SHA-1 (see RFC 3174). It uses an efficient external library if available (for Poly/ML). * Renamed some important ML structures, while keeping the old names for some time as aliases within the structure Legacy: OuterKeyword ~> Keyword OuterLex ~> Token OuterParse ~> Parse OuterSyntax ~> Outer_Syntax PrintMode ~> Print_Mode SpecParse ~> Parse_Spec ThyInfo ~> Thy_Info ThyLoad ~> Thy_Load ThyOutput ~> Thy_Output TypeInfer ~> Type_Infer Note that "open Legacy" simplifies porting of sources, but forgetting to remove it again will complicate porting again in the future. * Most operations that refer to a global context are named accordingly, e.g. Simplifier.global_context or ProofContext.init_global. There are some situations where a global context actually works, but under normal circumstances one needs to pass the proper local context through the code! * Discontinued old TheoryDataFun with its copy/init operation -- data needs to be pure. Functor Theory_Data_PP retains the traditional Pretty.pp argument to merge, which is absent in the standard Theory_Data version. * Sorts.certify_sort and derived "cert" operations for types and terms no longer minimize sorts. Thus certification at the boundary of the inference kernel becomes invariant under addition of class relations, which is an important monotonicity principle. Sorts are now minimized in the syntax layer only, at the boundary between the end-user and the system. Subtle INCOMPATIBILITY, may have to use Sign.minimize_sort explicitly in rare situations. * Renamed old-style Drule.standard to Drule.export_without_context, to emphasize that this is in no way a standard operation. INCOMPATIBILITY. * Subgoal.FOCUS (and variants): resulting goal state is normalized as usual for resolution. Rare INCOMPATIBILITY. * Renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation (which is quite rare). * Curried take and drop in library.ML; negative length is interpreted as infinity (as in chop). Subtle INCOMPATIBILITY. * Proof terms: type substitutions on proof constants now use canonical order of type variables. INCOMPATIBILITY for tools working with proof terms. * Raw axioms/defs may no longer carry sort constraints, and raw defs may no longer carry premises. User-level specifications are transformed accordingly by Thm.add_axiom/add_def. *** System *** * Discontinued special HOL_USEDIR_OPTIONS for the main HOL image; ISABELLE_USEDIR_OPTIONS applies uniformly to all sessions. Note that proof terms are enabled unconditionally in the new HOL-Proofs image. * Discontinued old ISABELLE and ISATOOL environment settings (legacy feature since Isabelle2009). Use ISABELLE_PROCESS and ISABELLE_TOOL, respectively. * Old lib/scripts/polyml-platform is superseded by the ISABELLE_PLATFORM setting variable, which defaults to the 32 bit variant, even on a 64 bit machine. The following example setting prefers 64 bit if available: ML_PLATFORM="${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM}" * The preliminary Isabelle/jEdit application demonstrates the emerging Isabelle/Scala layer for advanced prover interaction and integration. See src/Tools/jEdit or "isabelle jedit" provided by the properly built component. * "IsabelleText" is a Unicode font derived from Bitstream Vera Mono and Bluesky TeX fonts. It provides the usual Isabelle symbols, similar to the default assignment of the document preparation system (cf. isabellesym.sty). The Isabelle/Scala class Isabelle_System provides some operations for direct access to the font without asking the user for manual installation. New in Isabelle2009-1 (December 2009) ------------------------------------- *** General *** * Discontinued old form of "escaped symbols" such as \\. Only one backslash should be used, even in ML sources. *** Pure *** * Locale interpretation propagates mixins along the locale hierarchy. The currently only available mixins are the equations used to map local definitions to terms of the target domain of an interpretation. * Reactivated diagnostic command 'print_interps'. Use "print_interps loc" to print all interpretations of locale "loc" in the theory. Interpretations in proofs are not shown. * Thoroughly revised locales tutorial. New section on conditional interpretation. * On instantiation of classes, remaining undefined class parameters are formally declared. INCOMPATIBILITY. *** Document preparation *** * New generalized style concept for printing terms: @{foo (style) ...} instead of @{foo_style style ...} (old form is still retained for backward compatibility). Styles can be also applied for antiquotations prop, term_type and typeof. *** HOL *** * New proof method "smt" for a combination of first-order logic with equality, linear and nonlinear (natural/integer/real) arithmetic, and fixed-size bitvectors; there is also basic support for higher-order features (esp. lambda abstractions). It is an incomplete decision procedure based on external SMT solvers using the oracle mechanism; for the SMT solver Z3, this method is proof-producing. Certificates are provided to avoid calling the external solvers solely for re-checking proofs. Due to a remote SMT service there is no need for installing SMT solvers locally. See src/HOL/SMT. * New commands to load and prove verification conditions generated by the Boogie program verifier or derived systems (e.g. the Verifying C Compiler (VCC) or Spec#). See src/HOL/Boogie. * New counterexample generator tool 'nitpick' based on the Kodkod relational model finder. See src/HOL/Tools/Nitpick and src/HOL/Nitpick_Examples. * New commands 'code_pred' and 'values' to invoke the predicate compiler and to enumerate values of inductive predicates. * A tabled implementation of the reflexive transitive closure. * New implementation of quickcheck uses generic code generator; default generators are provided for all suitable HOL types, records and datatypes. Old quickcheck can be re-activated importing theory Library/SML_Quickcheck. * New testing tool Mirabelle for automated proof tools. Applies several tools and tactics like sledgehammer, metis, or quickcheck, to every proof step in a theory. To be used in batch mode via the "mirabelle" utility. * New proof method "sos" (sum of squares) for nonlinear real arithmetic (originally due to John Harison). It requires theory Library/Sum_Of_Squares. It is not a complete decision procedure but works well in practice on quantifier-free real arithmetic with +, -, *, ^, =, <= and <, i.e. boolean combinations of equalities and inequalities between polynomials. It makes use of external semidefinite programming solvers. Method "sos" generates a certificate that can be pasted into the proof thus avoiding the need to call an external tool every time the proof is checked. See src/HOL/Library/Sum_Of_Squares. * New method "linarith" invokes existing linear arithmetic decision procedure only. * New command 'atp_minimal' reduces result produced by Sledgehammer. * New Sledgehammer option "Full Types" in Proof General settings menu. Causes full type information to be output to the ATPs. This slows ATPs down considerably but eliminates a source of unsound "proofs" that fail later. * New method "metisFT": A version of metis that uses full type information in order to avoid failures of proof reconstruction. * New evaluator "approximate" approximates an real valued term using the same method as the approximation method. * Method "approximate" now supports arithmetic expressions as boundaries of intervals and implements interval splitting and Taylor series expansion. * ML antiquotation @{code_datatype} inserts definition of a datatype generated by the code generator; e.g. see src/HOL/Predicate.thy. * New theory SupInf of the supremum and infimum operators for sets of reals. * New theory Probability, which contains a development of measure theory, eventually leading to Lebesgue integration and probability. * Extended Multivariate Analysis to include derivation and Brouwer's fixpoint theorem. * Reorganization of number theory, INCOMPATIBILITY: - new number theory development for nat and int, in theories Divides and GCD as well as in new session Number_Theory - some constants and facts now suffixed with _nat and _int accordingly - former session NumberTheory now named Old_Number_Theory, including theories Legacy_GCD and Primes (prefer Number_Theory if possible) - moved theory Pocklington from src/HOL/Library to src/HOL/Old_Number_Theory * Theory GCD includes functions Gcd/GCD and Lcm/LCM for the gcd and lcm of finite and infinite sets. It is shown that they form a complete lattice. * Class semiring_div requires superclass no_zero_divisors and proof of div_mult_mult1; theorems div_mult_mult1, div_mult_mult2, div_mult_mult1_if, div_mult_mult1 and div_mult_mult2 have been generalized to class semiring_div, subsuming former theorems zdiv_zmult_zmult1, zdiv_zmult_zmult1_if, zdiv_zmult_zmult1 and zdiv_zmult_zmult2. div_mult_mult1 is now [simp] by default. INCOMPATIBILITY. * Refinements to lattice classes and sets: - less default intro/elim rules in locale variant, more default intro/elim rules in class variant: more uniformity - lemma ge_sup_conv renamed to le_sup_iff, in accordance with le_inf_iff - dropped lemma alias inf_ACI for inf_aci (same for sup_ACI and sup_aci) - renamed ACI to inf_sup_aci - new class "boolean_algebra" - class "complete_lattice" moved to separate theory "Complete_Lattice"; corresponding constants (and abbreviations) renamed and with authentic syntax: Set.Inf ~> Complete_Lattice.Inf Set.Sup ~> Complete_Lattice.Sup Set.INFI ~> Complete_Lattice.INFI Set.SUPR ~> Complete_Lattice.SUPR Set.Inter ~> Complete_Lattice.Inter Set.Union ~> Complete_Lattice.Union Set.INTER ~> Complete_Lattice.INTER Set.UNION ~> Complete_Lattice.UNION - authentic syntax for Set.Pow Set.image - mere abbreviations: Set.empty (for bot) Set.UNIV (for top) Set.inter (for inf, formerly Set.Int) Set.union (for sup, formerly Set.Un) Complete_Lattice.Inter (for Inf) Complete_Lattice.Union (for Sup) Complete_Lattice.INTER (for INFI) Complete_Lattice.UNION (for SUPR) - object-logic definitions as far as appropriate INCOMPATIBILITY. Care is required when theorems Int_subset_iff or Un_subset_iff are explicitly deleted as default simp rules; then also their lattice counterparts le_inf_iff and le_sup_iff have to be deleted to achieve the desired effect. * Rules inf_absorb1, inf_absorb2, sup_absorb1, sup_absorb2 are no simp rules by default any longer; the same applies to min_max.inf_absorb1 etc. INCOMPATIBILITY. * Rules sup_Int_eq and sup_Un_eq are no longer declared as pred_set_conv by default. INCOMPATIBILITY. * Power operations on relations and functions are now one dedicated constant "compow" with infix syntax "^^". Power operation on multiplicative monoids retains syntax "^" and is now defined generic in class power. INCOMPATIBILITY. * Relation composition "R O S" now has a more standard argument order: "R O S = {(x, z). EX y. (x, y) : R & (y, z) : S}". INCOMPATIBILITY, rewrite propositions with "S O R" --> "R O S". Proofs may occasionally break, since the O_assoc rule was not rewritten like this. Fix using O_assoc[symmetric]. The same applies to the curried version "R OO S". * Function "Inv" is renamed to "inv_into" and function "inv" is now an abbreviation for "inv_into UNIV". Lemmas are renamed accordingly. INCOMPATIBILITY. * Most rules produced by inductive and datatype package have mandatory prefixes. INCOMPATIBILITY. * Changed "DERIV_intros" to a dynamic fact, which can be augmented by the attribute of the same name. Each of the theorems in the list DERIV_intros assumes composition with an additional function and matches a variable to the derivative, which has to be solved by the Simplifier. Hence (auto intro!: DERIV_intros) computes the derivative of most elementary terms. Former Maclauren.DERIV_tac and Maclauren.deriv_tac should be replaced by (auto intro!: DERIV_intros). INCOMPATIBILITY. * Code generator attributes follow the usual underscore convention: code_unfold replaces code unfold code_post replaces code post etc. INCOMPATIBILITY. * Renamed methods: sizechange -> size_change induct_scheme -> induction_schema INCOMPATIBILITY. * Discontinued abbreviation "arbitrary" of constant "undefined". INCOMPATIBILITY, use "undefined" directly. * Renamed theorems: Suc_eq_add_numeral_1 -> Suc_eq_plus1 Suc_eq_add_numeral_1_left -> Suc_eq_plus1_left Suc_plus1 -> Suc_eq_plus1 *anti_sym -> *antisym* vector_less_eq_def -> vector_le_def INCOMPATIBILITY. * Added theorem List.map_map as [simp]. Removed List.map_compose. INCOMPATIBILITY. * Removed predicate "M hassize n" (<--> card M = n & finite M). INCOMPATIBILITY. *** HOLCF *** * Theory Representable defines a class "rep" of domains that are representable (via an ep-pair) in the universal domain type "udom". Instances are provided for all type constructors defined in HOLCF. * The 'new_domain' command is a purely definitional version of the domain package, for representable domains. Syntax is identical to the old domain package. The 'new_domain' package also supports indirect recursion using previously-defined type constructors. See src/HOLCF/ex/New_Domain.thy for examples. * Method "fixrec_simp" unfolds one step of a fixrec-defined constant on the left-hand side of an equation, and then performs simplification. Rewriting is done using rules declared with the "fixrec_simp" attribute. The "fixrec_simp" method is intended as a replacement for "fixpat"; see src/HOLCF/ex/Fixrec_ex.thy for examples. * The pattern-match compiler in 'fixrec' can now handle constructors with HOL function types. Pattern-match combinators for the Pair constructor are pre-configured. * The 'fixrec' package now produces better fixed-point induction rules for mutually-recursive definitions: Induction rules have conclusions of the form "P foo bar" instead of "P ". * The constant "sq_le" (with infix syntax "<<" or "\") has been renamed to "below". The name "below" now replaces "less" in many theorem names. (Legacy theorem names using "less" are still supported as well.) * The 'fixrec' package now supports "bottom patterns". Bottom patterns can be used to generate strictness rules, or to make functions more strict (much like the bang-patterns supported by the Glasgow Haskell Compiler). See src/HOLCF/ex/Fixrec_ex.thy for examples. *** ML *** * Support for Poly/ML 5.3.0, with improved reporting of compiler errors and run-time exceptions, including detailed source positions. * Structure Name_Space (formerly NameSpace) now manages uniquely identified entries, with some additional information such as source position, logical grouping etc. * Theory and context data is now introduced by the simplified and modernized functors Theory_Data, Proof_Data, Generic_Data. Data needs to be pure, but the old TheoryDataFun for mutable data (with explicit copy operation) is still available for some time. * Structure Synchronized (cf. src/Pure/Concurrent/synchronized.ML) provides a high-level programming interface to synchronized state variables with atomic update. This works via pure function application within a critical section -- its runtime should be as short as possible; beware of deadlocks if critical code is nested, either directly or indirectly via other synchronized variables! * Structure Unsynchronized (cf. src/Pure/ML-Systems/unsynchronized.ML) wraps raw ML references, explicitly indicating their non-thread-safe behaviour. The Isar toplevel keeps this structure open, to accommodate Proof General as well as quick and dirty interactive experiments with references. * PARALLEL_CHOICE and PARALLEL_GOALS provide basic support for parallel tactical reasoning. * Tacticals Subgoal.FOCUS, Subgoal.FOCUS_PREMS, Subgoal.FOCUS_PARAMS are similar to SUBPROOF, but are slightly more flexible: only the specified parts of the subgoal are imported into the context, and the body tactic may introduce new subgoals and schematic variables. * Old tactical METAHYPS, which does not observe the proof context, has been renamed to Old_Goals.METAHYPS and awaits deletion. Use SUBPROOF or Subgoal.FOCUS etc. * Renamed functor TableFun to Table, and GraphFun to Graph. (Since functors have their own ML name space there is no point to mark them separately.) Minor INCOMPATIBILITY. * Renamed NamedThmsFun to Named_Thms. INCOMPATIBILITY. * Renamed several structures FooBar to Foo_Bar. Occasional, INCOMPATIBILITY. * Operations of structure Skip_Proof no longer require quick_and_dirty mode, which avoids critical setmp. * Eliminated old Attrib.add_attributes, Method.add_methods and related combinators for "args". INCOMPATIBILITY, need to use simplified Attrib/Method.setup introduced in Isabelle2009. * Proper context for simpset_of, claset_of, clasimpset_of. May fall back on global_simpset_of, global_claset_of, global_clasimpset_of as last resort. INCOMPATIBILITY. * Display.pretty_thm now requires a proper context (cf. former ProofContext.pretty_thm). May fall back on Display.pretty_thm_global or even Display.pretty_thm_without_context as last resort. INCOMPATIBILITY. * Discontinued Display.pretty_ctyp/cterm etc. INCOMPATIBILITY, use Syntax.pretty_typ/term directly, preferably with proper context instead of global theory. *** System *** * Further fine tuning of parallel proof checking, scales up to 8 cores (max. speedup factor 5.0). See also Goal.parallel_proofs in ML and usedir option -q. * Support for additional "Isabelle components" via etc/components, see also the system manual. * The isabelle makeall tool now operates on all components with IsaMakefile, not just hardwired "logics". * Removed "compress" option from isabelle-process and isabelle usedir; this is always enabled. * Discontinued support for Poly/ML 4.x versions. * Isabelle tool "wwwfind" provides web interface for 'find_theorems' on a given logic image. This requires the lighttpd webserver and is currently supported on Linux only. New in Isabelle2009 (April 2009) -------------------------------- *** General *** * Simplified main Isabelle executables, with less surprises on case-insensitive file-systems (such as Mac OS). - The main Isabelle tool wrapper is now called "isabelle" instead of "isatool." - The former "isabelle" alias for "isabelle-process" has been removed (should rarely occur to regular users). - The former "isabelle-interface" and its alias "Isabelle" have been removed (interfaces are now regular Isabelle tools). Within scripts and make files, the Isabelle environment variables ISABELLE_TOOL and ISABELLE_PROCESS replace old ISATOOL and ISABELLE, respectively. (The latter are still available as legacy feature.) The old isabelle-interface wrapper could react in confusing ways if the interface was uninstalled or changed otherwise. Individual interface tool configuration is now more explicit, see also the Isabelle system manual. In particular, Proof General is now available via "isabelle emacs". INCOMPATIBILITY, need to adapt derivative scripts. Users may need to purge installed copies of Isabelle executables and re-run "isabelle install -p ...", or use symlinks. * The default for ISABELLE_HOME_USER is now ~/.isabelle instead of the old ~/isabelle, which was slightly non-standard and apt to cause surprises on case-insensitive file-systems (such as Mac OS). INCOMPATIBILITY, need to move existing ~/isabelle/etc, ~/isabelle/heaps, ~/isabelle/browser_info to the new place. Special care is required when using older releases of Isabelle. Note that ISABELLE_HOME_USER can be changed in Isabelle/etc/settings of any Isabelle distribution, in order to use the new ~/.isabelle uniformly. * Proofs of fully specified statements are run in parallel on multi-core systems. A speedup factor of 2.5 to 3.2 can be expected on a regular 4-core machine, if the initial heap space is made reasonably large (cf. Poly/ML option -H). (Requires Poly/ML 5.2.1 or later.) * The main reference manuals ("isar-ref", "implementation", and "system") have been updated and extended. Formally checked references as hyperlinks are now available uniformly. *** Pure *** * Complete re-implementation of locales. INCOMPATIBILITY in several respects. The most important changes are listed below. See the Tutorial on Locales ("locales" manual) for details. - In locale expressions, instantiation replaces renaming. Parameters must be declared in a for clause. To aid compatibility with previous parameter inheritance, in locale declarations, parameters that are not 'touched' (instantiation position "_" or omitted) are implicitly added with their syntax at the beginning of the for clause. - Syntax from abbreviations and definitions in locales is available in locale expressions and context elements. The latter is particularly useful in locale declarations. - More flexible mechanisms to qualify names generated by locale expressions. Qualifiers (prefixes) may be specified in locale expressions, and can be marked as mandatory (syntax: "name!:") or optional (syntax "name?:"). The default depends for plain "name:" depends on the situation where a locale expression is used: in commands 'locale' and 'sublocale' prefixes are optional, in 'interpretation' and 'interpret' prefixes are mandatory. The old implicit qualifiers derived from the parameter names of a locale are no longer generated. - Command "sublocale l < e" replaces "interpretation l < e". The instantiation clause in "interpretation" and "interpret" (square brackets) is no longer available. Use locale expressions. - When converting proof scripts, mandatory qualifiers in 'interpretation' and 'interpret' should be retained by default, even if this is an INCOMPATIBILITY compared to former behavior. In the worst case, use the "name?:" form for non-mandatory ones. Qualifiers in locale expressions range over a single locale instance only. - Dropped locale element "includes". This is a major INCOMPATIBILITY. In existing theorem specifications replace the includes element by the respective context elements of the included locale, omitting those that are already present in the theorem specification. Multiple assume elements of a locale should be replaced by a single one involving the locale predicate. In the proof body, declarations (most notably theorems) may be regained by interpreting the respective locales in the proof context as required (command "interpret"). If using "includes" in replacement of a target solely because the parameter types in the theorem are not as general as in the target, consider declaring a new locale with additional type constraints on the parameters (context element "constrains"). - Discontinued "locale (open)". INCOMPATIBILITY. - Locale interpretation commands no longer attempt to simplify goal. INCOMPATIBILITY: in rare situations the generated goal differs. Use methods intro_locales and unfold_locales to clarify. - Locale interpretation commands no longer accept interpretation attributes. INCOMPATIBILITY. * Class declaration: so-called "base sort" must not be given in import list any longer, but is inferred from the specification. Particularly in HOL, write class foo = ... instead of class foo = type + ... * Class target: global versions of theorems stemming do not carry a parameter prefix any longer. INCOMPATIBILITY. * Class 'instance' command no longer accepts attached definitions. INCOMPATIBILITY, use proper 'instantiation' target instead. * Recovered hiding of consts, which was accidentally broken in Isabelle2007. Potential INCOMPATIBILITY, ``hide const c'' really makes c inaccessible; consider using ``hide (open) const c'' instead. * Slightly more coherent Pure syntax, with updated documentation in isar-ref manual. Removed locales meta_term_syntax and meta_conjunction_syntax: TERM and &&& (formerly &&) are now permanent, INCOMPATIBILITY in rare situations. Note that &&& should not be used directly in regular applications. * There is a new syntactic category "float_const" for signed decimal fractions (e.g. 123.45 or -123.45). * Removed exotic 'token_translation' command. INCOMPATIBILITY, use ML interface with 'setup' command instead. * Command 'local_setup' is similar to 'setup', but operates on a local theory context. * The 'axiomatization' command now only works within a global theory context. INCOMPATIBILITY. * Goal-directed proof now enforces strict proof irrelevance wrt. sort hypotheses. Sorts required in the course of reasoning need to be covered by the constraints in the initial statement, completed by the type instance information of the background theory. Non-trivial sort hypotheses, which rarely occur in practice, may be specified via vacuous propositions of the form SORT_CONSTRAINT('a::c). For example: lemma assumes "SORT_CONSTRAINT('a::empty)" shows False ... The result contains an implicit sort hypotheses as before -- SORT_CONSTRAINT premises are eliminated as part of the canonical rule normalization. * Generalized Isar history, with support for linear undo, direct state addressing etc. * Changed defaults for unify configuration options: unify_trace_bound = 50 (formerly 25) unify_search_bound = 60 (formerly 30) * Different bookkeeping for code equations (INCOMPATIBILITY): a) On theory merge, the last set of code equations for a particular constant is taken (in accordance with the policy applied by other parts of the code generator framework). b) Code equations stemming from explicit declarations (e.g. code attribute) gain priority over default code equations stemming from definition, primrec, fun etc. * Keyword 'code_exception' now named 'code_abort'. INCOMPATIBILITY. * Unified theorem tables for both code generators. Thus [code func] has disappeared and only [code] remains. INCOMPATIBILITY. * Command 'find_consts' searches for constants based on type and name patterns, e.g. find_consts "_ => bool" By default, matching is against subtypes, but it may be restricted to the whole type. Searching by name is possible. Multiple queries are conjunctive and queries may be negated by prefixing them with a hyphen: find_consts strict: "_ => bool" name: "Int" -"int => int" * New 'find_theorems' criterion "solves" matches theorems that directly solve the current goal (modulo higher-order unification). * Auto solve feature for main theorem statements: whenever a new goal is stated, "find_theorems solves" is called; any theorems that could solve the lemma directly are listed as part of the goal state. Cf. associated options in Proof General Isabelle settings menu, enabled by default, with reasonable timeout for pathological cases of higher-order unification. *** Document preparation *** * Antiquotation @{lemma} now imitates a regular terminal proof, demanding keyword 'by' and supporting the full method expression syntax just like the Isar command 'by'. *** HOL *** * Integrated main parts of former image HOL-Complex with HOL. Entry points Main and Complex_Main remain as before. * Logic image HOL-Plain provides a minimal HOL with the most important tools available (inductive, datatype, primrec, ...). This facilitates experimentation and tool development. Note that user applications (and library theories) should never refer to anything below theory Main, as before. * Logic image HOL-Main stops at theory Main, and thus facilitates experimentation due to shorter build times. * Logic image HOL-NSA contains theories of nonstandard analysis which were previously part of former HOL-Complex. Entry point Hyperreal remains valid, but theories formerly using Complex_Main should now use new entry point Hypercomplex. * Generic ATP manager for Sledgehammer, based on ML threads instead of Posix processes. Avoids potentially expensive forking of the ML process. New thread-based implementation also works on non-Unix platforms (Cygwin). Provers are no longer hardwired, but defined within the theory via plain ML wrapper functions. Basic Sledgehammer commands are covered in the isar-ref manual. * Wrapper scripts for remote SystemOnTPTP service allows to use sledgehammer without local ATP installation (Vampire etc.). Other provers may be included via suitable ML wrappers, see also src/HOL/ATP_Linkup.thy. * ATP selection (E/Vampire/Spass) is now via Proof General's settings menu. * The metis method no longer fails because the theorem is too trivial (contains the empty clause). * The metis method now fails in the usual manner, rather than raising an exception, if it determines that it cannot prove the theorem. * Method "coherent" implements a prover for coherent logic (see also src/Tools/coherent.ML). * Constants "undefined" and "default" replace "arbitrary". Usually "undefined" is the right choice to replace "arbitrary", though logically there is no difference. INCOMPATIBILITY. * Command "value" now integrates different evaluation mechanisms. The result of the first successful evaluation mechanism is printed. In square brackets a particular named evaluation mechanisms may be specified (currently, [SML], [code] or [nbe]). See further src/HOL/ex/Eval_Examples.thy. * Normalization by evaluation now allows non-leftlinear equations. Declare with attribute [code nbe]. * Methods "case_tac" and "induct_tac" now refer to the very same rules as the structured Isar versions "cases" and "induct", cf. the corresponding "cases" and "induct" attributes. Mutual induction rules are now presented as a list of individual projections (e.g. foo_bar.inducts for types foo and bar); the old format with explicit HOL conjunction is no longer supported. INCOMPATIBILITY, in rare situations a different rule is selected --- notably nested tuple elimination instead of former prod.exhaust: use explicit (case_tac t rule: prod.exhaust) here. * Attributes "cases", "induct", "coinduct" support "del" option. * Removed fact "case_split_thm", which duplicates "case_split". * The option datatype has been moved to a new theory Option. Renamed option_map to Option.map, and o2s to Option.set, INCOMPATIBILITY. * New predicate "strict_mono" classifies strict functions on partial orders. With strict functions on linear orders, reasoning about (in)equalities is facilitated by theorems "strict_mono_eq", "strict_mono_less_eq" and "strict_mono_less". * Some set operations are now proper qualified constants with authentic syntax. INCOMPATIBILITY: op Int ~> Set.Int op Un ~> Set.Un INTER ~> Set.INTER UNION ~> Set.UNION Inter ~> Set.Inter Union ~> Set.Union {} ~> Set.empty UNIV ~> Set.UNIV * Class complete_lattice with operations Inf, Sup, INFI, SUPR now in theory Set. * Auxiliary class "itself" has disappeared -- classes without any parameter are treated as expected by the 'class' command. * Leibnitz's Series for Pi and the arcus tangens and logarithm series. * Common decision procedures (Cooper, MIR, Ferrack, Approximation, Dense_Linear_Order) are now in directory HOL/Decision_Procs. * Theory src/HOL/Decision_Procs/Approximation provides the new proof method "approximation". It proves formulas on real values by using interval arithmetic. In the formulas are also the transcendental functions sin, cos, tan, atan, ln, exp and the constant pi are allowed. For examples see src/HOL/Descision_Procs/ex/Approximation_Ex.thy. * Theory "Reflection" now resides in HOL/Library. * Entry point to Word library now simply named "Word". INCOMPATIBILITY. * Made source layout more coherent with logical distribution structure: src/HOL/Library/RType.thy ~> src/HOL/Typerep.thy src/HOL/Library/Code_Message.thy ~> src/HOL/ src/HOL/Library/GCD.thy ~> src/HOL/ src/HOL/Library/Order_Relation.thy ~> src/HOL/ src/HOL/Library/Parity.thy ~> src/HOL/ src/HOL/Library/Univ_Poly.thy ~> src/HOL/ src/HOL/Real/ContNotDenum.thy ~> src/HOL/Library/ src/HOL/Real/Lubs.thy ~> src/HOL/ src/HOL/Real/PReal.thy ~> src/HOL/ src/HOL/Real/Rational.thy ~> src/HOL/ src/HOL/Real/RComplete.thy ~> src/HOL/ src/HOL/Real/RealDef.thy ~> src/HOL/ src/HOL/Real/RealPow.thy ~> src/HOL/ src/HOL/Real/Real.thy ~> src/HOL/ src/HOL/Complex/Complex_Main.thy ~> src/HOL/ src/HOL/Complex/Complex.thy ~> src/HOL/ src/HOL/Complex/FrechetDeriv.thy ~> src/HOL/Library/ src/HOL/Complex/Fundamental_Theorem_Algebra.thy ~> src/HOL/Library/ src/HOL/Hyperreal/Deriv.thy ~> src/HOL/ src/HOL/Hyperreal/Fact.thy ~> src/HOL/ src/HOL/Hyperreal/Integration.thy ~> src/HOL/ src/HOL/Hyperreal/Lim.thy ~> src/HOL/ src/HOL/Hyperreal/Ln.thy ~> src/HOL/ src/HOL/Hyperreal/Log.thy ~> src/HOL/ src/HOL/Hyperreal/MacLaurin.thy ~> src/HOL/ src/HOL/Hyperreal/NthRoot.thy ~> src/HOL/ src/HOL/Hyperreal/Series.thy ~> src/HOL/ src/HOL/Hyperreal/SEQ.thy ~> src/HOL/ src/HOL/Hyperreal/Taylor.thy ~> src/HOL/ src/HOL/Hyperreal/Transcendental.thy ~> src/HOL/ src/HOL/Real/Float ~> src/HOL/Library/ src/HOL/Real/HahnBanach ~> src/HOL/HahnBanach src/HOL/Real/RealVector.thy ~> src/HOL/ src/HOL/arith_data.ML ~> src/HOL/Tools src/HOL/hologic.ML ~> src/HOL/Tools src/HOL/simpdata.ML ~> src/HOL/Tools src/HOL/int_arith1.ML ~> src/HOL/Tools/int_arith.ML src/HOL/int_factor_simprocs.ML ~> src/HOL/Tools src/HOL/nat_simprocs.ML ~> src/HOL/Tools src/HOL/Real/float_arith.ML ~> src/HOL/Tools src/HOL/Real/float_syntax.ML ~> src/HOL/Tools src/HOL/Real/rat_arith.ML ~> src/HOL/Tools src/HOL/Real/real_arith.ML ~> src/HOL/Tools src/HOL/Library/Array.thy ~> src/HOL/Imperative_HOL src/HOL/Library/Heap_Monad.thy ~> src/HOL/Imperative_HOL src/HOL/Library/Heap.thy ~> src/HOL/Imperative_HOL src/HOL/Library/Imperative_HOL.thy ~> src/HOL/Imperative_HOL src/HOL/Library/Ref.thy ~> src/HOL/Imperative_HOL src/HOL/Library/Relational.thy ~> src/HOL/Imperative_HOL * If methods "eval" and "evaluation" encounter a structured proof state with !!/==>, only the conclusion is evaluated to True (if possible), avoiding strange error messages. * Method "sizechange" automates termination proofs using (a modification of) the size-change principle. Requires SAT solver. See src/HOL/ex/Termination.thy for examples. * Simplifier: simproc for let expressions now unfolds if bound variable occurs at most once in let expression body. INCOMPATIBILITY. * Method "arith": Linear arithmetic now ignores all inequalities when fast_arith_neq_limit is exceeded, instead of giving up entirely. * New attribute "arith" for facts that should always be used automatically by arithmetic. It is intended to be used locally in proofs, e.g. assumes [arith]: "x > 0" Global usage is discouraged because of possible performance impact. * New classes "top" and "bot" with corresponding operations "top" and "bot" in theory Orderings; instantiation of class "complete_lattice" requires instantiation of classes "top" and "bot". INCOMPATIBILITY. * Changed definition lemma "less_fun_def" in order to provide an instance for preorders on functions; use lemma "less_le" instead. INCOMPATIBILITY. * Theory Orderings: class "wellorder" moved here, with explicit induction rule "less_induct" as assumption. For instantiation of "wellorder" by means of predicate "wf", use rule wf_wellorderI. INCOMPATIBILITY. * Theory Orderings: added class "preorder" as superclass of "order". INCOMPATIBILITY: Instantiation proofs for order, linorder etc. slightly changed. Some theorems named order_class.* now named preorder_class.*. * Theory Relation: renamed "refl" to "refl_on", "reflexive" to "refl, "diag" to "Id_on". * Theory Finite_Set: added a new fold combinator of type ('a => 'b => 'b) => 'b => 'a set => 'b Occasionally this is more convenient than the old fold combinator which is now defined in terms of the new one and renamed to fold_image. * Theories Ring_and_Field and OrderedGroup: The lemmas "group_simps" and "ring_simps" have been replaced by "algebra_simps" (which can be extended with further lemmas!). At the moment both still exist but the former will disappear at some point. * Theory Power: Lemma power_Suc is now declared as a simp rule in class recpower. Type-specific simp rules for various recpower types have been removed. INCOMPATIBILITY, rename old lemmas as follows: rat_power_0 -> power_0 rat_power_Suc -> power_Suc realpow_0 -> power_0 realpow_Suc -> power_Suc complexpow_0 -> power_0 complexpow_Suc -> power_Suc power_poly_0 -> power_0 power_poly_Suc -> power_Suc * Theories Ring_and_Field and Divides: Definition of "op dvd" has been moved to separate class dvd in Ring_and_Field; a couple of lemmas on dvd has been generalized to class comm_semiring_1. Likewise a bunch of lemmas from Divides has been generalized from nat to class semiring_div. INCOMPATIBILITY. This involves the following theorem renames resulting from duplicate elimination: dvd_def_mod ~> dvd_eq_mod_eq_0 zero_dvd_iff ~> dvd_0_left_iff dvd_0 ~> dvd_0_right DIVISION_BY_ZERO_DIV ~> div_by_0 DIVISION_BY_ZERO_MOD ~> mod_by_0 mult_div ~> div_mult_self2_is_id mult_mod ~> mod_mult_self2_is_0 * Theory IntDiv: removed many lemmas that are instances of class-based generalizations (from Divides and Ring_and_Field). INCOMPATIBILITY, rename old lemmas as follows: dvd_diff -> nat_dvd_diff dvd_zminus_iff -> dvd_minus_iff mod_add1_eq -> mod_add_eq mod_mult1_eq -> mod_mult_right_eq mod_mult1_eq' -> mod_mult_left_eq mod_mult_distrib_mod -> mod_mult_eq nat_mod_add_left_eq -> mod_add_left_eq nat_mod_add_right_eq -> mod_add_right_eq nat_mod_div_trivial -> mod_div_trivial nat_mod_mod_trivial -> mod_mod_trivial zdiv_zadd_self1 -> div_add_self1 zdiv_zadd_self2 -> div_add_self2 zdiv_zmult_self1 -> div_mult_self2_is_id zdiv_zmult_self2 -> div_mult_self1_is_id zdvd_triv_left -> dvd_triv_left zdvd_triv_right -> dvd_triv_right zdvd_zmult_cancel_disj -> dvd_mult_cancel_left zmod_eq0_zdvd_iff -> dvd_eq_mod_eq_0[symmetric] zmod_zadd_left_eq -> mod_add_left_eq zmod_zadd_right_eq -> mod_add_right_eq zmod_zadd_self1 -> mod_add_self1 zmod_zadd_self2 -> mod_add_self2 zmod_zadd1_eq -> mod_add_eq zmod_zdiff1_eq -> mod_diff_eq zmod_zdvd_zmod -> mod_mod_cancel zmod_zmod_cancel -> mod_mod_cancel zmod_zmult_self1 -> mod_mult_self2_is_0 zmod_zmult_self2 -> mod_mult_self1_is_0 zmod_1 -> mod_by_1 zdiv_1 -> div_by_1 zdvd_abs1 -> abs_dvd_iff zdvd_abs2 -> dvd_abs_iff zdvd_refl -> dvd_refl zdvd_trans -> dvd_trans zdvd_zadd -> dvd_add zdvd_zdiff -> dvd_diff zdvd_zminus_iff -> dvd_minus_iff zdvd_zminus2_iff -> minus_dvd_iff zdvd_zmultD -> dvd_mult_right zdvd_zmultD2 -> dvd_mult_left zdvd_zmult_mono -> mult_dvd_mono zdvd_0_right -> dvd_0_right zdvd_0_left -> dvd_0_left_iff zdvd_1_left -> one_dvd zminus_dvd_iff -> minus_dvd_iff * Theory Rational: 'Fract k 0' now equals '0'. INCOMPATIBILITY. * The real numbers offer decimal input syntax: 12.34 is translated into 1234/10^2. This translation is not reversed upon output. * Theory Library/Polynomial defines an abstract type 'a poly of univariate polynomials with coefficients of type 'a. In addition to the standard ring operations, it also supports div and mod. Code generation is also supported, using list-style constructors. * Theory Library/Inner_Product defines a class of real_inner for real inner product spaces, with an overloaded operation inner :: 'a => 'a => real. Class real_inner is a subclass of real_normed_vector from theory RealVector. * Theory Library/Product_Vector provides instances for the product type 'a * 'b of several classes from RealVector and Inner_Product. Definitions of addition, subtraction, scalar multiplication, norms, and inner products are included. * Theory Library/Bit defines the field "bit" of integers modulo 2. In addition to the field operations, numerals and case syntax are also supported. * Theory Library/Diagonalize provides constructive version of Cantor's first diagonalization argument. * Theory Library/GCD: Curried operations gcd, lcm (for nat) and zgcd, zlcm (for int); carried together from various gcd/lcm developements in the HOL Distribution. Constants zgcd and zlcm replace former igcd and ilcm; corresponding theorems renamed accordingly. INCOMPATIBILITY, may recover tupled syntax as follows: hide (open) const gcd abbreviation gcd where "gcd == (%(a, b). GCD.gcd a b)" notation (output) GCD.gcd ("gcd '(_, _')") The same works for lcm, zgcd, zlcm. * Theory Library/Nat_Infinity: added addition, numeral syntax and more instantiations for algebraic structures. Removed some duplicate theorems. Changes in simp rules. INCOMPATIBILITY. * ML antiquotation @{code} takes a constant as argument and generates corresponding code in background and inserts name of the corresponding resulting ML value/function/datatype constructor binding in place. All occurrences of @{code} with a single ML block are generated simultaneously. Provides a generic and safe interface for instrumentalizing code generation. See src/HOL/Decision_Procs/Ferrack.thy for a more ambitious application. In future you ought to refrain from ad-hoc compiling generated SML code on the ML toplevel. Note that (for technical reasons) @{code} cannot refer to constants for which user-defined serializations are set. Refer to the corresponding ML counterpart directly in that cases. * Command 'rep_datatype': instead of theorem names the command now takes a list of terms denoting the constructors of the type to be represented as datatype. The characteristic theorems have to be proven. INCOMPATIBILITY. Also observe that the following theorems have disappeared in favour of existing ones: unit_induct ~> unit.induct prod_induct ~> prod.induct sum_induct ~> sum.induct Suc_Suc_eq ~> nat.inject Suc_not_Zero Zero_not_Suc ~> nat.distinct *** HOL-Algebra *** * New locales for orders and lattices where the equivalence relation is not restricted to equality. INCOMPATIBILITY: all order and lattice locales use a record structure with field eq for the equivalence. * New theory of factorial domains. * Units_l_inv and Units_r_inv are now simp rules by default. INCOMPATIBILITY. Simplifier proof that require deletion of l_inv and/or r_inv will now also require deletion of these lemmas. * Renamed the following theorems, INCOMPATIBILITY: UpperD ~> Upper_memD LowerD ~> Lower_memD least_carrier ~> least_closed greatest_carrier ~> greatest_closed greatest_Lower_above ~> greatest_Lower_below one_zero ~> carrier_one_zero one_not_zero ~> carrier_one_not_zero (collision with assumption) *** HOL-Nominal *** * Nominal datatypes can now contain type-variables. * Commands 'nominal_inductive' and 'equivariance' work with local theory targets. * Nominal primrec can now works with local theory targets and its specification syntax now conforms to the general format as seen in 'inductive' etc. * Method "perm_simp" honours the standard simplifier attributes (no_asm), (no_asm_use) etc. * The new predicate #* is defined like freshness, except that on the left hand side can be a set or list of atoms. * Experimental command 'nominal_inductive2' derives strong induction principles for inductive definitions. In contrast to 'nominal_inductive', which can only deal with a fixed number of binders, it can deal with arbitrary expressions standing for sets of atoms to be avoided. The only inductive definition we have at the moment that needs this generalisation is the typing rule for Lets in the algorithm W: Gamma |- t1 : T1 (x,close Gamma T1)::Gamma |- t2 : T2 x#Gamma ----------------------------------------------------------------- Gamma |- Let x be t1 in t2 : T2 In this rule one wants to avoid all the binders that are introduced by "close Gamma T1". We are looking for other examples where this feature might be useful. Please let us know. *** HOLCF *** * Reimplemented the simplification procedure for proving continuity subgoals. The new simproc is extensible; users can declare additional continuity introduction rules with the attribute [cont2cont]. * The continuity simproc now uses a different introduction rule for solving continuity subgoals on terms with lambda abstractions. In some rare cases the new simproc may fail to solve subgoals that the old one could solve, and "simp add: cont2cont_LAM" may be necessary. Potential INCOMPATIBILITY. * Command 'fixrec': specification syntax now conforms to the general format as seen in 'inductive' etc. See src/HOLCF/ex/Fixrec_ex.thy for examples. INCOMPATIBILITY. *** ZF *** * Proof of Zorn's Lemma for partial orders. *** ML *** * Multithreading for Poly/ML 5.1/5.2 is no longer supported, only for Poly/ML 5.2.1 or later. Important note: the TimeLimit facility depends on multithreading, so timouts will not work before Poly/ML 5.2.1! * High-level support for concurrent ML programming, see src/Pure/Cuncurrent. The data-oriented model of "future values" is particularly convenient to organize independent functional computations. The concept of "synchronized variables" provides a higher-order interface for components with shared state, avoiding the delicate details of mutexes and condition variables. (Requires Poly/ML 5.2.1 or later.) * ML bindings produced via Isar commands are stored within the Isar context (theory or proof). Consequently, commands like 'use' and 'ML' become thread-safe and work with undo as expected (concerning top-level bindings, not side-effects on global references). INCOMPATIBILITY, need to provide proper Isar context when invoking the compiler at runtime; really global bindings need to be given outside a theory. (Requires Poly/ML 5.2 or later.) * Command 'ML_prf' is analogous to 'ML' but works within a proof context. Top-level ML bindings are stored within the proof context in a purely sequential fashion, disregarding the nested proof structure. ML bindings introduced by 'ML_prf' are discarded at the end of the proof. (Requires Poly/ML 5.2 or later.) * Simplified ML attribute and method setup, cf. functions Attrib.setup and Method.setup, as well as Isar commands 'attribute_setup' and 'method_setup'. INCOMPATIBILITY for 'method_setup', need to simplify existing code accordingly, or use plain 'setup' together with old Method.add_method. * Simplified ML oracle interface Thm.add_oracle promotes 'a -> cterm to 'a -> thm, while results are always tagged with an authentic oracle name. The Isar command 'oracle' is now polymorphic, no argument type is specified. INCOMPATIBILITY, need to simplify existing oracle code accordingly. Note that extra performance may be gained by producing the cterm carefully, avoiding slow Thm.cterm_of. * Simplified interface for defining document antiquotations via ThyOutput.antiquotation, ThyOutput.output, and optionally ThyOutput.maybe_pretty_source. INCOMPATIBILITY, need to simplify user antiquotations accordingly, see src/Pure/Thy/thy_output.ML for common examples. * More systematic treatment of long names, abstract name bindings, and name space operations. Basic operations on qualified names have been move from structure NameSpace to Long_Name, e.g. Long_Name.base_name, Long_Name.append. Old type bstring has been mostly replaced by abstract type binding (see structure Binding), which supports precise qualification by packages and local theory targets, as well as proper tracking of source positions. INCOMPATIBILITY, need to wrap old bstring values into Binding.name, or better pass through abstract bindings everywhere. See further src/Pure/General/long_name.ML, src/Pure/General/binding.ML and src/Pure/General/name_space.ML * Result facts (from PureThy.note_thms, ProofContext.note_thms, LocalTheory.note etc.) now refer to the *full* internal name, not the bstring as before. INCOMPATIBILITY, not detected by ML type-checking! * Disposed old type and term read functions (Sign.read_def_typ, Sign.read_typ, Sign.read_def_terms, Sign.read_term, Thm.read_def_cterms, Thm.read_cterm etc.). INCOMPATIBILITY, should use regular Syntax.read_typ, Syntax.read_term, Syntax.read_typ_global, Syntax.read_term_global etc.; see also OldGoals.read_term as last resort for legacy applications. * Disposed old declarations, tactics, tactic combinators that refer to the simpset or claset of an implicit theory (such as Addsimps, Simp_tac, SIMPSET). INCOMPATIBILITY, should use @{simpset} etc. in embedded ML text, or local_simpset_of with a proper context passed as explicit runtime argument. * Rules and tactics that read instantiations (read_instantiate, res_inst_tac, thin_tac, subgoal_tac etc.) now demand a proper proof context, which is required for parsing and type-checking. Moreover, the variables are specified as plain indexnames, not string encodings thereof. INCOMPATIBILITY. * Generic Toplevel.add_hook interface allows to analyze the result of transactions. E.g. see src/Pure/ProofGeneral/proof_general_pgip.ML for theorem dependency output of transactions resulting in a new theory state. * ML antiquotations: block-structured compilation context indicated by \ ... \; additional antiquotation forms: @{binding name} - basic name binding @{let ?pat = term} - term abbreviation (HO matching) @{note name = fact} - fact abbreviation @{thm fact} - singleton fact (with attributes) @{thms fact} - general fact (with attributes) @{lemma prop by method} - singleton goal @{lemma prop by meth1 meth2} - singleton goal @{lemma prop1 ... propN by method} - general goal @{lemma prop1 ... propN by meth1 meth2} - general goal @{lemma (open) ...} - open derivation *** System *** * The Isabelle "emacs" tool provides a specific interface to invoke Proof General / Emacs, with more explicit failure if that is not installed (the old isabelle-interface script silently falls back on isabelle-process). The PROOFGENERAL_HOME setting determines the installation location of the Proof General distribution. * Isabelle/lib/classes/Pure.jar provides basic support to integrate the Isabelle process into a JVM/Scala application. See Isabelle/lib/jedit/plugin for a minimal example. (The obsolete Java process wrapper has been discontinued.) * Added homegrown Isabelle font with unicode layout, see lib/fonts. * Various status messages (with exact source position information) are emitted, if proper markup print mode is enabled. This allows user-interface components to provide detailed feedback on internal prover operations. New in Isabelle2008 (June 2008) ------------------------------- *** General *** * The Isabelle/Isar Reference Manual (isar-ref) has been reorganized and updated, with formally checked references as hyperlinks. * Theory loader: use_thy (and similar operations) no longer set the implicit ML context, which was occasionally hard to predict and in conflict with concurrency. INCOMPATIBILITY, use ML within Isar which provides a proper context already. * Theory loader: old-style ML proof scripts being *attached* to a thy file are no longer supported. INCOMPATIBILITY, regular 'uses' and 'use' within a theory file will do the job. * Name space merge now observes canonical order, i.e. the second space is inserted into the first one, while existing entries in the first space take precedence. INCOMPATIBILITY in rare situations, may try to swap theory imports. * Syntax: symbol \ is now considered a letter. Potential INCOMPATIBILITY in identifier syntax etc. * Outer syntax: string tokens no longer admit escaped white space, which was an accidental (undocumented) feature. INCOMPATIBILITY, use white space without escapes. * Outer syntax: string tokens may contain arbitrary character codes specified via 3 decimal digits (as in SML). E.g. "foo\095bar" for "foo_bar". *** Pure *** * Context-dependent token translations. Default setup reverts locally fixed variables, and adds hilite markup for undeclared frees. * Unused theorems can be found using the new command 'unused_thms'. There are three ways of invoking it: (1) unused_thms Only finds unused theorems in the current theory. (2) unused_thms thy_1 ... thy_n - Finds unused theorems in the current theory and all of its ancestors, excluding the theories thy_1 ... thy_n and all of their ancestors. (3) unused_thms thy_1 ... thy_n - thy'_1 ... thy'_m Finds unused theorems in the theories thy'_1 ... thy'_m and all of their ancestors, excluding the theories thy_1 ... thy_n and all of their ancestors. In order to increase the readability of the list produced by unused_thms, theorems that have been created by a particular instance of a theory command such as 'inductive' or 'function' are considered to belong to the same "group", meaning that if at least one theorem in this group is used, the other theorems in the same group are no longer reported as unused. Moreover, if all theorems in the group are unused, only one theorem in the group is displayed. Note that proof objects have to be switched on in order for unused_thms to work properly (i.e. !proofs must be >= 1, which is usually the case when using Proof General with the default settings). * Authentic naming of facts disallows ad-hoc overwriting of previous theorems within the same name space. INCOMPATIBILITY, need to remove duplicate fact bindings, or even accidental fact duplications. Note that tools may maintain dynamically scoped facts systematically, using PureThy.add_thms_dynamic. * Command 'hide' now allows to hide from "fact" name space as well. * Eliminated destructive theorem database, simpset, claset, and clasimpset. Potential INCOMPATIBILITY, really need to observe linear update of theories within ML code. * Eliminated theory ProtoPure and CPure, leaving just one Pure theory. INCOMPATIBILITY, object-logics depending on former Pure require additional setup PureThy.old_appl_syntax_setup; object-logics depending on former CPure need to refer to Pure. * Commands 'use' and 'ML' are now purely functional, operating on theory/local_theory. Removed former 'ML_setup' (on theory), use 'ML' instead. Added 'ML_val' as mere diagnostic replacement for 'ML'. INCOMPATIBILITY. * Command 'setup': discontinued implicit version with ML reference. * Instantiation target allows for simultaneous specification of class instance operations together with an instantiation proof. Type-checking phase allows to refer to class operations uniformly. See src/HOL/Complex/Complex.thy for an Isar example and src/HOL/Library/Eval.thy for an ML example. * Indexing of literal facts: be more serious about including only facts from the visible specification/proof context, but not the background context (locale etc.). Affects `prop` notation and method "fact". INCOMPATIBILITY: need to name facts explicitly in rare situations. * Method "cases", "induct", "coinduct": removed obsolete/undocumented "(open)" option, which used to expose internal bound variables to the proof text. * Isar statements: removed obsolete case "rule_context". INCOMPATIBILITY, better use explicit fixes/assumes. * Locale proofs: default proof step now includes 'unfold_locales'; hence 'proof' without argument may be used to unfold locale predicates. *** Document preparation *** * Simplified pdfsetup.sty: color/hyperref is used unconditionally for both pdf and dvi (hyperlinks usually work in xdvi as well); removed obsolete thumbpdf setup (contemporary PDF viewers do this on the spot); renamed link color from "darkblue" to "linkcolor" (default value unchanged, can be redefined via \definecolor); no longer sets "a4paper" option (unnecessary or even intrusive). * Antiquotation @{lemma A method} proves proposition A by the given method (either a method name or a method name plus (optional) method arguments in parentheses) and prints A just like @{prop A}. *** HOL *** * New primrec package. Specification syntax conforms in style to definition/function/.... No separate induction rule is provided. The "primrec" command distinguishes old-style and new-style specifications by syntax. The former primrec package is now named OldPrimrecPackage. When adjusting theories, beware: constants stemming from new-style primrec specifications have authentic syntax. * Metis prover is now an order of magnitude faster, and also works with multithreading. * Metis: the maximum number of clauses that can be produced from a theorem is now given by the attribute max_clauses. Theorems that exceed this number are ignored, with a warning printed. * Sledgehammer no longer produces structured proofs by default. To enable, declare [[sledgehammer_full = true]]. Attributes reconstruction_modulus, reconstruction_sorts renamed sledgehammer_modulus, sledgehammer_sorts. INCOMPATIBILITY. * Method "induct_scheme" derives user-specified induction rules from well-founded induction and completeness of patterns. This factors out some operations that are done internally by the function package and makes them available separately. See src/HOL/ex/Induction_Scheme.thy for examples. * More flexible generation of measure functions for termination proofs: Measure functions can be declared by proving a rule of the form "is_measure f" and giving it the [measure_function] attribute. The "is_measure" predicate is logically meaningless (always true), and just guides the heuristic. To find suitable measure functions, the termination prover sets up the goal "is_measure ?f" of the appropriate type and generates all solutions by Prolog-style backward proof using the declared rules. This setup also deals with rules like "is_measure f ==> is_measure (list_size f)" which accommodates nested datatypes that recurse through lists. Similar rules are predeclared for products and option types. * Turned the type of sets "'a set" into an abbreviation for "'a => bool" INCOMPATIBILITIES: - Definitions of overloaded constants on sets have to be replaced by definitions on => and bool. - Some definitions of overloaded operators on sets can now be proved using the definitions of the operators on => and bool. Therefore, the following theorems have been renamed: subset_def -> subset_eq psubset_def -> psubset_eq set_diff_def -> set_diff_eq Compl_def -> Compl_eq Sup_set_def -> Sup_set_eq Inf_set_def -> Inf_set_eq sup_set_def -> sup_set_eq inf_set_def -> inf_set_eq - Due to the incompleteness of the HO unification algorithm, some rules such as subst may require manual instantiation, if some of the unknowns in the rule is a set. - Higher order unification and forward proofs: The proof pattern have "P (S::'a set)" <...> then have "EX S. P S" .. no longer works (due to the incompleteness of the HO unification algorithm) and must be replaced by the pattern have "EX S. P S" proof show "P S" <...> qed - Calculational reasoning with subst (or similar rules): The proof pattern have "P (S::'a set)" <...> also have "S = T" <...> finally have "P T" . no longer works (for similar reasons as the previous example) and must be replaced by something like have "P (S::'a set)" <...> moreover have "S = T" <...> ultimately have "P T" by simp - Tactics or packages written in ML code: Code performing pattern matching on types via Type ("set", [T]) => ... must be rewritten. Moreover, functions like strip_type or binder_types no longer return the right value when applied to a type of the form T1 => ... => Tn => U => bool rather than T1 => ... => Tn => U set * Merged theories Wellfounded_Recursion, Accessible_Part and Wellfounded_Relations to theory Wellfounded. * Explicit class "eq" for executable equality. INCOMPATIBILITY. * Class finite no longer treats UNIV as class parameter. Use class enum from theory Library/Enum instead to achieve a similar effect. INCOMPATIBILITY. * Theory List: rule list_induct2 now has explicitly named cases "Nil" and "Cons". INCOMPATIBILITY. * HOL (and FOL): renamed variables in rules imp_elim and swap. Potential INCOMPATIBILITY. * Theory Product_Type: duplicated lemmas split_Pair_apply and injective_fst_snd removed, use split_eta and prod_eqI instead. Renamed upd_fst to apfst and upd_snd to apsnd. INCOMPATIBILITY. * Theory Nat: removed redundant lemmas that merely duplicate lemmas of the same name in theory Orderings: less_trans less_linear le_imp_less_or_eq le_less_trans less_le_trans less_not_sym less_asym Renamed less_imp_le to less_imp_le_nat, and less_irrefl to less_irrefl_nat. Potential INCOMPATIBILITY due to more general types and different variable names. * Library/Option_ord.thy: Canonical order on option type. * Library/RBT.thy: Red-black trees, an efficient implementation of finite maps. * Library/Countable.thy: Type class for countable types. * Theory Int: The representation of numerals has changed. The infix operator BIT and the bit datatype with constructors B0 and B1 have disappeared. INCOMPATIBILITY, use "Int.Bit0 x" and "Int.Bit1 y" in place of "x BIT bit.B0" and "y BIT bit.B1", respectively. Theorems involving BIT, B0, or B1 have been renamed with "Bit0" or "Bit1" accordingly. * Theory Nat: definition of <= and < on natural numbers no longer depend on well-founded relations. INCOMPATIBILITY. Definitions le_def and less_def have disappeared. Consider lemmas not_less [symmetric, where ?'a = nat] and less_eq [symmetric] instead. * Theory Finite_Set: locales ACf, ACe, ACIf, ACIfSL and ACIfSLlin (whose purpose mainly is for various fold_set functionals) have been abandoned in favor of the existing algebraic classes ab_semigroup_mult, comm_monoid_mult, ab_semigroup_idem_mult, lower_semilattice (resp. upper_semilattice) and linorder. INCOMPATIBILITY. * Theory Transitive_Closure: induct and cases rules now declare proper case_names ("base" and "step"). INCOMPATIBILITY. * Theorem Inductive.lfp_ordinal_induct generalized to complete lattices. The form set-specific version is available as Inductive.lfp_ordinal_induct_set. * Renamed theorems "power.simps" to "power_int.simps". INCOMPATIBILITY. * Class semiring_div provides basic abstract properties of semirings with division and modulo operations. Subsumes former class dvd_mod. * Merged theories IntDef, Numeral and IntArith into unified theory Int. INCOMPATIBILITY. * Theory Library/Code_Index: type "index" now represents natural numbers rather than integers. INCOMPATIBILITY. * New class "uminus" with operation "uminus" (split of from class "minus" which now only has operation "minus", binary). INCOMPATIBILITY. * Constants "card", "internal_split", "option_map" now with authentic syntax. INCOMPATIBILITY. * Definitions subset_def, psubset_def, set_diff_def, Compl_def, le_bool_def, less_bool_def, le_fun_def, less_fun_def, inf_bool_def, sup_bool_def, Inf_bool_def, Sup_bool_def, inf_fun_def, sup_fun_def, Inf_fun_def, Sup_fun_def, inf_set_def, sup_set_def, Inf_set_def, Sup_set_def, le_def, less_def, option_map_def now with object equality. INCOMPATIBILITY. * Records. Removed K_record, and replaced it by pure lambda term %x. c. The simplifier setup is now more robust against eta expansion. INCOMPATIBILITY: in cases explicitly referring to K_record. * Library/Multiset: {#a, b, c#} abbreviates {#a#} + {#b#} + {#c#}. * Library/ListVector: new theory of arithmetic vector operations. * Library/Order_Relation: new theory of various orderings as sets of pairs. Defines preorders, partial orders, linear orders and well-orders on sets and on types. *** ZF *** * Renamed some theories to allow to loading both ZF and HOL in the same session: Datatype -> Datatype_ZF Inductive -> Inductive_ZF Int -> Int_ZF IntDiv -> IntDiv_ZF Nat -> Nat_ZF List -> List_ZF Main -> Main_ZF INCOMPATIBILITY: ZF theories that import individual theories below Main might need to be adapted. Regular theory Main is still available, as trivial extension of Main_ZF. *** ML *** * ML within Isar: antiquotation @{const name} or @{const name(typargs)} produces statically-checked Const term. * Functor NamedThmsFun: data is available to the user as dynamic fact (of the same name). Removed obsolete print command. * Removed obsolete "use_legacy_bindings" function. * The ``print mode'' is now a thread-local value derived from a global template (the former print_mode reference), thus access becomes non-critical. The global print_mode reference is for session management only; user-code should use print_mode_value, print_mode_active, PrintMode.setmp etc. INCOMPATIBILITY. * Functions system/system_out provide a robust way to invoke external shell commands, with propagation of interrupts (requires Poly/ML 5.2.1). Do not use OS.Process.system etc. from the basis library! *** System *** * Default settings: PROOFGENERAL_OPTIONS no longer impose xemacs --- in accordance with Proof General 3.7, which prefers GNU emacs. * isatool tty runs Isabelle process with plain tty interaction; optional line editor may be specified via ISABELLE_LINE_EDITOR setting, the default settings attempt to locate "ledit" and "rlwrap". * isatool browser now works with Cygwin as well, using general "javapath" function defined in Isabelle process environment. * YXML notation provides a simple and efficient alternative to standard XML transfer syntax. See src/Pure/General/yxml.ML and isatool yxml as described in the Isabelle system manual. * JVM class isabelle.IsabelleProcess (located in Isabelle/lib/classes) provides general wrapper for managing an Isabelle process in a robust fashion, with ``cooked'' output from stdin/stderr. * Rudimentary Isabelle plugin for jEdit (see Isabelle/lib/jedit), based on Isabelle/JVM process wrapper (see Isabelle/lib/classes). * Removed obsolete THIS_IS_ISABELLE_BUILD feature. NB: the documented way of changing the user's settings is via ISABELLE_HOME_USER/etc/settings, which is a fully featured bash script. * Multithreading.max_threads := 0 refers to the number of actual CPU cores of the underlying machine, which is a good starting point for optimal performance tuning. The corresponding usedir option -M allows "max" as an alias for "0". WARNING: does not work on certain versions of Mac OS (with Poly/ML 5.1). * isabelle-process: non-ML sessions are run with "nice", to reduce the adverse effect of Isabelle flooding interactive front-ends (notably ProofGeneral / XEmacs). New in Isabelle2007 (November 2007) ----------------------------------- *** General *** * More uniform information about legacy features, notably a warning/error of "Legacy feature: ...", depending on the state of the tolerate_legacy_features flag (default true). FUTURE INCOMPATIBILITY: legacy features will disappear eventually. * Theory syntax: the header format ``theory A = B + C:'' has been discontinued in favour of ``theory A imports B C begin''. Use isatool fixheaders to convert existing theory files. INCOMPATIBILITY. * Theory syntax: the old non-Isar theory file format has been discontinued altogether. Note that ML proof scripts may still be used with Isar theories; migration is usually quite simple with the ML function use_legacy_bindings. INCOMPATIBILITY. * Theory syntax: some popular names (e.g. 'class', 'declaration', 'fun', 'help', 'if') are now keywords. INCOMPATIBILITY, use double quotes. * Theory loader: be more serious about observing the static theory header specifications (including optional directories), but not the accidental file locations of previously successful loads. The strict update policy of former update_thy is now already performed by use_thy, so the former has been removed; use_thys updates several theories simultaneously, just as 'imports' within a theory header specification, but without merging the results. Potential INCOMPATIBILITY: may need to refine theory headers and commands ROOT.ML which depend on load order. * Theory loader: optional support for content-based file identification, instead of the traditional scheme of full physical path plus date stamp; configured by the ISABELLE_FILE_IDENT setting (cf. the system manual). The new scheme allows to work with non-finished theories in persistent session images, such that source files may be moved later on without requiring reloads. * Theory loader: old-style ML proof scripts being *attached* to a thy file (with the same base name as the theory) are considered a legacy feature, which will disappear eventually. Even now, the theory loader no longer maintains dependencies on such files. * Syntax: the scope for resolving ambiguities via type-inference is now limited to individual terms, instead of whole simultaneous specifications as before. This greatly reduces the complexity of the syntax module and improves flexibility by separating parsing and type-checking. INCOMPATIBILITY: additional type-constraints (explicit 'fixes' etc.) are required in rare situations. * Syntax: constants introduced by new-style packages ('definition', 'abbreviation' etc.) are passed through the syntax module in ``authentic mode''. This means that associated mixfix annotations really stick to such constants, independently of potential name space ambiguities introduced later on. INCOMPATIBILITY: constants in parse trees are represented slightly differently, may need to adapt syntax translations accordingly. Use CONST marker in 'translations' and @{const_syntax} antiquotation in 'parse_translation' etc. * Legacy goal package: reduced interface to the bare minimum required to keep existing proof scripts running. Most other user-level functions are now part of the OldGoals structure, which is *not* open by default (consider isatool expandshort before open OldGoals). Removed top_sg, prin, printyp, pprint_term/typ altogether, because these tend to cause confusion about the actual goal (!) context being used here, which is not necessarily the same as the_context(). * Command 'find_theorems': supports "*" wild-card in "name:" criterion; "with_dups" option. Certain ProofGeneral versions might support a specific search form (see ProofGeneral/CHANGES). * The ``prems limit'' option (cf. ProofContext.prems_limit) is now -1 by default, which means that "prems" (and also "fixed variables") are suppressed from proof state output. Note that the ProofGeneral settings mechanism allows to change and save options persistently, but older versions of Isabelle will fail to start up if a negative prems limit is imposed. * Local theory targets may be specified by non-nested blocks of ``context/locale/class ... begin'' followed by ``end''. The body may contain definitions, theorems etc., including any derived mechanism that has been implemented on top of these primitives. This concept generalizes the existing ``theorem (in ...)'' towards more versatility and scalability. * Proof General interface: proper undo of final 'end' command; discontinued Isabelle/classic mode (ML proof scripts). *** Document preparation *** * Added antiquotation @{theory name} which prints the given name, after checking that it refers to a valid ancestor theory in the current context. * Added antiquotations @{ML_type text} and @{ML_struct text} which check the given source text as ML type/structure, printing verbatim. * Added antiquotation @{abbrev "c args"} which prints the abbreviation "c args == rhs" given in the current context. (Any number of arguments may be given on the LHS.) *** Pure *** * The 'class' package offers a combination of axclass and locale to achieve Haskell-like type classes in Isabelle. Definitions and theorems within a class context produce both relative results (with implicit parameters according to the locale context), and polymorphic constants with qualified polymorphism (according to the class context). Within the body context of a 'class' target, a separate syntax layer ("user space type system") takes care of converting between global polymorphic consts and internal locale representation. See src/HOL/ex/Classpackage.thy for examples (as well as main HOL). "isatool doc classes" provides a tutorial. * Generic code generator framework allows to generate executable code for ML and Haskell (including Isabelle classes). A short usage sketch: internal compilation: export_code in SML writing SML code to a file: export_code in SML writing OCaml code to a file: export_code in OCaml writing Haskell code to a bunch of files: export_code in Haskell evaluating closed propositions to True/False using code generation: method ``eval'' Reasonable default setup of framework in HOL. Theorem attributs for selecting and transforming function equations theorems: [code fun]: select a theorem as function equation for a specific constant [code fun del]: deselect a theorem as function equation for a specific constant [code inline]: select an equation theorem for unfolding (inlining) in place [code inline del]: deselect an equation theorem for unfolding (inlining) in place User-defined serializations (target in {SML, OCaml, Haskell}): code_const {(target) }+ code_type {(target) }+ code_instance {(target)}+ where instance ::= :: code_class {(target) }+ where class target syntax ::= {where { == }+}? code_instance and code_class only are effective to target Haskell. For example usage see src/HOL/ex/Codegenerator.thy and src/HOL/ex/Codegenerator_Pretty.thy. A separate tutorial on code generation from Isabelle/HOL theories is available via "isatool doc codegen". * Code generator: consts in 'consts_code' Isar commands are now referred to by usual term syntax (including optional type annotations). * Command 'no_translations' removes translation rules from theory syntax. * Overloaded definitions are now actually checked for acyclic dependencies. The overloading scheme is slightly more general than that of Haskell98, although Isabelle does not demand an exact correspondence to type class and instance declarations. INCOMPATIBILITY, use ``defs (unchecked overloaded)'' to admit more exotic versions of overloading -- at the discretion of the user! Polymorphic constants are represented via type arguments, i.e. the instantiation that matches an instance against the most general declaration given in the signature. For example, with the declaration c :: 'a => 'a => 'a, an instance c :: nat => nat => nat is represented as c(nat). Overloading is essentially simultaneous structural recursion over such type arguments. Incomplete specification patterns impose global constraints on all occurrences, e.g. c('a * 'a) on the LHS means that more general c('a * 'b) will be disallowed on any RHS. Command 'print_theory' outputs the normalized system of recursive equations, see section "definitions". * Configuration options are maintained within the theory or proof context (with name and type bool/int/string), providing a very simple interface to a poor-man's version of general context data. Tools may declare options in ML (e.g. using Attrib.config_int) and then refer to these values using Config.get etc. Users may change options via an associated attribute of the same name. This form of context declaration works particularly well with commands 'declare' or 'using', for example ``declare [[foo = 42]]''. Thus it has become very easy to avoid global references, which would not observe Isar toplevel undo/redo and fail to work with multithreading. Various global ML references of Pure and HOL have been turned into configuration options: Unify.search_bound unify_search_bound Unify.trace_bound unify_trace_bound Unify.trace_simp unify_trace_simp Unify.trace_types unify_trace_types Simplifier.simp_depth_limit simp_depth_limit Blast.depth_limit blast_depth_limit DatatypeProp.dtK datatype_distinctness_limit fast_arith_neq_limit fast_arith_neq_limit fast_arith_split_limit fast_arith_split_limit * Named collections of theorems may be easily installed as context data using the functor NamedThmsFun (see also src/Pure/Tools/named_thms.ML). The user may add or delete facts via attributes; there is also a toplevel print command. This facility is just a common case of general context data, which is the preferred way for anything more complex than just a list of facts in canonical order. * Isar: command 'declaration' augments a local theory by generic declaration functions written in ML. This enables arbitrary content being added to the context, depending on a morphism that tells the difference of the original declaration context wrt. the application context encountered later on. * Isar: proper interfaces for simplification procedures. Command 'simproc_setup' declares named simprocs (with match patterns, and body text in ML). Attribute "simproc" adds/deletes simprocs in the current context. ML antiquotation @{simproc name} retrieves named simprocs. * Isar: an extra pair of brackets around attribute declarations abbreviates a theorem reference involving an internal dummy fact, which will be ignored later --- only the effect of the attribute on the background context will persist. This form of in-place declarations is particularly useful with commands like 'declare' and 'using', for example ``have A using [[simproc a]] by simp''. * Isar: method "assumption" (and implicit closing of subproofs) now takes simple non-atomic goal assumptions into account: after applying an assumption as a rule the resulting subgoals are solved by atomic assumption steps. This is particularly useful to finish 'obtain' goals, such as "!!x. (!!x. P x ==> thesis) ==> P x ==> thesis", without referring to the original premise "!!x. P x ==> thesis" in the Isar proof context. POTENTIAL INCOMPATIBILITY: method "assumption" is more permissive. * Isar: implicit use of prems from the Isar proof context is considered a legacy feature. Common applications like ``have A .'' may be replaced by ``have A by fact'' or ``note `A`''. In general, referencing facts explicitly here improves readability and maintainability of proof texts. * Isar: improper proof element 'guess' is like 'obtain', but derives the obtained context from the course of reasoning! For example: assume "EX x y. A x & B y" -- "any previous fact" then guess x and y by clarify This technique is potentially adventurous, depending on the facts and proof tools being involved here. * Isar: known facts from the proof context may be specified as literal propositions, using ASCII back-quote syntax. This works wherever named facts used to be allowed so far, in proof commands, proof methods, attributes etc. Literal facts are retrieved from the context according to unification of type and term parameters. For example, provided that "A" and "A ==> B" and "!!x. P x ==> Q x" are known theorems in the current context, then these are valid literal facts: `A` and `A ==> B` and `!!x. P x ==> Q x" as well as `P a ==> Q a` etc. There is also a proof method "fact" which does the same composition for explicit goal states, e.g. the following proof texts coincide with certain special cases of literal facts: have "A" by fact == note `A` have "A ==> B" by fact == note `A ==> B` have "!!x. P x ==> Q x" by fact == note `!!x. P x ==> Q x` have "P a ==> Q a" by fact == note `P a ==> Q a` * Isar: ":" (colon) is no longer a symbolic identifier character in outer syntax. Thus symbolic identifiers may be used without additional white space in declarations like this: ``assume *: A''. * Isar: 'print_facts' prints all local facts of the current context, both named and unnamed ones. * Isar: 'def' now admits simultaneous definitions, e.g.: def x == "t" and y == "u" * Isar: added command 'unfolding', which is structurally similar to 'using', but affects both the goal state and facts by unfolding given rewrite rules. Thus many occurrences of the 'unfold' method or 'unfolded' attribute may be replaced by first-class proof text. * Isar: methods 'unfold' / 'fold', attributes 'unfolded' / 'folded', and command 'unfolding' now all support object-level equalities (potentially conditional). The underlying notion of rewrite rule is analogous to the 'rule_format' attribute, but *not* that of the Simplifier (which is usually more generous). * Isar: the new attribute [rotated n] (default n = 1) rotates the premises of a theorem by n. Useful in conjunction with drule. * Isar: the goal restriction operator [N] (default N = 1) evaluates a method expression within a sandbox consisting of the first N sub-goals, which need to exist. For example, ``simp_all [3]'' simplifies the first three sub-goals, while (rule foo, simp_all)[] simplifies all new goals that emerge from applying rule foo to the originally first one. * Isar: schematic goals are no longer restricted to higher-order patterns; e.g. ``lemma "?P(?x)" by (rule TrueI)'' now works as expected. * Isar: the conclusion of a long theorem statement is now either 'shows' (a simultaneous conjunction, as before), or 'obtains' (essentially a disjunction of cases with local parameters and assumptions). The latter allows to express general elimination rules adequately; in this notation common elimination rules look like this: lemma exE: -- "EX x. P x ==> (!!x. P x ==> thesis) ==> thesis" assumes "EX x. P x" obtains x where "P x" lemma conjE: -- "A & B ==> (A ==> B ==> thesis) ==> thesis" assumes "A & B" obtains A and B lemma disjE: -- "A | B ==> (A ==> thesis) ==> (B ==> thesis) ==> thesis" assumes "A | B" obtains A | B The subsequent classical rules even refer to the formal "thesis" explicitly: lemma classical: -- "(~ thesis ==> thesis) ==> thesis" obtains "~ thesis" lemma Peirce's_Law: -- "((thesis ==> something) ==> thesis) ==> thesis" obtains "thesis ==> something" The actual proof of an 'obtains' statement is analogous to that of the Isar proof element 'obtain', only that there may be several cases. Optional case names may be specified in parentheses; these will be available both in the present proof and as annotations in the resulting rule, for later use with the 'cases' method (cf. attribute case_names). * Isar: the assumptions of a long theorem statement are available as "assms" fact in the proof context. This is more appropriate than the (historical) "prems", which refers to all assumptions of the current context, including those from the target locale, proof body etc. * Isar: 'print_statement' prints theorems from the current theory or proof context in long statement form, according to the syntax of a top-level lemma. * Isar: 'obtain' takes an optional case name for the local context introduction rule (default "that"). * Isar: removed obsolete 'concl is' patterns. INCOMPATIBILITY, use explicit (is "_ ==> ?foo") in the rare cases where this still happens to occur. * Pure: syntax "CONST name" produces a fully internalized constant according to the current context. This is particularly useful for syntax translations that should refer to internal constant representations independently of name spaces. * Pure: syntax constant for foo (binder "FOO ") is called "foo_binder" instead of "FOO ". This allows multiple binder declarations to coexist in the same context. INCOMPATIBILITY. * Isar/locales: 'notation' provides a robust interface to the 'syntax' primitive that also works in a locale context (both for constants and fixed variables). Type declaration and internal syntactic representation of given constants retrieved from the context. Likewise, the 'no_notation' command allows to remove given syntax annotations from the current context. * Isar/locales: new derived specification elements 'axiomatization', 'definition', 'abbreviation', which support type-inference, admit object-level specifications (equality, equivalence). See also the isar-ref manual. Examples: axiomatization eq (infix "===" 50) where eq_refl: "x === x" and eq_subst: "x === y ==> P x ==> P y" definition "f x y = x + y + 1" definition g where "g x = f x x" abbreviation neq (infix "=!=" 50) where "x =!= y == ~ (x === y)" These specifications may be also used in a locale context. Then the constants being introduced depend on certain fixed parameters, and the constant name is qualified by the locale base name. An internal abbreviation takes care for convenient input and output, making the parameters implicit and using the original short name. See also src/HOL/ex/Abstract_NAT.thy for an example of deriving polymorphic entities from a monomorphic theory. Presently, abbreviations are only available 'in' a target locale, but not inherited by general import expressions. Also note that 'abbreviation' may be used as a type-safe replacement for 'syntax' + 'translations' in common applications. The "no_abbrevs" print mode prevents folding of abbreviations in term output. Concrete syntax is attached to specified constants in internal form, independently of name spaces. The parse tree representation is slightly different -- use 'notation' instead of raw 'syntax', and 'translations' with explicit "CONST" markup to accommodate this. * Pure/Isar: unified syntax for new-style specification mechanisms (e.g. 'definition', 'abbreviation', or 'inductive' in HOL) admits full type inference and dummy patterns ("_"). For example: definition "K x _ = x" inductive conj for A B where "A ==> B ==> conj A B" * Pure: command 'print_abbrevs' prints all constant abbreviations of the current context. Print mode "no_abbrevs" prevents inversion of abbreviations on output. * Isar/locales: improved parameter handling: use of locales "var" and "struct" no longer necessary; - parameter renamings are no longer required to be injective. For example, this allows to define endomorphisms as locale endom = homom mult mult h. * Isar/locales: changed the way locales with predicates are defined. Instead of accumulating the specification, the imported expression is now an interpretation. INCOMPATIBILITY: different normal form of locale expressions. In particular, in interpretations of locales with predicates, goals repesenting already interpreted fragments are not removed automatically. Use methods `intro_locales' and `unfold_locales'; see below. * Isar/locales: new methods `intro_locales' and `unfold_locales' provide backward reasoning on locales predicates. The methods are aware of interpretations and discharge corresponding goals. `intro_locales' is less aggressive then `unfold_locales' and does not unfold predicates to assumptions. * Isar/locales: the order in which locale fragments are accumulated has changed. This enables to override declarations from fragments due to interpretations -- for example, unwanted simp rules. * Isar/locales: interpretation in theories and proof contexts has been extended. One may now specify (and prove) equations, which are unfolded in interpreted theorems. This is useful for replacing defined concepts (constants depending on locale parameters) by concepts already existing in the target context. Example: interpretation partial_order ["op <= :: [int, int] => bool"] where "partial_order.less (op <=) (x::int) y = (x < y)" Typically, the constant `partial_order.less' is created by a definition specification element in the context of locale partial_order. * Method "induct": improved internal context management to support local fixes and defines on-the-fly. Thus explicit meta-level connectives !! and ==> are rarely required anymore in inductive goals (using object-logic connectives for this purpose has been long obsolete anyway). Common proof patterns are explained in src/HOL/Induct/Common_Patterns.thy, see also src/HOL/Isar_examples/Puzzle.thy and src/HOL/Lambda for realistic examples. * Method "induct": improved handling of simultaneous goals. Instead of introducing object-level conjunction, the statement is now split into several conclusions, while the corresponding symbolic cases are nested accordingly. INCOMPATIBILITY, proofs need to be structured explicitly, see src/HOL/Induct/Common_Patterns.thy, for example. * Method "induct": mutual induction rules are now specified as a list of rule sharing the same induction cases. HOL packages usually provide foo_bar.inducts for mutually defined items foo and bar (e.g. inductive predicates/sets or datatypes). INCOMPATIBILITY, users need to specify mutual induction rules differently, i.e. like this: (induct rule: foo_bar.inducts) (induct set: foo bar) (induct pred: foo bar) (induct type: foo bar) The ML function ProjectRule.projections turns old-style rules into the new format. * Method "coinduct": dual of induction, see src/HOL/Library/Coinductive_List.thy for various examples. * Method "cases", "induct", "coinduct": the ``(open)'' option is considered a legacy feature. * Attribute "symmetric" produces result with standardized schematic variables (index 0). Potential INCOMPATIBILITY. * Simplifier: by default the simplifier trace only shows top level rewrites now. That is, trace_simp_depth_limit is set to 1 by default. Thus there is less danger of being flooded by the trace. The trace indicates where parts have been suppressed. * Provers/classical: removed obsolete classical version of elim_format attribute; classical elim/dest rules are now treated uniformly when manipulating the claset. * Provers/classical: stricter checks to ensure that supplied intro, dest and elim rules are well-formed; dest and elim rules must have at least one premise. * Provers/classical: attributes dest/elim/intro take an optional weight argument for the rule (just as the Pure versions). Weights are ignored by automated tools, but determine the search order of single rule steps. * Syntax: input syntax now supports dummy variable binding "%_. b", where the body does not mention the bound variable. Note that dummy patterns implicitly depend on their context of bounds, which makes "{_. _}" match any set comprehension as expected. Potential INCOMPATIBILITY -- parse translations need to cope with syntactic constant "_idtdummy" in the binding position. * Syntax: removed obsolete syntactic constant "_K" and its associated parse translation. INCOMPATIBILITY -- use dummy abstraction instead, for example "A -> B" => "Pi A (%_. B)". * Pure: 'class_deps' command visualizes the subclass relation, using the graph browser tool. * Pure: 'print_theory' now suppresses certain internal declarations by default; use '!' option for full details. *** HOL *** * Method "metis" proves goals by applying the Metis general-purpose resolution prover (see also http://gilith.com/software/metis/). Examples are in the directory MetisExamples. WARNING: the Isabelle/HOL-Metis integration does not yet work properly with multi-threading. * Command 'sledgehammer' invokes external automatic theorem provers as background processes. It generates calls to the "metis" method if successful. These can be pasted into the proof. Users do not have to wait for the automatic provers to return. WARNING: does not really work with multi-threading. * New "auto_quickcheck" feature tests outermost goal statements for potential counter-examples. Controlled by ML references auto_quickcheck (default true) and auto_quickcheck_time_limit (default 5000 milliseconds). Fails silently if statements is outside of executable fragment, or any other codgenerator problem occurs. * New constant "undefined" with axiom "undefined x = undefined". * Added class "HOL.eq", allowing for code generation with polymorphic equality. * Some renaming of class constants due to canonical name prefixing in the new 'class' package: HOL.abs ~> HOL.abs_class.abs HOL.divide ~> HOL.divide_class.divide 0 ~> HOL.zero_class.zero 1 ~> HOL.one_class.one op + ~> HOL.plus_class.plus op - ~> HOL.minus_class.minus uminus ~> HOL.minus_class.uminus op * ~> HOL.times_class.times op < ~> HOL.ord_class.less op <= > HOL.ord_class.less_eq Nat.power ~> Power.power_class.power Nat.size ~> Nat.size_class.size Numeral.number_of ~> Numeral.number_class.number_of FixedPoint.Inf ~> Lattices.complete_lattice_class.Inf FixedPoint.Sup ~> Lattices.complete_lattice_class.Sup Orderings.min ~> Orderings.ord_class.min Orderings.max ~> Orderings.ord_class.max Divides.op div ~> Divides.div_class.div Divides.op mod ~> Divides.div_class.mod Divides.op dvd ~> Divides.div_class.dvd INCOMPATIBILITY. Adaptions may be required in the following cases: a) User-defined constants using any of the names "plus", "minus", "times", "less" or "less_eq". The standard syntax translations for "+", "-" and "*" may go wrong. INCOMPATIBILITY: use more specific names. b) Variables named "plus", "minus", "times", "less", "less_eq" INCOMPATIBILITY: use more specific names. c) Permutative equations (e.g. "a + b = b + a") Since the change of names also changes the order of terms, permutative rewrite rules may get applied in a different order. Experience shows that this is rarely the case (only two adaptions in the whole Isabelle distribution). INCOMPATIBILITY: rewrite proofs d) ML code directly refering to constant names This in general only affects hand-written proof tactics, simprocs and so on. INCOMPATIBILITY: grep your sourcecode and replace names. Consider using @{const_name} antiquotation. * New class "default" with associated constant "default". * Function "sgn" is now overloaded and available on int, real, complex (and other numeric types), using class "sgn". Two possible defs of sgn are given as equational assumptions in the classes sgn_if and sgn_div_norm; ordered_idom now also inherits from sgn_if. INCOMPATIBILITY. * Locale "partial_order" now unified with class "order" (cf. theory Orderings), added parameter "less". INCOMPATIBILITY. * Renamings in classes "order" and "linorder": facts "refl", "trans" and "cases" to "order_refl", "order_trans" and "linorder_cases", to avoid clashes with HOL "refl" and "trans". INCOMPATIBILITY. * Classes "order" and "linorder": potential INCOMPATIBILITY due to changed order of proof goals in instance proofs. * The transitivity reasoner for partial and linear orders is set up for classes "order" and "linorder". Instances of the reasoner are available in all contexts importing or interpreting the corresponding locales. Method "order" invokes the reasoner separately; the reasoner is also integrated with the Simplifier as a solver. Diagnostic command 'print_orders' shows the available instances of the reasoner in the current context. * Localized monotonicity predicate in theory "Orderings"; integrated lemmas max_of_mono and min_of_mono with this predicate. INCOMPATIBILITY. * Formulation of theorem "dense" changed slightly due to integration with new class dense_linear_order. * Uniform lattice theory development in HOL. constants "meet" and "join" now named "inf" and "sup" constant "Meet" now named "Inf" classes "meet_semilorder" and "join_semilorder" now named "lower_semilattice" and "upper_semilattice" class "lorder" now named "lattice" class "comp_lat" now named "complete_lattice" Instantiation of lattice classes allows explicit definitions for "inf" and "sup" operations (or "Inf" and "Sup" for complete lattices). INCOMPATIBILITY. Theorem renames: meet_left_le ~> inf_le1 meet_right_le ~> inf_le2 join_left_le ~> sup_ge1 join_right_le ~> sup_ge2 meet_join_le ~> inf_sup_ord le_meetI ~> le_infI join_leI ~> le_supI le_meet ~> le_inf_iff le_join ~> ge_sup_conv meet_idempotent ~> inf_idem join_idempotent ~> sup_idem meet_comm ~> inf_commute join_comm ~> sup_commute meet_leI1 ~> le_infI1 meet_leI2 ~> le_infI2 le_joinI1 ~> le_supI1 le_joinI2 ~> le_supI2 meet_assoc ~> inf_assoc join_assoc ~> sup_assoc meet_left_comm ~> inf_left_commute meet_left_idempotent ~> inf_left_idem join_left_comm ~> sup_left_commute join_left_idempotent ~> sup_left_idem meet_aci ~> inf_aci join_aci ~> sup_aci le_def_meet ~> le_iff_inf le_def_join ~> le_iff_sup join_absorp2 ~> sup_absorb2 join_absorp1 ~> sup_absorb1 meet_absorp1 ~> inf_absorb1 meet_absorp2 ~> inf_absorb2 meet_join_absorp ~> inf_sup_absorb join_meet_absorp ~> sup_inf_absorb distrib_join_le ~> distrib_sup_le distrib_meet_le ~> distrib_inf_le add_meet_distrib_left ~> add_inf_distrib_left add_join_distrib_left ~> add_sup_distrib_left is_join_neg_meet ~> is_join_neg_inf is_meet_neg_join ~> is_meet_neg_sup add_meet_distrib_right ~> add_inf_distrib_right add_join_distrib_right ~> add_sup_distrib_right add_meet_join_distribs ~> add_sup_inf_distribs join_eq_neg_meet ~> sup_eq_neg_inf meet_eq_neg_join ~> inf_eq_neg_sup add_eq_meet_join ~> add_eq_inf_sup meet_0_imp_0 ~> inf_0_imp_0 join_0_imp_0 ~> sup_0_imp_0 meet_0_eq_0 ~> inf_0_eq_0 join_0_eq_0 ~> sup_0_eq_0 neg_meet_eq_join ~> neg_inf_eq_sup neg_join_eq_meet ~> neg_sup_eq_inf join_eq_if ~> sup_eq_if mono_meet ~> mono_inf mono_join ~> mono_sup meet_bool_eq ~> inf_bool_eq join_bool_eq ~> sup_bool_eq meet_fun_eq ~> inf_fun_eq join_fun_eq ~> sup_fun_eq meet_set_eq ~> inf_set_eq join_set_eq ~> sup_set_eq meet1_iff ~> inf1_iff meet2_iff ~> inf2_iff meet1I ~> inf1I meet2I ~> inf2I meet1D1 ~> inf1D1 meet2D1 ~> inf2D1 meet1D2 ~> inf1D2 meet2D2 ~> inf2D2 meet1E ~> inf1E meet2E ~> inf2E join1_iff ~> sup1_iff join2_iff ~> sup2_iff join1I1 ~> sup1I1 join2I1 ~> sup2I1 join1I1 ~> sup1I1 join2I2 ~> sup1I2 join1CI ~> sup1CI join2CI ~> sup2CI join1E ~> sup1E join2E ~> sup2E is_meet_Meet ~> is_meet_Inf Meet_bool_def ~> Inf_bool_def Meet_fun_def ~> Inf_fun_def Meet_greatest ~> Inf_greatest Meet_lower ~> Inf_lower Meet_set_def ~> Inf_set_def Sup_def ~> Sup_Inf Sup_bool_eq ~> Sup_bool_def Sup_fun_eq ~> Sup_fun_def Sup_set_eq ~> Sup_set_def listsp_meetI ~> listsp_infI listsp_meet_eq ~> listsp_inf_eq meet_min ~> inf_min join_max ~> sup_max * Added syntactic class "size"; overloaded constant "size" now has type "'a::size ==> bool" * Internal reorganisation of `size' of datatypes: size theorems "foo.size" are no longer subsumed by "foo.simps" (but are still simplification rules by default!); theorems "prod.size" now named "*.size". * Class "div" now inherits from class "times" rather than "type". INCOMPATIBILITY. * HOL/Finite_Set: "name-space" locales Lattice, Distrib_lattice, Linorder etc. have disappeared; operations defined in terms of fold_set now are named Inf_fin, Sup_fin. INCOMPATIBILITY. * HOL/Nat: neq0_conv no longer declared as iff. INCOMPATIBILITY. * HOL-Word: New extensive library and type for generic, fixed size machine words, with arithmetic, bit-wise, shifting and rotating operations, reflection into int, nat, and bool lists, automation for linear arithmetic (by automatic reflection into nat or int), including lemmas on overflow and monotonicity. Instantiated to all appropriate arithmetic type classes, supporting automatic simplification of numerals on all operations. * Library/Boolean_Algebra: locales for abstract boolean algebras. * Library/Numeral_Type: numbers as types, e.g. TYPE(32). * Code generator library theories: - Code_Integer represents HOL integers by big integer literals in target languages. - Code_Char represents HOL characters by character literals in target languages. - Code_Char_chr like Code_Char, but also offers treatment of character codes; includes Code_Integer. - Executable_Set allows to generate code for finite sets using lists. - Executable_Rat implements rational numbers as triples (sign, enumerator, denominator). - Executable_Real implements a subset of real numbers, namly those representable by rational numbers. - Efficient_Nat implements natural numbers by integers, which in general will result in higher efficency; pattern matching with 0/Suc is eliminated; includes Code_Integer. - Code_Index provides an additional datatype index which is mapped to target-language built-in integers. - Code_Message provides an additional datatype message_string which is isomorphic to strings; messages are mapped to target-language strings. * New package for inductive predicates An n-ary predicate p with m parameters z_1, ..., z_m can now be defined via inductive p :: "U_1 => ... => U_m => T_1 => ... => T_n => bool" for z_1 :: U_1 and ... and z_n :: U_m where rule_1: "... ==> p z_1 ... z_m t_1_1 ... t_1_n" | ... with full support for type-inference, rather than consts s :: "U_1 => ... => U_m => (T_1 * ... * T_n) set" abbreviation p :: "U_1 => ... => U_m => T_1 => ... => T_n => bool" where "p z_1 ... z_m x_1 ... x_n == (x_1, ..., x_n) : s z_1 ... z_m" inductive "s z_1 ... z_m" intros rule_1: "... ==> (t_1_1, ..., t_1_n) : s z_1 ... z_m" ... For backward compatibility, there is a wrapper allowing inductive sets to be defined with the new package via inductive_set s :: "U_1 => ... => U_m => (T_1 * ... * T_n) set" for z_1 :: U_1 and ... and z_n :: U_m where rule_1: "... ==> (t_1_1, ..., t_1_n) : s z_1 ... z_m" | ... or inductive_set s :: "U_1 => ... => U_m => (T_1 * ... * T_n) set" and p :: "U_1 => ... => U_m => T_1 => ... => T_n => bool" for z_1 :: U_1 and ... and z_n :: U_m where "p z_1 ... z_m x_1 ... x_n == (x_1, ..., x_n) : s z_1 ... z_m" | rule_1: "... ==> p z_1 ... z_m t_1_1 ... t_1_n" | ... if the additional syntax "p ..." is required. Numerous examples can be found in the subdirectories src/HOL/Auth, src/HOL/Bali, src/HOL/Induct, and src/HOL/MicroJava. INCOMPATIBILITIES: - Since declaration and definition of inductive sets or predicates is no longer separated, abbreviations involving the newly introduced sets or predicates must be specified together with the introduction rules after the 'where' keyword (see above), rather than before the actual inductive definition. - The variables in induction and elimination rules are now quantified in the order of their occurrence in the introduction rules, rather than in alphabetical order. Since this may break some proofs, these proofs either have to be repaired, e.g. by reordering the variables a_i_1 ... a_i_{k_i} in Isar 'case' statements of the form case (rule_i a_i_1 ... a_i_{k_i}) or the old order of quantification has to be restored by explicitly adding meta-level quantifiers in the introduction rules, i.e. | rule_i: "!!a_i_1 ... a_i_{k_i}. ... ==> p z_1 ... z_m t_i_1 ... t_i_n" - The format of the elimination rules is now p z_1 ... z_m x_1 ... x_n ==> (!!a_1_1 ... a_1_{k_1}. x_1 = t_1_1 ==> ... ==> x_n = t_1_n ==> ... ==> P) ==> ... ==> P for predicates and (x_1, ..., x_n) : s z_1 ... z_m ==> (!!a_1_1 ... a_1_{k_1}. x_1 = t_1_1 ==> ... ==> x_n = t_1_n ==> ... ==> P) ==> ... ==> P for sets rather than x : s z_1 ... z_m ==> (!!a_1_1 ... a_1_{k_1}. x = (t_1_1, ..., t_1_n) ==> ... ==> P) ==> ... ==> P This may require terms in goals to be expanded to n-tuples (e.g. using case_tac or simplification with the split_paired_all rule) before the above elimination rule is applicable. - The elimination or case analysis rules for (mutually) inductive sets or predicates are now called "p_1.cases" ... "p_k.cases". The list of rules "p_1_..._p_k.elims" is no longer available. * New package "function"/"fun" for general recursive functions, supporting mutual and nested recursion, definitions in local contexts, more general pattern matching and partiality. See HOL/ex/Fundefs.thy for small examples, and the separate tutorial on the function package. The old recdef "package" is still available as before, but users are encouraged to use the new package. * Method "lexicographic_order" automatically synthesizes termination relations as lexicographic combinations of size measures. * Case-expressions allow arbitrary constructor-patterns (including "_") and take their order into account, like in functional programming. Internally, this is translated into nested case-expressions; missing cases are added and mapped to the predefined constant "undefined". In complicated cases printing may no longer show the original input but the internal form. Lambda-abstractions allow the same form of pattern matching: "% pat1 => e1 | ..." is an abbreviation for "%x. case x of pat1 => e1 | ..." where x is a new variable. * IntDef: The constant "int :: nat => int" has been removed; now "int" is an abbreviation for "of_nat :: nat => int". The simplification rules for "of_nat" have been changed to work like "int" did previously. Potential INCOMPATIBILITY: - "of_nat (Suc m)" simplifies to "1 + of_nat m" instead of "of_nat m + 1" - of_nat_diff and of_nat_mult are no longer default simp rules * Method "algebra" solves polynomial equations over (semi)rings using Groebner bases. The (semi)ring structure is defined by locales and the tool setup depends on that generic context. Installing the method for a specific type involves instantiating the locale and possibly adding declarations for computation on the coefficients. The method is already instantiated for natural numbers and for the axiomatic class of idoms with numerals. See also the paper by Chaieb and Wenzel at CALCULEMUS 2007 for the general principles underlying this architecture of context-aware proof-tools. * Method "ferrack" implements quantifier elimination over special-purpose dense linear orders using locales (analogous to "algebra"). The method is already installed for class {ordered_field,recpower,number_ring} which subsumes real, hyperreal, rat, etc. * Former constant "List.op @" now named "List.append". Use ML antiquotations @{const_name List.append} or @{term " ... @ ... "} to circumvent possible incompatibilities when working on ML level. * primrec: missing cases mapped to "undefined" instead of "arbitrary". * New function listsum :: 'a list => 'a for arbitrary monoids. Special syntax: "SUM x <- xs. f x" (and latex variants) * New syntax for Haskell-like list comprehension (input only), eg. [(x,y). x <- xs, y <- ys, x ~= y], see also src/HOL/List.thy. * The special syntax for function "filter" has changed from [x : xs. P] to [x <- xs. P] to avoid an ambiguity caused by list comprehension syntax, and for uniformity. INCOMPATIBILITY. * [a..b] is now defined for arbitrary linear orders. It used to be defined on nat only, as an abbreviation for [a.. B" for equality on bool (with priority 25 like -->); output depends on the "iff" print_mode, the default is "A = B" (with priority 50). * Relations less (<) and less_eq (<=) are also available on type bool. Modified syntax to disallow nesting without explicit parentheses, e.g. "(x < y) < z" or "x < (y < z)", but NOT "x < y < z". Potential INCOMPATIBILITY. * "LEAST x:A. P" expands to "LEAST x. x:A & P" (input only). * Relation composition operator "op O" now has precedence 75 and binds stronger than union and intersection. INCOMPATIBILITY. * The old set interval syntax "{m..n(}" (and relatives) has been removed. Use "{m.. ==> False", equivalences (i.e. "=" on type bool) are handled, variable names of the form "lit_" are no longer reserved, significant speedup. * Methods "sat" and "satx" can now replay MiniSat proof traces. zChaff is still supported as well. * 'inductive' and 'datatype': provide projections of mutual rules, bundled as foo_bar.inducts; * Library: moved theories Parity, GCD, Binomial, Infinite_Set to Library. * Library: moved theory Accessible_Part to main HOL. * Library: added theory Coinductive_List of potentially infinite lists as greatest fixed-point. * Library: added theory AssocList which implements (finite) maps as association lists. * Method "evaluation" solves goals (i.e. a boolean expression) efficiently by compiling it to ML. The goal is "proved" (via an oracle) if it evaluates to True. * Linear arithmetic now splits certain operators (e.g. min, max, abs) also when invoked by the simplifier. This results in the Simplifier being more powerful on arithmetic goals. INCOMPATIBILITY. Configuration option fast_arith_split_limit=0 recovers the old behavior. * Support for hex (0x20) and binary (0b1001) numerals. * New method: reify eqs (t), where eqs are equations for an interpretation I :: 'a list => 'b => 'c and t::'c is an optional parameter, computes a term s::'b and a list xs::'a list and proves the theorem I xs s = t. This is also known as reification or quoting. The resulting theorem is applied to the subgoal to substitute t with I xs s. If t is omitted, the subgoal itself is reified. * New method: reflection corr_thm eqs (t). The parameters eqs and (t) are as explained above. corr_thm is a theorem for I vs (f t) = I vs t, where f is supposed to be a computable function (in the sense of code generattion). The method uses reify to compute s and xs as above then applies corr_thm and uses normalization by evaluation to "prove" f s = r and finally gets the theorem t = r, which is again applied to the subgoal. An Example is available in src/HOL/ex/ReflectionEx.thy. * Reflection: Automatic reification now handels binding, an example is available in src/HOL/ex/ReflectionEx.thy * HOL-Statespace: ``State Spaces: The Locale Way'' introduces a command 'statespace' that is similar to 'record', but introduces an abstract specification based on the locale infrastructure instead of HOL types. This leads to extra flexibility in composing state spaces, in particular multiple inheritance and renaming of components. *** HOL-Complex *** * Hyperreal: Functions root and sqrt are now defined on negative real inputs so that root n (- x) = - root n x and sqrt (- x) = - sqrt x. Nonnegativity side conditions have been removed from many lemmas, so that more subgoals may now be solved by simplification; potential INCOMPATIBILITY. * Real: new type classes formalize real normed vector spaces and algebras, using new overloaded constants scaleR :: real => 'a => 'a and norm :: 'a => real. * Real: constant of_real :: real => 'a::real_algebra_1 injects from reals into other types. The overloaded constant Reals :: 'a set is now defined as range of_real; potential INCOMPATIBILITY. * Real: proper support for ML code generation, including 'quickcheck'. Reals are implemented as arbitrary precision rationals. * Hyperreal: Several constants that previously worked only for the reals have been generalized, so they now work over arbitrary vector spaces. Type annotations may need to be added in some cases; potential INCOMPATIBILITY. Infinitesimal :: ('a::real_normed_vector) star set HFinite :: ('a::real_normed_vector) star set HInfinite :: ('a::real_normed_vector) star set approx :: ('a::real_normed_vector) star => 'a star => bool monad :: ('a::real_normed_vector) star => 'a star set galaxy :: ('a::real_normed_vector) star => 'a star set (NS)LIMSEQ :: [nat => 'a::real_normed_vector, 'a] => bool (NS)convergent :: (nat => 'a::real_normed_vector) => bool (NS)Bseq :: (nat => 'a::real_normed_vector) => bool (NS)Cauchy :: (nat => 'a::real_normed_vector) => bool (NS)LIM :: ['a::real_normed_vector => 'b::real_normed_vector, 'a, 'b] => bool is(NS)Cont :: ['a::real_normed_vector => 'b::real_normed_vector, 'a] => bool deriv :: ['a::real_normed_field => 'a, 'a, 'a] => bool sgn :: 'a::real_normed_vector => 'a exp :: 'a::{recpower,real_normed_field,banach} => 'a * Complex: Some complex-specific constants are now abbreviations for overloaded ones: complex_of_real = of_real, cmod = norm, hcmod = hnorm. Other constants have been entirely removed in favor of the polymorphic versions (INCOMPATIBILITY): approx <-- capprox HFinite <-- CFinite HInfinite <-- CInfinite Infinitesimal <-- CInfinitesimal monad <-- cmonad galaxy <-- cgalaxy (NS)LIM <-- (NS)CLIM, (NS)CRLIM is(NS)Cont <-- is(NS)Contc, is(NS)contCR (ns)deriv <-- (ns)cderiv *** HOL-Algebra *** * Formalisation of ideals and the quotient construction over rings. * Order and lattice theory no longer based on records. INCOMPATIBILITY. * Renamed lemmas least_carrier -> least_closed and greatest_carrier -> greatest_closed. INCOMPATIBILITY. * Method algebra is now set up via an attribute. For examples see Ring.thy. INCOMPATIBILITY: the method is now weaker on combinations of algebraic structures. * Renamed theory CRing to Ring. *** HOL-Nominal *** * Substantial, yet incomplete support for nominal datatypes (binding structures) based on HOL-Nominal logic. See src/HOL/Nominal and src/HOL/Nominal/Examples. Prospective users should consult http://isabelle.in.tum.de/nominal/ *** ML *** * ML basics: just one true type int, which coincides with IntInf.int (even on SML/NJ). * ML within Isar: antiquotations allow to embed statically-checked formal entities in the source, referring to the context available at compile-time. For example: ML {* @{sort "{zero,one}"} *} ML {* @{typ "'a => 'b"} *} ML {* @{term "%x. x"} *} ML {* @{prop "x == y"} *} ML {* @{ctyp "'a => 'b"} *} ML {* @{cterm "%x. x"} *} ML {* @{cprop "x == y"} *} ML {* @{thm asm_rl} *} ML {* @{thms asm_rl} *} ML {* @{type_name c} *} ML {* @{type_syntax c} *} ML {* @{const_name c} *} ML {* @{const_syntax c} *} ML {* @{context} *} ML {* @{theory} *} ML {* @{theory Pure} *} ML {* @{theory_ref} *} ML {* @{theory_ref Pure} *} ML {* @{simpset} *} ML {* @{claset} *} ML {* @{clasimpset} *} The same works for sources being ``used'' within an Isar context. * ML in Isar: improved error reporting; extra verbosity with ML_Context.trace enabled. * Pure/General/table.ML: the join operations now works via exceptions DUP/SAME instead of type option. This is simpler in simple cases, and admits slightly more efficient complex applications. * Pure: 'advanced' translation functions (parse_translation etc.) now use Context.generic instead of just theory. * Pure: datatype Context.generic joins theory/Proof.context and provides some facilities for code that works in either kind of context, notably GenericDataFun for uniform theory and proof data. * Pure: simplified internal attribute type, which is now always Context.generic * thm -> Context.generic * thm. Global (theory) vs. local (Proof.context) attributes have been discontinued, while minimizing code duplication. Thm.rule_attribute and Thm.declaration_attribute build canonical attributes; see also structure Context for further operations on Context.generic, notably GenericDataFun. INCOMPATIBILITY, need to adapt attribute type declarations and definitions. * Context data interfaces (Theory/Proof/GenericDataFun): removed name/print, uninitialized data defaults to ad-hoc copy of empty value, init only required for impure data. INCOMPATIBILITY: empty really need to be empty (no dependencies on theory content!) * Pure/kernel: consts certification ignores sort constraints given in signature declarations. (This information is not relevant to the logic, but only for type inference.) SIGNIFICANT INTERNAL CHANGE, potential INCOMPATIBILITY. * Pure: axiomatic type classes are now purely definitional, with explicit proofs of class axioms and super class relations performed internally. See Pure/axclass.ML for the main internal interfaces -- notably AxClass.define_class supercedes AxClass.add_axclass, and AxClass.axiomatize_class/classrel/arity supersede Sign.add_classes/classrel/arities. * Pure/Isar: Args/Attrib parsers operate on Context.generic -- global/local versions on theory vs. Proof.context have been discontinued; Attrib.syntax and Method.syntax have been adapted accordingly. INCOMPATIBILITY, need to adapt parser expressions for attributes, methods, etc. * Pure: several functions of signature "... -> theory -> theory * ..." have been reoriented to "... -> theory -> ... * theory" in order to allow natural usage in combination with the ||>, ||>>, |-> and fold_map combinators. * Pure: official theorem names (closed derivations) and additional comments (tags) are now strictly separate. Name hints -- which are maintained as tags -- may be attached any time without affecting the derivation. * Pure: primitive rule lift_rule now takes goal cterm instead of an actual goal state (thm). Use Thm.lift_rule (Thm.cprem_of st i) to achieve the old behaviour. * Pure: the "Goal" constant is now called "prop", supporting a slightly more general idea of ``protecting'' meta-level rule statements. * Pure: Logic.(un)varify only works in a global context, which is now enforced instead of silently assumed. INCOMPATIBILITY, may use Logic.legacy_(un)varify as temporary workaround. * Pure: structure Name provides scalable operations for generating internal variable names, notably Name.variants etc. This replaces some popular functions from term.ML: Term.variant -> Name.variant Term.variantlist -> Name.variant_list Term.invent_names -> Name.invent_list Note that low-level renaming rarely occurs in new code -- operations from structure Variable are used instead (see below). * Pure: structure Variable provides fundamental operations for proper treatment of fixed/schematic variables in a context. For example, Variable.import introduces fixes for schematics of given facts and Variable.export reverses the effect (up to renaming) -- this replaces various freeze_thaw operations. * Pure: structure Goal provides simple interfaces for init/conclude/finish and tactical prove operations (replacing former Tactic.prove). Goal.prove is the canonical way to prove results within a given context; Goal.prove_global is a degraded version for theory level goals, including a global Drule.standard. Note that OldGoals.prove_goalw_cterm has long been obsolete, since it is ill-behaved in a local proof context (e.g. with local fixes/assumes or in a locale context). * Pure/Syntax: generic interfaces for parsing (Syntax.parse_term etc.) and type checking (Syntax.check_term etc.), with common combinations (Syntax.read_term etc.). These supersede former Sign.read_term etc. which are considered legacy and await removal. * Pure/Syntax: generic interfaces for type unchecking (Syntax.uncheck_terms etc.) and unparsing (Syntax.unparse_term etc.), with common combinations (Syntax.pretty_term, Syntax.string_of_term etc.). Former Sign.pretty_term, Sign.string_of_term etc. are still available for convenience, but refer to the very same operations using a mere theory instead of a full context. * Isar: simplified treatment of user-level errors, using exception ERROR of string uniformly. Function error now merely raises ERROR, without any side effect on output channels. The Isar toplevel takes care of proper display of ERROR exceptions. ML code may use plain handle/can/try; cat_error may be used to concatenate errors like this: ... handle ERROR msg => cat_error msg "..." Toplevel ML code (run directly or through the Isar toplevel) may be embedded into the Isar toplevel with exception display/debug like this: Isar.toplevel (fn () => ...) INCOMPATIBILITY, removed special transform_error facilities, removed obsolete variants of user-level exceptions (ERROR_MESSAGE, Context.PROOF, ProofContext.CONTEXT, Proof.STATE, ProofHistory.FAIL) -- use plain ERROR instead. * Isar: theory setup now has type (theory -> theory), instead of a list. INCOMPATIBILITY, may use #> to compose setup functions. * Isar: ML toplevel pretty printer for type Proof.context, subject to ProofContext.debug/verbose flags. * Isar: Toplevel.theory_to_proof admits transactions that modify the theory before entering a proof state. Transactions now always see a quasi-functional intermediate checkpoint, both in interactive and batch mode. * Isar: simplified interfaces for outer syntax. Renamed OuterSyntax.add_keywords to OuterSyntax.keywords. Removed OuterSyntax.add_parsers -- this functionality is now included in OuterSyntax.command etc. INCOMPATIBILITY. * Simplifier: the simpset of a running simplification process now contains a proof context (cf. Simplifier.the_context), which is the very context that the initial simpset has been retrieved from (by simpset_of/local_simpset_of). Consequently, all plug-in components (solver, looper etc.) may depend on arbitrary proof data. * Simplifier.inherit_context inherits the proof context (plus the local bounds) of the current simplification process; any simproc etc. that calls the Simplifier recursively should do this! Removed former Simplifier.inherit_bounds, which is already included here -- INCOMPATIBILITY. Tools based on low-level rewriting may even have to specify an explicit context using Simplifier.context/theory_context. * Simplifier/Classical Reasoner: more abstract interfaces change_simpset/claset for modifying the simpset/claset reference of a theory; raw versions simpset/claset_ref etc. have been discontinued -- INCOMPATIBILITY. * Provers: more generic wrt. syntax of object-logics, avoid hardwired "Trueprop" etc. *** System *** * settings: the default heap location within ISABELLE_HOME_USER now includes ISABELLE_IDENTIFIER. This simplifies use of multiple Isabelle installations. * isabelle-process: option -S (secure mode) disables some critical operations, notably runtime compilation and evaluation of ML source code. * Basic Isabelle mode for jEdit, see Isabelle/lib/jedit/. * Support for parallel execution, using native multicore support of Poly/ML 5.1. The theory loader exploits parallelism when processing independent theories, according to the given theory header specifications. The maximum number of worker threads is specified via usedir option -M or the "max-threads" setting in Proof General. A speedup factor of 1.5--3.5 can be expected on a 4-core machine, and up to 6 on a 8-core machine. User-code needs to observe certain guidelines for thread-safe programming, see appendix A in the Isar Implementation manual. New in Isabelle2005 (October 2005) ---------------------------------- *** General *** * Theory headers: the new header syntax for Isar theories is theory imports ... uses ... begin where the 'uses' part is optional. The previous syntax theory = + ... + : will disappear in the next release. Use isatool fixheaders to convert existing theory files. Note that there is no change in ancient non-Isar theories now, but these will disappear soon. * Theory loader: parent theories can now also be referred to via relative and absolute paths. * Command 'find_theorems' searches for a list of criteria instead of a list of constants. Known criteria are: intro, elim, dest, name:string, simp:term, and any term. Criteria can be preceded by '-' to select theorems that do not match. Intro, elim, dest select theorems that match the current goal, name:s selects theorems whose fully qualified name contain s, and simp:term selects all simplification rules whose lhs match term. Any other term is interpreted as pattern and selects all theorems matching the pattern. Available in ProofGeneral under 'ProofGeneral -> Find Theorems' or C-c C-f. Example: C-c C-f (100) "(_::nat) + _ + _" intro -name: "HOL." prints the last 100 theorems matching the pattern "(_::nat) + _ + _", matching the current goal as introduction rule and not having "HOL." in their name (i.e. not being defined in theory HOL). * Command 'thms_containing' has been discontinued in favour of 'find_theorems'; INCOMPATIBILITY. * Communication with Proof General is now 8bit clean, which means that Unicode text in UTF-8 encoding may be used within theory texts (both formal and informal parts). Cf. option -U of the Isabelle Proof General interface. Here are some simple examples (cf. src/HOL/ex): http://isabelle.in.tum.de/library/HOL/ex/Hebrew.html http://isabelle.in.tum.de/library/HOL/ex/Chinese.html * Improved efficiency of the Simplifier and, to a lesser degree, the Classical Reasoner. Typical big applications run around 2 times faster. *** Document preparation *** * Commands 'display_drafts' and 'print_drafts' perform simple output of raw sources. Only those symbols that do not require additional LaTeX packages (depending on comments in isabellesym.sty) are displayed properly, everything else is left verbatim. isatool display and isatool print are used as front ends (these are subject to the DVI/PDF_VIEWER and PRINT_COMMAND settings, respectively). * Command tags control specific markup of certain regions of text, notably folding and hiding. Predefined tags include "theory" (for theory begin and end), "proof" for proof commands, and "ML" for commands involving ML code; the additional tags "visible" and "invisible" are unused by default. Users may give explicit tag specifications in the text, e.g. ''by %invisible (auto)''. The interpretation of tags is determined by the LaTeX job during document preparation: see option -V of isatool usedir, or options -n and -t of isatool document, or even the LaTeX macros \isakeeptag, \isafoldtag, \isadroptag. Several document versions may be produced at the same time via isatool usedir (the generated index.html will link all of them). Typical specifications include ''-V document=theory,proof,ML'' to present theory/proof/ML parts faithfully, ''-V outline=/proof,/ML'' to fold proof and ML commands, and ''-V mutilated=-theory,-proof,-ML'' to omit these parts without any formal replacement text. The Isabelle site default settings produce ''document'' and ''outline'' versions as specified above. * Several new antiquotations: @{term_type term} prints a term with its type annotated; @{typeof term} prints the type of a term; @{const const} is the same as @{term const}, but checks that the argument is a known logical constant; @{term_style style term} and @{thm_style style thm} print a term or theorem applying a "style" to it @{ML text} Predefined styles are 'lhs' and 'rhs' printing the lhs/rhs of definitions, equations, inequations etc., 'concl' printing only the conclusion of a meta-logical statement theorem, and 'prem1' .. 'prem19' to print the specified premise. TermStyle.add_style provides an ML interface for introducing further styles. See also the "LaTeX Sugar" document practical applications. The ML antiquotation prints type-checked ML expressions verbatim. * Markup commands 'chapter', 'section', 'subsection', 'subsubsection', and 'text' support optional locale specification '(in loc)', which specifies the default context for interpreting antiquotations. For example: 'text (in lattice) {* @{thm inf_assoc}*}'. * Option 'locale=NAME' of antiquotations specifies an alternative context interpreting the subsequent argument. For example: @{thm [locale=lattice] inf_assoc}. * Proper output of proof terms (@{prf ...} and @{full_prf ...}) within a proof context. * Proper output of antiquotations for theory commands involving a proof context (such as 'locale' or 'theorem (in loc) ...'). * Delimiters of outer tokens (string etc.) now produce separate LaTeX macros (\isachardoublequoteopen, isachardoublequoteclose etc.). * isatool usedir: new option -C (default true) controls whether option -D should include a copy of the original document directory; -C false prevents unwanted effects such as copying of administrative CVS data. *** Pure *** * Considerably improved version of 'constdefs' command. Now performs automatic type-inference of declared constants; additional support for local structure declarations (cf. locales and HOL records), see also isar-ref manual. Potential INCOMPATIBILITY: need to observe strictly sequential dependencies of definitions within a single 'constdefs' section; moreover, the declared name needs to be an identifier. If all fails, consider to fall back on 'consts' and 'defs' separately. * Improved indexed syntax and implicit structures. First of all, indexed syntax provides a notational device for subscripted application, using the new syntax \<^bsub>term\<^esub> for arbitrary expressions. Secondly, in a local context with structure declarations, number indexes \<^sub>n or the empty index (default number 1) refer to a certain fixed variable implicitly; option show_structs controls printing of implicit structures. Typical applications of these concepts involve record types and locales. * New command 'no_syntax' removes grammar declarations (and translations) resulting from the given syntax specification, which is interpreted in the same manner as for the 'syntax' command. * 'Advanced' translation functions (parse_translation etc.) may depend on the signature of the theory context being presently used for parsing/printing, see also isar-ref manual. * Improved 'oracle' command provides a type-safe interface to turn an ML expression of type theory -> T -> term into a primitive rule of type theory -> T -> thm (i.e. the functionality of Thm.invoke_oracle is already included here); see also FOL/ex/IffExample.thy; INCOMPATIBILITY. * axclass: name space prefix for class "c" is now "c_class" (was "c" before); "cI" is no longer bound, use "c.intro" instead. INCOMPATIBILITY. This change avoids clashes of fact bindings for axclasses vs. locales. * Improved internal renaming of symbolic identifiers -- attach primes instead of base 26 numbers. * New flag show_question_marks controls printing of leading question marks in schematic variable names. * In schematic variable names, *any* symbol following \<^isub> or \<^isup> is now treated as part of the base name. For example, the following works without printing of awkward ".0" indexes: lemma "x\<^isub>1 = x\<^isub>2 ==> x\<^isub>2 = x\<^isub>1" by simp * Inner syntax includes (*(*nested*) comments*). * Pretty printer now supports unbreakable blocks, specified in mixfix annotations as "(00...)". * Clear separation of logical types and nonterminals, where the latter may only occur in 'syntax' specifications or type abbreviations. Before that distinction was only partially implemented via type class "logic" vs. "{}". Potential INCOMPATIBILITY in rare cases of improper use of 'types'/'consts' instead of 'nonterminals'/'syntax'. Some very exotic syntax specifications may require further adaption (e.g. Cube/Cube.thy). * Removed obsolete type class "logic", use the top sort {} instead. Note that non-logical types should be declared as 'nonterminals' rather than 'types'. INCOMPATIBILITY for new object-logic specifications. * Attributes 'induct' and 'cases': type or set names may now be locally fixed variables as well. * Simplifier: can now control the depth to which conditional rewriting is traced via the PG menu Isabelle -> Settings -> Trace Simp Depth Limit. * Simplifier: simplification procedures may now take the current simpset into account (cf. Simplifier.simproc(_i) / mk_simproc interface), which is very useful for calling the Simplifier recursively. Minor INCOMPATIBILITY: the 'prems' argument of simprocs is gone -- use prems_of_ss on the simpset instead. Moreover, the low-level mk_simproc no longer applies Logic.varify internally, to allow for use in a context of fixed variables. * thin_tac now works even if the assumption being deleted contains !! or ==>. More generally, erule now works even if the major premise of the elimination rule contains !! or ==>. * Method 'rules' has been renamed to 'iprover'. INCOMPATIBILITY. * Reorganized bootstrapping of the Pure theories; CPure is now derived from Pure, which contains all common declarations already. Both theories are defined via plain Isabelle/Isar .thy files. INCOMPATIBILITY: elements of CPure (such as the CPure.intro / CPure.elim / CPure.dest attributes) now appear in the Pure name space; use isatool fixcpure to adapt your theory and ML sources. * New syntax 'name(i-j, i-, i, ...)' for referring to specific selections of theorems in named facts via index ranges. * 'print_theorems': in theory mode, really print the difference wrt. the last state (works for interactive theory development only), in proof mode print all local facts (cf. 'print_facts'); * 'hide': option '(open)' hides only base names. * More efficient treatment of intermediate checkpoints in interactive theory development. * Code generator is now invoked via code_module (incremental code generation) and code_library (modular code generation, ML structures for each theory). INCOMPATIBILITY: new keywords 'file' and 'contains' must be quoted when used as identifiers. * New 'value' command for reading, evaluating and printing terms using the code generator. INCOMPATIBILITY: command keyword 'value' must be quoted when used as identifier. *** Locales *** * New commands for the interpretation of locale expressions in theories (1), locales (2) and proof contexts (3). These generate proof obligations from the expression specification. After the obligations have been discharged, theorems of the expression are added to the theory, target locale or proof context. The synopsis of the commands is a follows: (1) interpretation expr inst (2) interpretation target < expr (3) interpret expr inst Interpretation in theories and proof contexts require a parameter instantiation of terms from the current context. This is applied to specifications and theorems of the interpreted expression. Interpretation in locales only permits parameter renaming through the locale expression. Interpretation is smart in that interpretations that are active already do not occur in proof obligations, neither are instantiated theorems stored in duplicate. Use 'print_interps' to inspect active interpretations of a particular locale. For details, see the Isar Reference manual. Examples can be found in HOL/Finite_Set.thy and HOL/Algebra/UnivPoly.thy. INCOMPATIBILITY: former 'instantiate' has been withdrawn, use 'interpret' instead. * New context element 'constrains' for adding type constraints to parameters. * Context expressions: renaming of parameters with syntax redeclaration. * Locale declaration: 'includes' disallowed. * Proper static binding of attribute syntax -- i.e. types / terms / facts mentioned as arguments are always those of the locale definition context, independently of the context of later invocations. Moreover, locale operations (renaming and type / term instantiation) are applied to attribute arguments as expected. INCOMPATIBILITY of the ML interface: always pass Attrib.src instead of actual attributes; rare situations may require Attrib.attribute to embed those attributes into Attrib.src that lack concrete syntax. Attribute implementations need to cooperate properly with the static binding mechanism. Basic parsers Args.XXX_typ/term/prop and Attrib.XXX_thm etc. already do the right thing without further intervention. Only unusual applications -- such as "where" or "of" (cf. src/Pure/Isar/attrib.ML), which process arguments depending both on the context and the facts involved -- may have to assign parsed values to argument tokens explicitly. * Changed parameter management in theorem generation for long goal statements with 'includes'. INCOMPATIBILITY: produces a different theorem statement in rare situations. * Locale inspection command 'print_locale' omits notes elements. Use 'print_locale!' to have them included in the output. *** Provers *** * Provers/hypsubst.ML: improved version of the subst method, for single-step rewriting: it now works in bound variable contexts. New is 'subst (asm)', for rewriting an assumption. INCOMPATIBILITY: may rewrite a different subterm than the original subst method, which is still available as 'simplesubst'. * Provers/quasi.ML: new transitivity reasoners for transitivity only and quasi orders. * Provers/trancl.ML: new transitivity reasoner for transitive and reflexive-transitive closure of relations. * Provers/blast.ML: new reference depth_limit to make blast's depth limit (previously hard-coded with a value of 20) user-definable. * Provers/simplifier.ML has been moved to Pure, where Simplifier.setup is peformed already. Object-logics merely need to finish their initial simpset configuration as before. INCOMPATIBILITY. *** HOL *** * Symbolic syntax of Hilbert Choice Operator is now as follows: syntax (epsilon) "_Eps" :: "[pttrn, bool] => 'a" ("(3\_./ _)" [0, 10] 10) The symbol \ is displayed as the alternative epsilon of LaTeX and x-symbol; use option '-m epsilon' to get it actually printed. Moreover, the mathematically important symbolic identifier \ becomes available as variable, constant etc. INCOMPATIBILITY, * "x > y" abbreviates "y < x" and "x >= y" abbreviates "y <= x". Similarly for all quantifiers: "ALL x > y" etc. The x-symbol for >= is \. New transitivity rules have been added to HOL/Orderings.thy to support corresponding Isar calculations. * "{x:A. P}" abbreviates "{x. x:A & P}", and similarly for "\" instead of ":". * theory SetInterval: changed the syntax for open intervals: Old New {..n(} {.. {\1<\.\.} \.\.\([^(}]*\)(} -> \.\.<\1} * Theory Commutative_Ring (in Library): method comm_ring for proving equalities in commutative rings; method 'algebra' provides a generic interface. * Theory Finite_Set: changed the syntax for 'setsum', summation over finite sets: "setsum (%x. e) A", which used to be "\x:A. e", is now either "SUM x:A. e" or "\x \ A. e". The bound variable can be a tuple pattern. Some new syntax forms are available: "\x | P. e" for "setsum (%x. e) {x. P}" "\x = a..b. e" for "setsum (%x. e) {a..b}" "\x = a..x < k. e" for "setsum (%x. e) {..x < k. e" used to be based on a separate function "Summation", which has been discontinued. * theory Finite_Set: in structured induction proofs, the insert case is now 'case (insert x F)' instead of the old counterintuitive 'case (insert F x)'. * The 'refute' command has been extended to support a much larger fragment of HOL, including axiomatic type classes, constdefs and typedefs, inductive datatypes and recursion. * New tactics 'sat' and 'satx' to prove propositional tautologies. Requires zChaff with proof generation to be installed. See HOL/ex/SAT_Examples.thy for examples. * Datatype induction via method 'induct' now preserves the name of the induction variable. For example, when proving P(xs::'a list) by induction on xs, the induction step is now P(xs) ==> P(a#xs) rather than P(list) ==> P(a#list) as previously. Potential INCOMPATIBILITY in unstructured proof scripts. * Reworked implementation of records. Improved scalability for records with many fields, avoiding performance problems for type inference. Records are no longer composed of nested field types, but of nested extension types. Therefore the record type only grows linear in the number of extensions and not in the number of fields. The top-level (users) view on records is preserved. Potential INCOMPATIBILITY only in strange cases, where the theory depends on the old record representation. The type generated for a record is called _ext_type. Flag record_quick_and_dirty_sensitive can be enabled to skip the proofs triggered by a record definition or a simproc (if quick_and_dirty is enabled). Definitions of large records can take quite long. New simproc record_upd_simproc for simplification of multiple record updates enabled by default. Moreover, trivial updates are also removed: r(|x := x r|) = r. INCOMPATIBILITY: old proofs break occasionally, since simplification is more powerful by default. * typedef: proper support for polymorphic sets, which contain extra type-variables in the term. * Simplifier: automatically reasons about transitivity chains involving "trancl" (r^+) and "rtrancl" (r^*) by setting up tactics provided by Provers/trancl.ML as additional solvers. INCOMPATIBILITY: old proofs break occasionally as simplification may now solve more goals than previously. * Simplifier: converts x <= y into x = y if assumption y <= x is present. Works for all partial orders (class "order"), in particular numbers and sets. For linear orders (e.g. numbers) it treats ~ x < y just like y <= x. * Simplifier: new simproc for "let x = a in f x". If a is a free or bound variable or a constant then the let is unfolded. Otherwise first a is simplified to b, and then f b is simplified to g. If possible we abstract b from g arriving at "let x = b in h x", otherwise we unfold the let and arrive at g. The simproc can be enabled/disabled by the reference use_let_simproc. Potential INCOMPATIBILITY since simplification is more powerful by default. * Classical reasoning: the meson method now accepts theorems as arguments. * Prover support: pre-release of the Isabelle-ATP linkup, which runs background jobs to provide advice on the provability of subgoals. * Theory OrderedGroup and Ring_and_Field: various additions and improvements to faciliate calculations involving equalities and inequalities. The following theorems have been eliminated or modified (INCOMPATIBILITY): abs_eq now named abs_of_nonneg abs_of_ge_0 now named abs_of_nonneg abs_minus_eq now named abs_of_nonpos imp_abs_id now named abs_of_nonneg imp_abs_neg_id now named abs_of_nonpos mult_pos now named mult_pos_pos mult_pos_le now named mult_nonneg_nonneg mult_pos_neg_le now named mult_nonneg_nonpos mult_pos_neg2_le now named mult_nonneg_nonpos2 mult_neg now named mult_neg_neg mult_neg_le now named mult_nonpos_nonpos * The following lemmas in Ring_and_Field have been added to the simplifier: zero_le_square not_square_less_zero The following lemmas have been deleted from Real/RealPow: realpow_zero_zero realpow_two realpow_less zero_le_power realpow_two_le abs_realpow_two realpow_two_abs * Theory Parity: added rules for simplifying exponents. * Theory List: The following theorems have been eliminated or modified (INCOMPATIBILITY): list_all_Nil now named list_all.simps(1) list_all_Cons now named list_all.simps(2) list_all_conv now named list_all_iff set_mem_eq now named mem_iff * Theories SetsAndFunctions and BigO (see HOL/Library) support asymptotic "big O" calculations. See the notes in BigO.thy. *** HOL-Complex *** * Theory RealDef: better support for embedding natural numbers and integers in the reals. The following theorems have been eliminated or modified (INCOMPATIBILITY): exp_ge_add_one_self now requires no hypotheses real_of_int_add reversed direction of equality (use [symmetric]) real_of_int_minus reversed direction of equality (use [symmetric]) real_of_int_diff reversed direction of equality (use [symmetric]) real_of_int_mult reversed direction of equality (use [symmetric]) * Theory RComplete: expanded support for floor and ceiling functions. * Theory Ln is new, with properties of the natural logarithm * Hyperreal: There is a new type constructor "star" for making nonstandard types. The old type names are now type synonyms: hypreal = real star hypnat = nat star hcomplex = complex star * Hyperreal: Many groups of similarly-defined constants have been replaced by polymorphic versions (INCOMPATIBILITY): star_of <-- hypreal_of_real, hypnat_of_nat, hcomplex_of_complex starset <-- starsetNat, starsetC *s* <-- *sNat*, *sc* starset_n <-- starsetNat_n, starsetC_n *sn* <-- *sNatn*, *scn* InternalSets <-- InternalNatSets, InternalCSets starfun <-- starfun{Nat,Nat2,C,RC,CR} *f* <-- *fNat*, *fNat2*, *fc*, *fRc*, *fcR* starfun_n <-- starfun{Nat,Nat2,C,RC,CR}_n *fn* <-- *fNatn*, *fNat2n*, *fcn*, *fRcn*, *fcRn* InternalFuns <-- InternalNatFuns, InternalNatFuns2, Internal{C,RC,CR}Funs * Hyperreal: Many type-specific theorems have been removed in favor of theorems specific to various axiomatic type classes (INCOMPATIBILITY): add_commute <-- {hypreal,hypnat,hcomplex}_add_commute add_assoc <-- {hypreal,hypnat,hcomplex}_add_assocs OrderedGroup.add_0 <-- {hypreal,hypnat,hcomplex}_add_zero_left OrderedGroup.add_0_right <-- {hypreal,hcomplex}_add_zero_right right_minus <-- hypreal_add_minus left_minus <-- {hypreal,hcomplex}_add_minus_left mult_commute <-- {hypreal,hypnat,hcomplex}_mult_commute mult_assoc <-- {hypreal,hypnat,hcomplex}_mult_assoc mult_1_left <-- {hypreal,hypnat}_mult_1, hcomplex_mult_one_left mult_1_right <-- hcomplex_mult_one_right mult_zero_left <-- hcomplex_mult_zero_left left_distrib <-- {hypreal,hypnat,hcomplex}_add_mult_distrib right_distrib <-- hypnat_add_mult_distrib2 zero_neq_one <-- {hypreal,hypnat,hcomplex}_zero_not_eq_one right_inverse <-- hypreal_mult_inverse left_inverse <-- hypreal_mult_inverse_left, hcomplex_mult_inv_left order_refl <-- {hypreal,hypnat}_le_refl order_trans <-- {hypreal,hypnat}_le_trans order_antisym <-- {hypreal,hypnat}_le_anti_sym order_less_le <-- {hypreal,hypnat}_less_le linorder_linear <-- {hypreal,hypnat}_le_linear add_left_mono <-- {hypreal,hypnat}_add_left_mono mult_strict_left_mono <-- {hypreal,hypnat}_mult_less_mono2 add_nonneg_nonneg <-- hypreal_le_add_order * Hyperreal: Separate theorems having to do with type-specific versions of constants have been merged into theorems that apply to the new polymorphic constants (INCOMPATIBILITY): STAR_UNIV_set <-- {STAR_real,NatStar_real,STARC_complex}_set STAR_empty_set <-- {STAR,NatStar,STARC}_empty_set STAR_Un <-- {STAR,NatStar,STARC}_Un STAR_Int <-- {STAR,NatStar,STARC}_Int STAR_Compl <-- {STAR,NatStar,STARC}_Compl STAR_subset <-- {STAR,NatStar,STARC}_subset STAR_mem <-- {STAR,NatStar,STARC}_mem STAR_mem_Compl <-- {STAR,STARC}_mem_Compl STAR_diff <-- {STAR,STARC}_diff STAR_star_of_image_subset <-- {STAR_hypreal_of_real, NatStar_hypreal_of_real, STARC_hcomplex_of_complex}_image_subset starset_n_Un <-- starset{Nat,C}_n_Un starset_n_Int <-- starset{Nat,C}_n_Int starset_n_Compl <-- starset{Nat,C}_n_Compl starset_n_diff <-- starset{Nat,C}_n_diff InternalSets_Un <-- Internal{Nat,C}Sets_Un InternalSets_Int <-- Internal{Nat,C}Sets_Int InternalSets_Compl <-- Internal{Nat,C}Sets_Compl InternalSets_diff <-- Internal{Nat,C}Sets_diff InternalSets_UNIV_diff <-- Internal{Nat,C}Sets_UNIV_diff InternalSets_starset_n <-- Internal{Nat,C}Sets_starset{Nat,C}_n starset_starset_n_eq <-- starset{Nat,C}_starset{Nat,C}_n_eq starset_n_starset <-- starset{Nat,C}_n_starset{Nat,C} starfun_n_starfun <-- starfun{Nat,Nat2,C,RC,CR}_n_starfun{Nat,Nat2,C,RC,CR} starfun <-- starfun{Nat,Nat2,C,RC,CR} starfun_mult <-- starfun{Nat,Nat2,C,RC,CR}_mult starfun_add <-- starfun{Nat,Nat2,C,RC,CR}_add starfun_minus <-- starfun{Nat,Nat2,C,RC,CR}_minus starfun_diff <-- starfun{C,RC,CR}_diff starfun_o <-- starfun{NatNat2,Nat2,_stafunNat,C,C_starfunRC,_starfunCR}_o starfun_o2 <-- starfun{NatNat2,_stafunNat,C,C_starfunRC,_starfunCR}_o2 starfun_const_fun <-- starfun{Nat,Nat2,C,RC,CR}_const_fun starfun_inverse <-- starfun{Nat,C,RC,CR}_inverse starfun_eq <-- starfun{Nat,Nat2,C,RC,CR}_eq starfun_eq_iff <-- starfun{C,RC,CR}_eq_iff starfun_Id <-- starfunC_Id starfun_approx <-- starfun{Nat,CR}_approx starfun_capprox <-- starfun{C,RC}_capprox starfun_abs <-- starfunNat_rabs starfun_lambda_cancel <-- starfun{C,CR,RC}_lambda_cancel starfun_lambda_cancel2 <-- starfun{C,CR,RC}_lambda_cancel2 starfun_mult_HFinite_approx <-- starfunCR_mult_HFinite_capprox starfun_mult_CFinite_capprox <-- starfun{C,RC}_mult_CFinite_capprox starfun_add_capprox <-- starfun{C,RC}_add_capprox starfun_add_approx <-- starfunCR_add_approx starfun_inverse_inverse <-- starfunC_inverse_inverse starfun_divide <-- starfun{C,CR,RC}_divide starfun_n <-- starfun{Nat,C}_n starfun_n_mult <-- starfun{Nat,C}_n_mult starfun_n_add <-- starfun{Nat,C}_n_add starfun_n_add_minus <-- starfunNat_n_add_minus starfun_n_const_fun <-- starfun{Nat,C}_n_const_fun starfun_n_minus <-- starfun{Nat,C}_n_minus starfun_n_eq <-- starfun{Nat,C}_n_eq star_n_add <-- {hypreal,hypnat,hcomplex}_add star_n_minus <-- {hypreal,hcomplex}_minus star_n_diff <-- {hypreal,hcomplex}_diff star_n_mult <-- {hypreal,hcomplex}_mult star_n_inverse <-- {hypreal,hcomplex}_inverse star_n_le <-- {hypreal,hypnat}_le star_n_less <-- {hypreal,hypnat}_less star_n_zero_num <-- {hypreal,hypnat,hcomplex}_zero_num star_n_one_num <-- {hypreal,hypnat,hcomplex}_one_num star_n_abs <-- hypreal_hrabs star_n_divide <-- hcomplex_divide star_of_add <-- {hypreal_of_real,hypnat_of_nat,hcomplex_of_complex}_add star_of_minus <-- {hypreal_of_real,hcomplex_of_complex}_minus star_of_diff <-- hypreal_of_real_diff star_of_mult <-- {hypreal_of_real,hypnat_of_nat,hcomplex_of_complex}_mult star_of_one <-- {hypreal_of_real,hcomplex_of_complex}_one star_of_zero <-- {hypreal_of_real,hypnat_of_nat,hcomplex_of_complex}_zero star_of_le <-- {hypreal_of_real,hypnat_of_nat}_le_iff star_of_less <-- {hypreal_of_real,hypnat_of_nat}_less_iff star_of_eq <-- {hypreal_of_real,hypnat_of_nat,hcomplex_of_complex}_eq_iff star_of_inverse <-- {hypreal_of_real,hcomplex_of_complex}_inverse star_of_divide <-- {hypreal_of_real,hcomplex_of_complex}_divide star_of_of_nat <-- {hypreal_of_real,hcomplex_of_complex}_of_nat star_of_of_int <-- {hypreal_of_real,hcomplex_of_complex}_of_int star_of_number_of <-- {hypreal,hcomplex}_number_of star_of_number_less <-- number_of_less_hypreal_of_real_iff star_of_number_le <-- number_of_le_hypreal_of_real_iff star_of_eq_number <-- hypreal_of_real_eq_number_of_iff star_of_less_number <-- hypreal_of_real_less_number_of_iff star_of_le_number <-- hypreal_of_real_le_number_of_iff star_of_power <-- hypreal_of_real_power star_of_eq_0 <-- hcomplex_of_complex_zero_iff * Hyperreal: new method "transfer" that implements the transfer principle of nonstandard analysis. With a subgoal that mentions nonstandard types like "'a star", the command "apply transfer" replaces it with an equivalent one that mentions only standard types. To be successful, all free variables must have standard types; non- standard variables must have explicit universal quantifiers. * Hyperreal: A theory of Taylor series. *** HOLCF *** * Discontinued special version of 'constdefs' (which used to support continuous functions) in favor of the general Pure one with full type-inference. * New simplification procedure for solving continuity conditions; it is much faster on terms with many nested lambda abstractions (cubic instead of exponential time). * New syntax for domain package: selector names are now optional. Parentheses should be omitted unless argument is lazy, for example: domain 'a stream = cons "'a" (lazy "'a stream") * New command 'fixrec' for defining recursive functions with pattern matching; defining multiple functions with mutual recursion is also supported. Patterns may include the constants cpair, spair, up, sinl, sinr, or any data constructor defined by the domain package. The given equations are proven as rewrite rules. See HOLCF/ex/Fixrec_ex.thy for syntax and examples. * New commands 'cpodef' and 'pcpodef' for defining predicate subtypes of cpo and pcpo types. Syntax is exactly like the 'typedef' command, but the proof obligation additionally includes an admissibility requirement. The packages generate instances of class cpo or pcpo, with continuity and strictness theorems for Rep and Abs. * HOLCF: Many theorems have been renamed according to a more standard naming scheme (INCOMPATIBILITY): foo_inject: "foo$x = foo$y ==> x = y" foo_eq: "(foo$x = foo$y) = (x = y)" foo_less: "(foo$x << foo$y) = (x << y)" foo_strict: "foo$UU = UU" foo_defined: "... ==> foo$x ~= UU" foo_defined_iff: "(foo$x = UU) = (x = UU)" *** ZF *** * ZF/ex: theories Group and Ring provide examples in abstract algebra, including the First Isomorphism Theorem (on quotienting by the kernel of a homomorphism). * ZF/Simplifier: install second copy of type solver that actually makes use of TC rules declared to Isar proof contexts (or locales); the old version is still required for ML proof scripts. *** Cube *** * Converted to Isar theory format; use locales instead of axiomatic theories. *** ML *** * Pure/library.ML: added ##>, ##>>, #>> -- higher-order counterparts for ||>, ||>>, |>>, * Pure/library.ML no longer defines its own option datatype, but uses that of the SML basis, which has constructors NONE and SOME instead of None and Some, as well as exception Option.Option instead of OPTION. The functions the, if_none, is_some, is_none have been adapted accordingly, while Option.map replaces apsome. * Pure/library.ML: the exception LIST has been given up in favour of the standard exceptions Empty and Subscript, as well as Library.UnequalLengths. Function like Library.hd and Library.tl are superceded by the standard hd and tl functions etc. A number of basic list functions are no longer exported to the ML toplevel, as they are variants of predefined functions. The following suggests how one can translate existing code: rev_append xs ys = List.revAppend (xs, ys) nth_elem (i, xs) = List.nth (xs, i) last_elem xs = List.last xs flat xss = List.concat xss seq fs = List.app fs partition P xs = List.partition P xs mapfilter f xs = List.mapPartial f xs * Pure/library.ML: several combinators for linear functional transformations, notably reverse application and composition: x |> f f #> g (x, y) |-> f f #-> g * Pure/library.ML: introduced/changed precedence of infix operators: infix 1 |> |-> ||> ||>> |>> |>>> #> #->; infix 2 ?; infix 3 o oo ooo oooo; infix 4 ~~ upto downto; Maybe INCOMPATIBILITY when any of those is used in conjunction with other infix operators. * Pure/library.ML: natural list combinators fold, fold_rev, and fold_map support linear functional transformations and nesting. For example: fold f [x1, ..., xN] y = y |> f x1 |> ... |> f xN (fold o fold) f [xs1, ..., xsN] y = y |> fold f xs1 |> ... |> fold f xsN fold f [x1, ..., xN] = f x1 #> ... #> f xN (fold o fold) f [xs1, ..., xsN] = fold f xs1 #> ... #> fold f xsN * Pure/library.ML: the following selectors on type 'a option are available: the: 'a option -> 'a (*partial*) these: 'a option -> 'a where 'a = 'b list the_default: 'a -> 'a option -> 'a the_list: 'a option -> 'a list * Pure/General: structure AList (cf. Pure/General/alist.ML) provides basic operations for association lists, following natural argument order; moreover the explicit equality predicate passed here avoids potentially expensive polymorphic runtime equality checks. The old functions may be expressed as follows: assoc = uncurry (AList.lookup (op =)) assocs = these oo AList.lookup (op =) overwrite = uncurry (AList.update (op =)) o swap * Pure/General: structure AList (cf. Pure/General/alist.ML) provides val make: ('a -> 'b) -> 'a list -> ('a * 'b) list val find: ('a * 'b -> bool) -> ('c * 'b) list -> 'a -> 'c list replacing make_keylist and keyfilter (occassionally used) Naive rewrites: make_keylist = AList.make keyfilter = AList.find (op =) * eq_fst and eq_snd now take explicit equality parameter, thus avoiding eqtypes. Naive rewrites: eq_fst = eq_fst (op =) eq_snd = eq_snd (op =) * Removed deprecated apl and apr (rarely used). Naive rewrites: apl (n, op) =>>= curry op n apr (op, m) =>>= fn n => op (n, m) * Pure/General: structure OrdList (cf. Pure/General/ord_list.ML) provides a reasonably efficient light-weight implementation of sets as lists. * Pure/General: generic tables (cf. Pure/General/table.ML) provide a few new operations; existing lookup and update are now curried to follow natural argument order (for use with fold etc.); INCOMPATIBILITY, use (uncurry Symtab.lookup) etc. as last resort. * Pure/General: output via the Isabelle channels of writeln/warning/error etc. is now passed through Output.output, with a hook for arbitrary transformations depending on the print_mode (cf. Output.add_mode -- the first active mode that provides a output function wins). Already formatted output may be embedded into further text via Output.raw; the result of Pretty.string_of/str_of and derived functions (string_of_term/cterm/thm etc.) is already marked raw to accommodate easy composition of diagnostic messages etc. Programmers rarely need to care about Output.output or Output.raw at all, with some notable exceptions: Output.output is required when bypassing the standard channels (writeln etc.), or in token translations to produce properly formatted results; Output.raw is required when capturing already output material that will eventually be presented to the user a second time. For the default print mode, both Output.output and Output.raw have no effect. * Pure/General: Output.time_accumulator NAME creates an operator ('a -> 'b) -> 'a -> 'b to measure runtime and count invocations; the cumulative results are displayed at the end of a batch session. * Pure/General: File.sysify_path and File.quote_sysify path have been replaced by File.platform_path and File.shell_path (with appropriate hooks). This provides a clean interface for unusual systems where the internal and external process view of file names are different. * Pure: more efficient orders for basic syntactic entities: added fast_string_ord, fast_indexname_ord, fast_term_ord; changed sort_ord and typ_ord to use fast_string_ord and fast_indexname_ord (term_ord is NOT affected); structures Symtab, Vartab, Typtab, Termtab use the fast orders now -- potential INCOMPATIBILITY for code that depends on a particular order for Symtab.keys, Symtab.dest, etc. (consider using Library.sort_strings on result). * Pure/term.ML: combinators fold_atyps, fold_aterms, fold_term_types, fold_types traverse types/terms from left to right, observing natural argument order. Supercedes previous foldl_XXX versions, add_frees, add_vars etc. have been adapted as well: INCOMPATIBILITY. * Pure: name spaces have been refined, with significant changes of the internal interfaces -- INCOMPATIBILITY. Renamed cond_extern(_table) to extern(_table). The plain name entry path is superceded by a general 'naming' context, which also includes the 'policy' to produce a fully qualified name and external accesses of a fully qualified name; NameSpace.extend is superceded by context dependent Sign.declare_name. Several theory and proof context operations modify the naming context. Especially note Theory.restore_naming and ProofContext.restore_naming to get back to a sane state; note that Theory.add_path is no longer sufficient to recover from Theory.absolute_path in particular. * Pure: new flags short_names (default false) and unique_names (default true) for controlling output of qualified names. If short_names is set, names are printed unqualified. If unique_names is reset, the name prefix is reduced to the minimum required to achieve the original result when interning again, even if there is an overlap with earlier declarations. * Pure/TheoryDataFun: change of the argument structure; 'prep_ext' is now 'extend', and 'merge' gets an additional Pretty.pp argument (useful for printing error messages). INCOMPATIBILITY. * Pure: major reorganization of the theory context. Type Sign.sg and Theory.theory are now identified, referring to the universal Context.theory (see Pure/context.ML). Actual signature and theory content is managed as theory data. The old code and interfaces were spread over many files and structures; the new arrangement introduces considerable INCOMPATIBILITY to gain more clarity: Context -- theory management operations (name, identity, inclusion, parents, ancestors, merge, etc.), plus generic theory data; Sign -- logical signature and syntax operations (declaring consts, types, etc.), plus certify/read for common entities; Theory -- logical theory operations (stating axioms, definitions, oracles), plus a copy of logical signature operations (consts, types, etc.); also a few basic management operations (Theory.copy, Theory.merge, etc.) The most basic sign_of operations (Theory.sign_of, Thm.sign_of_thm etc.) as well as the sign field in Thm.rep_thm etc. have been retained for convenience -- they merely return the theory. * Pure: type Type.tsig is superceded by theory in most interfaces. * Pure: the Isar proof context type is already defined early in Pure as Context.proof (note that ProofContext.context and Proof.context are aliases, where the latter is the preferred name). This enables other Isabelle components to refer to that type even before Isar is present. * Pure/sign/theory: discontinued named name spaces (i.e. classK, typeK, constK, axiomK, oracleK), but provide explicit operations for any of these kinds. For example, Sign.intern typeK is now Sign.intern_type, Theory.hide_space Sign.typeK is now Theory.hide_types. Also note that former Theory.hide_classes/types/consts are now Theory.hide_classes_i/types_i/consts_i, while the non '_i' versions internalize their arguments! INCOMPATIBILITY. * Pure: get_thm interface (of PureThy and ProofContext) expects datatype thmref (with constructors Name and NameSelection) instead of plain string -- INCOMPATIBILITY; * Pure: cases produced by proof methods specify options, where NONE means to remove case bindings -- INCOMPATIBILITY in (RAW_)METHOD_CASES. * Pure: the following operations retrieve axioms or theorems from a theory node or theory hierarchy, respectively: Theory.axioms_of: theory -> (string * term) list Theory.all_axioms_of: theory -> (string * term) list PureThy.thms_of: theory -> (string * thm) list PureThy.all_thms_of: theory -> (string * thm) list * Pure: print_tac now outputs the goal through the trace channel. * Isar toplevel: improved diagnostics, mostly for Poly/ML only. Reference Toplevel.debug (default false) controls detailed printing and tracing of low-level exceptions; Toplevel.profiling (default 0) controls execution profiling -- set to 1 for time and 2 for space (both increase the runtime). * Isar session: The initial use of ROOT.ML is now always timed, i.e. the log will show the actual process times, in contrast to the elapsed wall-clock time that the outer shell wrapper produces. * Simplifier: improved handling of bound variables (nameless representation, avoid allocating new strings). Simprocs that invoke the Simplifier recursively should use Simplifier.inherit_bounds to avoid local name clashes. Failure to do so produces warnings "Simplifier: renamed bound variable ..."; set Simplifier.debug_bounds for further details. * ML functions legacy_bindings and use_legacy_bindings produce ML fact bindings for all theorems stored within a given theory; this may help in porting non-Isar theories to Isar ones, while keeping ML proof scripts for the time being. * ML operator HTML.with_charset specifies the charset begin used for generated HTML files. For example: HTML.with_charset "utf-8" use_thy "Hebrew"; HTML.with_charset "utf-8" use_thy "Chinese"; *** System *** * Allow symlinks to all proper Isabelle executables (Isabelle, isabelle, isatool etc.). * ISABELLE_DOC_FORMAT setting specifies preferred document format (for isatool doc, isatool mkdir, display_drafts etc.). * isatool usedir: option -f allows specification of the ML file to be used by Isabelle; default is ROOT.ML. * New isatool version outputs the version identifier of the Isabelle distribution being used. * HOL: new isatool dimacs2hol converts files in DIMACS CNF format (containing Boolean satisfiability problems) into Isabelle/HOL theories. New in Isabelle2004 (April 2004) -------------------------------- *** General *** * Provers/order.ML: new efficient reasoner for partial and linear orders. Replaces linorder.ML. * Pure: Greek letters (except small lambda, \), as well as Gothic (\...\\...\), calligraphic (\...\), and Euler (\...\), are now considered normal letters, and can therefore be used anywhere where an ASCII letter (a...zA...Z) has until now. COMPATIBILITY: This obviously changes the parsing of some terms, especially where a symbol has been used as a binder, say '\x. ...', which is now a type error since \x will be parsed as an identifier. Fix it by inserting a space around former symbols. Call 'isatool fixgreek' to try to fix parsing errors in existing theory and ML files. * Pure: Macintosh and Windows line-breaks are now allowed in theory files. * Pure: single letter sub/superscripts (\<^isub> and \<^isup>) are now allowed in identifiers. Similar to Greek letters \<^isub> is now considered a normal (but invisible) letter. For multiple letter subscripts repeat \<^isub> like this: x\<^isub>1\<^isub>2. * Pure: There are now sub-/superscripts that can span more than one character. Text between \<^bsub> and \<^esub> is set in subscript in ProofGeneral and LaTeX, text between \<^bsup> and \<^esup> in superscript. The new control characters are not identifier parts. * Pure: Control-symbols of the form \<^raw:...> will literally print the content of "..." to the latex file instead of \isacntrl... . The "..." may consist of any printable characters excluding the end bracket >. * Pure: Using new Isar command "finalconsts" (or the ML functions Theory.add_finals or Theory.add_finals_i) it is now possible to declare constants "final", which prevents their being given a definition later. It is useful for constants whose behaviour is fixed axiomatically rather than definitionally, such as the meta-logic connectives. * Pure: 'instance' now handles general arities with general sorts (i.e. intersections of classes), * Presentation: generated HTML now uses a CSS style sheet to make layout (somewhat) independent of content. It is copied from lib/html/isabelle.css. It can be changed to alter the colors/layout of generated pages. *** Isar *** * Tactic emulation methods rule_tac, erule_tac, drule_tac, frule_tac, cut_tac, subgoal_tac and thin_tac: - Now understand static (Isar) contexts. As a consequence, users of Isar locales are no longer forced to write Isar proof scripts. For details see Isar Reference Manual, paragraph 4.3.2: Further tactic emulations. - INCOMPATIBILITY: names of variables to be instantiated may no longer be enclosed in quotes. Instead, precede variable name with `?'. This is consistent with the instantiation attribute "where". * Attributes "where" and "of": - Now take type variables of instantiated theorem into account when reading the instantiation string. This fixes a bug that caused instantiated theorems to have too special types in some circumstances. - "where" permits explicit instantiations of type variables. * Calculation commands "moreover" and "also" no longer interfere with current facts ("this"), admitting arbitrary combinations with "then" and derived forms. * Locales: - Goal statements involving the context element "includes" no longer generate theorems with internal delta predicates (those ending on "_axioms") in the premise. Resolve particular premise with .intro to obtain old form. - Fixed bug in type inference ("unify_frozen") that prevented mix of target specification and "includes" elements in goal statement. - Rule sets .intro and .axioms no longer declared as [intro?] and [elim?] (respectively) by default. - Experimental command for instantiation of locales in proof contexts: instantiate ); X \ \; Y \ \\ \ disjnt (f ` X) (f ` Y) \ disjnt X Y" apply (auto simp: disjnt_def) using inj_on_eq_iff by fastforce lemma disjnt_Union1 [simp]: "disjnt (\\) B \ (\A \ \. disjnt A B)" by (auto simp: disjnt_def) lemma disjnt_Union2 [simp]: "disjnt B (\\) \ (\A \ \. disjnt B A)" by (auto simp: disjnt_def) subsubsection \Unions of families\ syntax (ASCII) "_UNION1" :: "pttrns => 'b set => 'b set" ("(3UN _./ _)" [0, 10] 10) "_UNION" :: "pttrn => 'a set => 'b set => 'b set" ("(3UN _:_./ _)" [0, 0, 10] 10) syntax "_UNION1" :: "pttrns => 'b set => 'b set" ("(3\_./ _)" [0, 10] 10) "_UNION" :: "pttrn => 'a set => 'b set => 'b set" ("(3\_\_./ _)" [0, 0, 10] 10) syntax (latex output) "_UNION1" :: "pttrns => 'b set => 'b set" ("(3\(\unbreakable\\<^bsub>_\<^esub>)/ _)" [0, 10] 10) "_UNION" :: "pttrn => 'a set => 'b set => 'b set" ("(3\(\unbreakable\\<^bsub>_\_\<^esub>)/ _)" [0, 0, 10] 10) translations "\x y. f" \ "\x. \y. f" "\x. f" \ "\(CONST range (\x. f))" "\x\A. f" \ "CONST Union ((\x. f) ` A)" text \ Note the difference between ordinary syntax of indexed unions and intersections (e.g.\ \\a\<^sub>1\A\<^sub>1. B\) and their \LaTeX\ rendition: \<^term>\\a\<^sub>1\A\<^sub>1. B\. \ lemma disjoint_UN_iff: "disjnt A (\i\I. B i) \ (\i\I. disjnt A (B i))" by (auto simp: disjnt_def) lemma UNION_eq: "(\x\A. B x) = {y. \x\A. y \ B x}" by (auto intro!: SUP_eqI) lemma bind_UNION [code]: "Set.bind A f = \(f ` A)" by (simp add: bind_def UNION_eq) lemma member_bind [simp]: "x \ Set.bind A f \ x \ \(f ` A)" by (simp add: bind_UNION) lemma Union_SetCompr_eq: "\{f x| x. P x} = {a. \x. P x \ a \ f x}" by blast lemma UN_iff [simp]: "b \ (\x\A. B x) \ (\x\A. b \ B x)" using Union_iff [of _ "B ` A"] by simp lemma UN_I [intro]: "a \ A \ b \ B a \ b \ (\x\A. B x)" \ \The order of the premises presupposes that \<^term>\A\ is rigid; \<^term>\b\ may be flexible.\ by auto lemma UN_E [elim!]: "b \ (\x\A. B x) \ (\x. x\A \ b \ B x \ R) \ R" by auto lemma UN_upper: "a \ A \ B a \ (\x\A. B x)" by (fact SUP_upper) lemma UN_least: "(\x. x \ A \ B x \ C) \ (\x\A. B x) \ C" by (fact SUP_least) lemma Collect_bex_eq: "{x. \y\A. P x y} = (\y\A. {x. P x y})" by blast lemma UN_insert_distrib: "u \ A \ (\x\A. insert a (B x)) = insert a (\x\A. B x)" by blast lemma UN_empty: "(\x\{}. B x) = {}" by (fact SUP_empty) lemma UN_empty2: "(\x\A. {}) = {}" by (fact SUP_bot) (* already simp *) lemma UN_absorb: "k \ I \ A k \ (\i\I. A i) = (\i\I. A i)" by (fact SUP_absorb) lemma UN_insert [simp]: "(\x\insert a A. B x) = B a \ \(B ` A)" by (fact SUP_insert) lemma UN_Un [simp]: "(\i \ A \ B. M i) = (\i\A. M i) \ (\i\B. M i)" by (fact SUP_union) lemma UN_UN_flatten: "(\x \ (\y\A. B y). C x) = (\y\A. \x\B y. C x)" by blast lemma UN_subset_iff: "((\i\I. A i) \ B) = (\i\I. A i \ B)" by (fact SUP_le_iff) lemma UN_constant [simp]: "(\y\A. c) = (if A = {} then {} else c)" by (fact SUP_constant) lemma UNION_singleton_eq_range: "(\x\A. {f x}) = f ` A" by blast lemma image_Union: "f ` \S = (\x\S. f ` x)" by blast lemma UNION_empty_conv: "{} = (\x\A. B x) \ (\x\A. B x = {})" "(\x\A. B x) = {} \ (\x\A. B x = {})" by (fact SUP_bot_conv)+ (* already simp *) lemma Collect_ex_eq: "{x. \y. P x y} = (\y. {x. P x y})" by blast lemma ball_UN: "(\z \ \(B ` A). P z) \ (\x\A. \z \ B x. P z)" by blast lemma bex_UN: "(\z \ \(B ` A). P z) \ (\x\A. \z\B x. P z)" by blast lemma Un_eq_UN: "A \ B = (\b. if b then A else B)" by safe (auto simp add: if_split_mem2) lemma UN_bool_eq: "(\b. A b) = (A True \ A False)" by (fact SUP_UNIV_bool_expand) lemma UN_Pow_subset: "(\x\A. Pow (B x)) \ Pow (\x\A. B x)" by blast lemma UN_mono: "A \ B \ (\x. x \ A \ f x \ g x) \ (\x\A. f x) \ (\x\B. g x)" by (fact SUP_subset_mono) lemma vimage_Union: "f -` (\A) = (\X\A. f -` X)" by blast lemma vimage_UN: "f -` (\x\A. B x) = (\x\A. f -` B x)" by blast lemma vimage_eq_UN: "f -` B = (\y\B. f -` {y})" \ \NOT suitable for rewriting\ by blast lemma image_UN: "f ` \(B ` A) = (\x\A. f ` B x)" by blast lemma UN_singleton [simp]: "(\x\A. {x}) = A" by blast lemma inj_on_image: "inj_on f (\A) \ inj_on ((`) f) A" unfolding inj_on_def by blast subsubsection \Distributive laws\ lemma Int_Union: "A \ \B = (\C\B. A \ C)" by blast lemma Un_Inter: "A \ \B = (\C\B. A \ C)" by blast lemma Int_Union2: "\B \ A = (\C\B. C \ A)" by blast lemma INT_Int_distrib: "(\i\I. A i \ B i) = (\i\I. A i) \ (\i\I. B i)" by (rule sym) (rule INF_inf_distrib) lemma UN_Un_distrib: "(\i\I. A i \ B i) = (\i\I. A i) \ (\i\I. B i)" by (rule sym) (rule SUP_sup_distrib) lemma Int_Inter_image: "(\x\C. A x \ B x) = \(A ` C) \ \(B ` C)" (* FIXME drop *) by (simp add: INT_Int_distrib) lemma Int_Inter_eq: "A \ \\ = (if \={} then A else (\B\\. A \ B))" "\\ \ A = (if \={} then A else (\B\\. B \ A))" by auto lemma Un_Union_image: "(\x\C. A x \ B x) = \(A ` C) \ \(B ` C)" (* FIXME drop *) \ \Devlin, Fundamentals of Contemporary Set Theory, page 12, exercise 5:\ \ \Union of a family of unions\ by (simp add: UN_Un_distrib) lemma Un_INT_distrib: "B \ (\i\I. A i) = (\i\I. B \ A i)" by blast lemma Int_UN_distrib: "B \ (\i\I. A i) = (\i\I. B \ A i)" \ \Halmos, Naive Set Theory, page 35.\ by blast lemma Int_UN_distrib2: "(\i\I. A i) \ (\j\J. B j) = (\i\I. \j\J. A i \ B j)" by blast lemma Un_INT_distrib2: "(\i\I. A i) \ (\j\J. B j) = (\i\I. \j\J. A i \ B j)" by blast lemma Union_disjoint: "(\C \ A = {}) \ (\B\C. B \ A = {})" by blast lemma SUP_UNION: "(\x\(\y\A. g y). f x) = (\y\A. \x\g y. f x :: _ :: complete_lattice)" by (rule order_antisym) (blast intro: SUP_least SUP_upper2)+ subsection \Injections and bijections\ lemma inj_on_Inter: "S \ {} \ (\A. A \ S \ inj_on f A) \ inj_on f (\S)" unfolding inj_on_def by blast lemma inj_on_INTER: "I \ {} \ (\i. i \ I \ inj_on f (A i)) \ inj_on f (\i \ I. A i)" unfolding inj_on_def by safe simp lemma inj_on_UNION_chain: assumes chain: "\i j. i \ I \ j \ I \ A i \ A j \ A j \ A i" and inj: "\i. i \ I \ inj_on f (A i)" shows "inj_on f (\i \ I. A i)" proof - have "x = y" if *: "i \ I" "j \ I" and **: "x \ A i" "y \ A j" and ***: "f x = f y" for i j x y using chain [OF *] proof assume "A i \ A j" with ** have "x \ A j" by auto with inj * ** *** show ?thesis by (auto simp add: inj_on_def) next assume "A j \ A i" with ** have "y \ A i" by auto with inj * ** *** show ?thesis by (auto simp add: inj_on_def) qed then show ?thesis by (unfold inj_on_def UNION_eq) auto qed lemma bij_betw_UNION_chain: assumes chain: "\i j. i \ I \ j \ I \ A i \ A j \ A j \ A i" and bij: "\i. i \ I \ bij_betw f (A i) (A' i)" shows "bij_betw f (\i \ I. A i) (\i \ I. A' i)" unfolding bij_betw_def proof safe have "\i. i \ I \ inj_on f (A i)" using bij bij_betw_def[of f] by auto then show "inj_on f (\(A ` I))" using chain inj_on_UNION_chain[of I A f] by auto next fix i x assume *: "i \ I" "x \ A i" with bij have "f x \ A' i" by (auto simp: bij_betw_def) with * show "f x \ \(A' ` I)" by blast next fix i x' assume *: "i \ I" "x' \ A' i" with bij have "\x \ A i. x' = f x" unfolding bij_betw_def by blast with * have "\j \ I. \x \ A j. x' = f x" by blast then show "x' \ f ` \(A ` I)" by blast qed (*injectivity's required. Left-to-right inclusion holds even if A is empty*) lemma image_INT: "inj_on f C \ \x\A. B x \ C \ j \ A \ f ` (\(B ` A)) = (\x\A. f ` B x)" by (auto simp add: inj_on_def) blast lemma bij_image_INT: "bij f \ f ` (\(B ` A)) = (\x\A. f ` B x)" by (auto simp: bij_def inj_def surj_def) blast lemma UNION_fun_upd: "\(A(i := B) ` J) = \(A ` (J - {i})) \ (if i \ J then B else {})" by (auto simp add: set_eq_iff) lemma bij_betw_Pow: assumes "bij_betw f A B" shows "bij_betw (image f) (Pow A) (Pow B)" proof - from assms have "inj_on f A" by (rule bij_betw_imp_inj_on) then have "inj_on f (\(Pow A))" by simp then have "inj_on (image f) (Pow A)" by (rule inj_on_image) then have "bij_betw (image f) (Pow A) (image f ` Pow A)" by (rule inj_on_imp_bij_betw) moreover from assms have "f ` A = B" by (rule bij_betw_imp_surj_on) then have "image f ` Pow A = Pow B" by (rule image_Pow_surj) ultimately show ?thesis by simp qed subsubsection \Complement\ lemma Compl_INT [simp]: "- (\x\A. B x) = (\x\A. -B x)" by blast lemma Compl_UN [simp]: "- (\x\A. B x) = (\x\A. -B x)" by blast subsubsection \Miniscoping and maxiscoping\ text \\<^medskip> Miniscoping: pushing in quantifiers and big Unions and Intersections.\ lemma UN_simps [simp]: "\a B C. (\x\C. insert a (B x)) = (if C={} then {} else insert a (\x\C. B x))" "\A B C. (\x\C. A x \ B) = ((if C={} then {} else (\x\C. A x) \ B))" "\A B C. (\x\C. A \ B x) = ((if C={} then {} else A \ (\x\C. B x)))" "\A B C. (\x\C. A x \ B) = ((\x\C. A x) \ B)" "\A B C. (\x\C. A \ B x) = (A \(\x\C. B x))" "\A B C. (\x\C. A x - B) = ((\x\C. A x) - B)" "\A B C. (\x\C. A - B x) = (A - (\x\C. B x))" "\A B. (\x\\A. B x) = (\y\A. \x\y. B x)" "\A B C. (\z\(\(B ` A)). C z) = (\x\A. \z\B x. C z)" "\A B f. (\x\f`A. B x) = (\a\A. B (f a))" by auto lemma INT_simps [simp]: "\A B C. (\x\C. A x \ B) = (if C={} then UNIV else (\x\C. A x) \ B)" "\A B C. (\x\C. A \ B x) = (if C={} then UNIV else A \(\x\C. B x))" "\A B C. (\x\C. A x - B) = (if C={} then UNIV else (\x\C. A x) - B)" "\A B C. (\x\C. A - B x) = (if C={} then UNIV else A - (\x\C. B x))" "\a B C. (\x\C. insert a (B x)) = insert a (\x\C. B x)" "\A B C. (\x\C. A x \ B) = ((\x\C. A x) \ B)" "\A B C. (\x\C. A \ B x) = (A \ (\x\C. B x))" "\A B. (\x\\A. B x) = (\y\A. \x\y. B x)" "\A B C. (\z\(\(B ` A)). C z) = (\x\A. \z\B x. C z)" "\A B f. (\x\f`A. B x) = (\a\A. B (f a))" by auto lemma UN_ball_bex_simps [simp]: "\A P. (\x\\A. P x) \ (\y\A. \x\y. P x)" "\A B P. (\x\(\(B ` A)). P x) = (\a\A. \x\ B a. P x)" "\A P. (\x\\A. P x) \ (\y\A. \x\y. P x)" "\A B P. (\x\(\(B ` A)). P x) \ (\a\A. \x\B a. P x)" by auto text \\<^medskip> Maxiscoping: pulling out big Unions and Intersections.\ lemma UN_extend_simps: "\a B C. insert a (\x\C. B x) = (if C={} then {a} else (\x\C. insert a (B x)))" "\A B C. (\x\C. A x) \ B = (if C={} then B else (\x\C. A x \ B))" "\A B C. A \ (\x\C. B x) = (if C={} then A else (\x\C. A \ B x))" "\A B C. ((\x\C. A x) \ B) = (\x\C. A x \ B)" "\A B C. (A \ (\x\C. B x)) = (\x\C. A \ B x)" "\A B C. ((\x\C. A x) - B) = (\x\C. A x - B)" "\A B C. (A - (\x\C. B x)) = (\x\C. A - B x)" "\A B. (\y\A. \x\y. B x) = (\x\\A. B x)" "\A B C. (\x\A. \z\B x. C z) = (\z\(\(B ` A)). C z)" "\A B f. (\a\A. B (f a)) = (\x\f`A. B x)" by auto lemma INT_extend_simps: "\A B C. (\x\C. A x) \ B = (if C={} then B else (\x\C. A x \ B))" "\A B C. A \ (\x\C. B x) = (if C={} then A else (\x\C. A \ B x))" "\A B C. (\x\C. A x) - B = (if C={} then UNIV - B else (\x\C. A x - B))" "\A B C. A - (\x\C. B x) = (if C={} then A else (\x\C. A - B x))" "\a B C. insert a (\x\C. B x) = (\x\C. insert a (B x))" "\A B C. ((\x\C. A x) \ B) = (\x\C. A x \ B)" "\A B C. A \ (\x\C. B x) = (\x\C. A \ B x)" "\A B. (\y\A. \x\y. B x) = (\x\\A. B x)" "\A B C. (\x\A. \z\B x. C z) = (\z\(\(B ` A)). C z)" "\A B f. (\a\A. B (f a)) = (\x\f`A. B x)" by auto text \Finally\ lemmas mem_simps = insert_iff empty_iff Un_iff Int_iff Compl_iff Diff_iff mem_Collect_eq UN_iff Union_iff INT_iff Inter_iff \ \Each of these has ALREADY been added \[simp]\ above.\ end diff --git a/src/HOL/Complete_Partial_Order.thy b/src/HOL/Complete_Partial_Order.thy --- a/src/HOL/Complete_Partial_Order.thy +++ b/src/HOL/Complete_Partial_Order.thy @@ -1,372 +1,372 @@ (* Title: HOL/Complete_Partial_Order.thy Author: Brian Huffman, Portland State University Author: Alexander Krauss, TU Muenchen *) section \Chain-complete partial orders and their fixpoints\ theory Complete_Partial_Order imports Product_Type begin subsection \Monotone functions\ text \Dictionary-passing version of \<^const>\Orderings.mono\.\ definition monotone :: "('a \ 'a \ bool) \ ('b \ 'b \ bool) \ ('a \ 'b) \ bool" where "monotone orda ordb f \ (\x y. orda x y \ ordb (f x) (f y))" lemma monotoneI[intro?]: "(\x y. orda x y \ ordb (f x) (f y)) \ monotone orda ordb f" unfolding monotone_def by iprover lemma monotoneD[dest?]: "monotone orda ordb f \ orda x y \ ordb (f x) (f y)" unfolding monotone_def by iprover subsection \Chains\ text \ A chain is a totally-ordered set. Chains are parameterized over the order for maximal flexibility, since type classes are not enough. \ definition chain :: "('a \ 'a \ bool) \ 'a set \ bool" where "chain ord S \ (\x\S. \y\S. ord x y \ ord y x)" lemma chainI: assumes "\x y. x \ S \ y \ S \ ord x y \ ord y x" shows "chain ord S" using assms unfolding chain_def by fast lemma chainD: assumes "chain ord S" and "x \ S" and "y \ S" shows "ord x y \ ord y x" using assms unfolding chain_def by fast lemma chainE: assumes "chain ord S" and "x \ S" and "y \ S" obtains "ord x y" | "ord y x" using assms unfolding chain_def by fast lemma chain_empty: "chain ord {}" by (simp add: chain_def) lemma chain_equality: "chain (=) A \ (\x\A. \y\A. x = y)" by (auto simp add: chain_def) lemma chain_subset: "chain ord A \ B \ A \ chain ord B" by (rule chainI) (blast dest: chainD) lemma chain_imageI: assumes chain: "chain le_a Y" and mono: "\x y. x \ Y \ y \ Y \ le_a x y \ le_b (f x) (f y)" shows "chain le_b (f ` Y)" by (blast intro: chainI dest: chainD[OF chain] mono) subsection \Chain-complete partial orders\ text \ A \ccpo\ has a least upper bound for any chain. In particular, the empty set is a chain, so every \ccpo\ must have a bottom element. \ class ccpo = order + Sup + assumes ccpo_Sup_upper: "chain (\) A \ x \ A \ x \ Sup A" assumes ccpo_Sup_least: "chain (\) A \ (\x. x \ A \ x \ z) \ Sup A \ z" begin lemma chain_singleton: "Complete_Partial_Order.chain (\) {x}" by (rule chainI) simp lemma ccpo_Sup_singleton [simp]: "\{x} = x" - by (rule antisym) (auto intro: ccpo_Sup_least ccpo_Sup_upper simp add: chain_singleton) + by (rule order.antisym) (auto intro: ccpo_Sup_least ccpo_Sup_upper simp add: chain_singleton) subsection \Transfinite iteration of a function\ context notes [[inductive_internals]] begin inductive_set iterates :: "('a \ 'a) \ 'a set" for f :: "'a \ 'a" where step: "x \ iterates f \ f x \ iterates f" | Sup: "chain (\) M \ \x\M. x \ iterates f \ Sup M \ iterates f" end lemma iterates_le_f: "x \ iterates f \ monotone (\) (\) f \ x \ f x" by (induct x rule: iterates.induct) (force dest: monotoneD intro!: ccpo_Sup_upper ccpo_Sup_least)+ lemma chain_iterates: assumes f: "monotone (\) (\) f" shows "chain (\) (iterates f)" (is "chain _ ?C") proof (rule chainI) fix x y assume "x \ ?C" "y \ ?C" then show "x \ y \ y \ x" proof (induct x arbitrary: y rule: iterates.induct) fix x y assume y: "y \ ?C" and IH: "\z. z \ ?C \ x \ z \ z \ x" from y show "f x \ y \ y \ f x" proof (induct y rule: iterates.induct) case (step y) with IH f show ?case by (auto dest: monotoneD) next case (Sup M) then have chM: "chain (\) M" and IH': "\z. z \ M \ f x \ z \ z \ f x" by auto show "f x \ Sup M \ Sup M \ f x" proof (cases "\z\M. f x \ z") case True then have "f x \ Sup M" by (blast intro: ccpo_Sup_upper[OF chM] order_trans) then show ?thesis .. next case False with IH' show ?thesis by (auto intro: ccpo_Sup_least[OF chM]) qed qed next case (Sup M y) show ?case proof (cases "\x\M. y \ x") case True then have "y \ Sup M" by (blast intro: ccpo_Sup_upper[OF Sup(1)] order_trans) then show ?thesis .. next case False with Sup show ?thesis by (auto intro: ccpo_Sup_least) qed qed qed lemma bot_in_iterates: "Sup {} \ iterates f" by (auto intro: iterates.Sup simp add: chain_empty) subsection \Fixpoint combinator\ definition fixp :: "('a \ 'a) \ 'a" where "fixp f = Sup (iterates f)" lemma iterates_fixp: assumes f: "monotone (\) (\) f" shows "fixp f \ iterates f" unfolding fixp_def by (simp add: iterates.Sup chain_iterates f) lemma fixp_unfold: assumes f: "monotone (\) (\) f" shows "fixp f = f (fixp f)" -proof (rule antisym) +proof (rule order.antisym) show "fixp f \ f (fixp f)" by (intro iterates_le_f iterates_fixp f) have "f (fixp f) \ Sup (iterates f)" by (intro ccpo_Sup_upper chain_iterates f iterates.step iterates_fixp) then show "f (fixp f) \ fixp f" by (simp only: fixp_def) qed lemma fixp_lowerbound: assumes f: "monotone (\) (\) f" and z: "f z \ z" shows "fixp f \ z" unfolding fixp_def proof (rule ccpo_Sup_least[OF chain_iterates[OF f]]) fix x assume "x \ iterates f" then show "x \ z" proof (induct x rule: iterates.induct) case (step x) from f \x \ z\ have "f x \ f z" by (rule monotoneD) also note z finally show "f x \ z" . next case (Sup M) then show ?case by (auto intro: ccpo_Sup_least) qed qed end subsection \Fixpoint induction\ setup \Sign.map_naming (Name_Space.mandatory_path "ccpo")\ definition admissible :: "('a set \ 'a) \ ('a \ 'a \ bool) \ ('a \ bool) \ bool" where "admissible lub ord P \ (\A. chain ord A \ A \ {} \ (\x\A. P x) \ P (lub A))" lemma admissibleI: assumes "\A. chain ord A \ A \ {} \ \x\A. P x \ P (lub A)" shows "ccpo.admissible lub ord P" using assms unfolding ccpo.admissible_def by fast lemma admissibleD: assumes "ccpo.admissible lub ord P" assumes "chain ord A" assumes "A \ {}" assumes "\x. x \ A \ P x" shows "P (lub A)" using assms by (auto simp: ccpo.admissible_def) setup \Sign.map_naming Name_Space.parent_path\ lemma (in ccpo) fixp_induct: assumes adm: "ccpo.admissible Sup (\) P" assumes mono: "monotone (\) (\) f" assumes bot: "P (Sup {})" assumes step: "\x. P x \ P (f x)" shows "P (fixp f)" unfolding fixp_def using adm chain_iterates[OF mono] proof (rule ccpo.admissibleD) show "iterates f \ {}" using bot_in_iterates by auto next fix x assume "x \ iterates f" then show "P x" proof (induct rule: iterates.induct) case prems: (step x) from this(2) show ?case by (rule step) next case (Sup M) then show ?case by (cases "M = {}") (auto intro: step bot ccpo.admissibleD adm) qed qed lemma admissible_True: "ccpo.admissible lub ord (\x. True)" unfolding ccpo.admissible_def by simp (*lemma admissible_False: "\ ccpo.admissible lub ord (\x. False)" unfolding ccpo.admissible_def chain_def by simp *) lemma admissible_const: "ccpo.admissible lub ord (\x. t)" by (auto intro: ccpo.admissibleI) lemma admissible_conj: assumes "ccpo.admissible lub ord (\x. P x)" assumes "ccpo.admissible lub ord (\x. Q x)" shows "ccpo.admissible lub ord (\x. P x \ Q x)" using assms unfolding ccpo.admissible_def by simp lemma admissible_all: assumes "\y. ccpo.admissible lub ord (\x. P x y)" shows "ccpo.admissible lub ord (\x. \y. P x y)" using assms unfolding ccpo.admissible_def by fast lemma admissible_ball: assumes "\y. y \ A \ ccpo.admissible lub ord (\x. P x y)" shows "ccpo.admissible lub ord (\x. \y\A. P x y)" using assms unfolding ccpo.admissible_def by fast lemma chain_compr: "chain ord A \ chain ord {x \ A. P x}" unfolding chain_def by fast context ccpo begin lemma admissible_disj: fixes P Q :: "'a \ bool" assumes P: "ccpo.admissible Sup (\) (\x. P x)" assumes Q: "ccpo.admissible Sup (\) (\x. Q x)" shows "ccpo.admissible Sup (\) (\x. P x \ Q x)" proof (rule ccpo.admissibleI) fix A :: "'a set" assume chain: "chain (\) A" assume A: "A \ {}" and P_Q: "\x\A. P x \ Q x" have "(\x\A. P x) \ (\x\A. \y\A. x \ y \ P y) \ (\x\A. Q x) \ (\x\A. \y\A. x \ y \ Q y)" (is "?P \ ?Q" is "?P1 \ ?P2 \ _") proof (rule disjCI) assume "\ ?Q" then consider "\x\A. \ Q x" | a where "a \ A" "\y\A. a \ y \ \ Q y" by blast then show ?P proof cases case 1 with P_Q have "\x\A. P x" by blast with A show ?P by blast next case 2 note a = \a \ A\ show ?P proof from P_Q 2 have *: "\y\A. a \ y \ P y" by blast with a have "P a" by blast with a show ?P1 by blast show ?P2 proof fix x assume x: "x \ A" with chain a show "\y\A. x \ y \ P y" proof (rule chainE) assume le: "a \ x" with * a x have "P x" by blast with x le show ?thesis by blast next assume "a \ x" with a \P a\ show ?thesis by blast qed qed qed qed qed moreover have "Sup A = Sup {x \ A. P x}" if "\x. x\A \ \y\A. x \ y \ P y" for P - proof (rule antisym) + proof (rule order.antisym) have chain_P: "chain (\) {x \ A. P x}" by (rule chain_compr [OF chain]) show "Sup A \ Sup {x \ A. P x}" proof (rule ccpo_Sup_least [OF chain]) show "\x. x \ A \ x \ \ {x \ A. P x}" by (blast intro: ccpo_Sup_upper[OF chain_P] order_trans dest: that) qed show "Sup {x \ A. P x} \ Sup A" apply (rule ccpo_Sup_least [OF chain_P]) apply (simp add: ccpo_Sup_upper [OF chain]) done qed ultimately consider "\x. x \ A \ P x" "Sup A = Sup {x \ A. P x}" | "\x. x \ A \ Q x" "Sup A = Sup {x \ A. Q x}" by blast then show "P (Sup A) \ Q (Sup A)" proof cases case 1 then show ?thesis using ccpo.admissibleD [OF P chain_compr [OF chain]] by force next case 2 then show ?thesis using ccpo.admissibleD [OF Q chain_compr [OF chain]] by force qed qed end instance complete_lattice \ ccpo by standard (fast intro: Sup_upper Sup_least)+ lemma lfp_eq_fixp: assumes mono: "mono f" shows "lfp f = fixp f" -proof (rule antisym) +proof (rule order.antisym) from mono have f': "monotone (\) (\) f" unfolding mono_def monotone_def . show "lfp f \ fixp f" by (rule lfp_lowerbound, subst fixp_unfold [OF f'], rule order_refl) show "fixp f \ lfp f" by (rule fixp_lowerbound [OF f']) (simp add: lfp_fixpoint [OF mono]) qed hide_const (open) iterates fixp end diff --git a/src/HOL/Complex_Main.thy b/src/HOL/Complex_Main.thy --- a/src/HOL/Complex_Main.thy +++ b/src/HOL/Complex_Main.thy @@ -1,9 +1,9 @@ section \Comprehensive Complex Theory\ theory Complex_Main imports Complex MacLaurin begin -end +end \ No newline at end of file diff --git a/src/HOL/Conditionally_Complete_Lattices.thy b/src/HOL/Conditionally_Complete_Lattices.thy --- a/src/HOL/Conditionally_Complete_Lattices.thy +++ b/src/HOL/Conditionally_Complete_Lattices.thy @@ -1,799 +1,799 @@ (* Title: HOL/Conditionally_Complete_Lattices.thy Author: Amine Chaieb and L C Paulson, University of Cambridge Author: Johannes Hölzl, TU München Author: Luke S. Serafin, Carnegie Mellon University *) section \Conditionally-complete Lattices\ theory Conditionally_Complete_Lattices imports Finite_Set Lattices_Big Set_Interval begin locale preordering_bdd = preordering begin definition bdd :: \'a set \ bool\ where unfold: \bdd A \ (\M. \x \ A. x \<^bold>\ M)\ lemma empty [simp, intro]: \bdd {}\ by (simp add: unfold) lemma I [intro]: \bdd A\ if \\x. x \ A \ x \<^bold>\ M\ using that by (auto simp add: unfold) lemma E: assumes \bdd A\ obtains M where \\x. x \ A \ x \<^bold>\ M\ using assms that by (auto simp add: unfold) lemma I2: \bdd (f ` A)\ if \\x. x \ A \ f x \<^bold>\ M\ using that by (auto simp add: unfold) lemma mono: \bdd A\ if \bdd B\ \A \ B\ using that by (auto simp add: unfold) lemma Int1 [simp]: \bdd (A \ B)\ if \bdd A\ using mono that by auto lemma Int2 [simp]: \bdd (A \ B)\ if \bdd B\ using mono that by auto end context preorder begin sublocale bdd_above: preordering_bdd \(\)\ \(<)\ defines bdd_above_primitive_def: bdd_above = bdd_above.bdd .. sublocale bdd_below: preordering_bdd \(\)\ \(>)\ defines bdd_below_primitive_def: bdd_below = bdd_below.bdd .. lemma bdd_above_def: \bdd_above A \ (\M. \x \ A. x \ M)\ by (fact bdd_above.unfold) lemma bdd_below_def: \bdd_below A \ (\M. \x \ A. M \ x)\ by (fact bdd_below.unfold) lemma bdd_aboveI: "(\x. x \ A \ x \ M) \ bdd_above A" by (fact bdd_above.I) lemma bdd_belowI: "(\x. x \ A \ m \ x) \ bdd_below A" by (fact bdd_below.I) lemma bdd_aboveI2: "(\x. x \ A \ f x \ M) \ bdd_above (f`A)" by (fact bdd_above.I2) lemma bdd_belowI2: "(\x. x \ A \ m \ f x) \ bdd_below (f`A)" by (fact bdd_below.I2) lemma bdd_above_empty: "bdd_above {}" by (fact bdd_above.empty) lemma bdd_below_empty: "bdd_below {}" by (fact bdd_below.empty) lemma bdd_above_mono: "bdd_above B \ A \ B \ bdd_above A" by (fact bdd_above.mono) lemma bdd_below_mono: "bdd_below B \ A \ B \ bdd_below A" by (fact bdd_below.mono) lemma bdd_above_Int1: "bdd_above A \ bdd_above (A \ B)" by (fact bdd_above.Int1) lemma bdd_above_Int2: "bdd_above B \ bdd_above (A \ B)" by (fact bdd_above.Int2) lemma bdd_below_Int1: "bdd_below A \ bdd_below (A \ B)" by (fact bdd_below.Int1) lemma bdd_below_Int2: "bdd_below B \ bdd_below (A \ B)" by (fact bdd_below.Int2) lemma bdd_above_Ioo [simp, intro]: "bdd_above {a <..< b}" by (auto simp add: bdd_above_def intro!: exI[of _ b] less_imp_le) lemma bdd_above_Ico [simp, intro]: "bdd_above {a ..< b}" by (auto simp add: bdd_above_def intro!: exI[of _ b] less_imp_le) lemma bdd_above_Iio [simp, intro]: "bdd_above {..< b}" by (auto simp add: bdd_above_def intro: exI[of _ b] less_imp_le) lemma bdd_above_Ioc [simp, intro]: "bdd_above {a <.. b}" by (auto simp add: bdd_above_def intro: exI[of _ b] less_imp_le) lemma bdd_above_Icc [simp, intro]: "bdd_above {a .. b}" by (auto simp add: bdd_above_def intro: exI[of _ b] less_imp_le) lemma bdd_above_Iic [simp, intro]: "bdd_above {.. b}" by (auto simp add: bdd_above_def intro: exI[of _ b] less_imp_le) lemma bdd_below_Ioo [simp, intro]: "bdd_below {a <..< b}" by (auto simp add: bdd_below_def intro!: exI[of _ a] less_imp_le) lemma bdd_below_Ioc [simp, intro]: "bdd_below {a <.. b}" by (auto simp add: bdd_below_def intro!: exI[of _ a] less_imp_le) lemma bdd_below_Ioi [simp, intro]: "bdd_below {a <..}" by (auto simp add: bdd_below_def intro: exI[of _ a] less_imp_le) lemma bdd_below_Ico [simp, intro]: "bdd_below {a ..< b}" by (auto simp add: bdd_below_def intro: exI[of _ a] less_imp_le) lemma bdd_below_Icc [simp, intro]: "bdd_below {a .. b}" by (auto simp add: bdd_below_def intro: exI[of _ a] less_imp_le) lemma bdd_below_Ici [simp, intro]: "bdd_below {a ..}" by (auto simp add: bdd_below_def intro: exI[of _ a] less_imp_le) end context order_top begin lemma bdd_above_top [simp, intro!]: "bdd_above A" by (rule bdd_aboveI [of _ top]) simp end context order_bot begin lemma bdd_below_bot [simp, intro!]: "bdd_below A" by (rule bdd_belowI [of _ bot]) simp end lemma bdd_above_image_mono: "mono f \ bdd_above A \ bdd_above (f`A)" by (auto simp: bdd_above_def mono_def) lemma bdd_below_image_mono: "mono f \ bdd_below A \ bdd_below (f`A)" by (auto simp: bdd_below_def mono_def) lemma bdd_above_image_antimono: "antimono f \ bdd_below A \ bdd_above (f`A)" by (auto simp: bdd_above_def bdd_below_def antimono_def) lemma bdd_below_image_antimono: "antimono f \ bdd_above A \ bdd_below (f`A)" by (auto simp: bdd_above_def bdd_below_def antimono_def) lemma fixes X :: "'a::ordered_ab_group_add set" shows bdd_above_uminus[simp]: "bdd_above (uminus ` X) \ bdd_below X" and bdd_below_uminus[simp]: "bdd_below (uminus ` X) \ bdd_above X" using bdd_above_image_antimono[of uminus X] bdd_below_image_antimono[of uminus "uminus`X"] using bdd_below_image_antimono[of uminus X] bdd_above_image_antimono[of uminus "uminus`X"] by (auto simp: antimono_def image_image) context lattice begin lemma bdd_above_insert [simp]: "bdd_above (insert a A) = bdd_above A" by (auto simp: bdd_above_def intro: le_supI2 sup_ge1) lemma bdd_below_insert [simp]: "bdd_below (insert a A) = bdd_below A" by (auto simp: bdd_below_def intro: le_infI2 inf_le1) lemma bdd_finite [simp]: assumes "finite A" shows bdd_above_finite: "bdd_above A" and bdd_below_finite: "bdd_below A" using assms by (induct rule: finite_induct, auto) lemma bdd_above_Un [simp]: "bdd_above (A \ B) = (bdd_above A \ bdd_above B)" proof assume "bdd_above (A \ B)" thus "bdd_above A \ bdd_above B" unfolding bdd_above_def by auto next assume "bdd_above A \ bdd_above B" then obtain a b where "\x\A. x \ a" "\x\B. x \ b" unfolding bdd_above_def by auto hence "\x \ A \ B. x \ sup a b" by (auto intro: Un_iff le_supI1 le_supI2) thus "bdd_above (A \ B)" unfolding bdd_above_def .. qed lemma bdd_below_Un [simp]: "bdd_below (A \ B) = (bdd_below A \ bdd_below B)" proof assume "bdd_below (A \ B)" thus "bdd_below A \ bdd_below B" unfolding bdd_below_def by auto next assume "bdd_below A \ bdd_below B" then obtain a b where "\x\A. a \ x" "\x\B. b \ x" unfolding bdd_below_def by auto hence "\x \ A \ B. inf a b \ x" by (auto intro: Un_iff le_infI1 le_infI2) thus "bdd_below (A \ B)" unfolding bdd_below_def .. qed lemma bdd_above_image_sup[simp]: "bdd_above ((\x. sup (f x) (g x)) ` A) \ bdd_above (f`A) \ bdd_above (g`A)" by (auto simp: bdd_above_def intro: le_supI1 le_supI2) lemma bdd_below_image_inf[simp]: "bdd_below ((\x. inf (f x) (g x)) ` A) \ bdd_below (f`A) \ bdd_below (g`A)" by (auto simp: bdd_below_def intro: le_infI1 le_infI2) lemma bdd_below_UN[simp]: "finite I \ bdd_below (\i\I. A i) = (\i \ I. bdd_below (A i))" by (induction I rule: finite.induct) auto lemma bdd_above_UN[simp]: "finite I \ bdd_above (\i\I. A i) = (\i \ I. bdd_above (A i))" by (induction I rule: finite.induct) auto end text \ To avoid name classes with the \<^class>\complete_lattice\-class we prefix \<^const>\Sup\ and \<^const>\Inf\ in theorem names with c. \ class conditionally_complete_lattice = lattice + Sup + Inf + assumes cInf_lower: "x \ X \ bdd_below X \ Inf X \ x" and cInf_greatest: "X \ {} \ (\x. x \ X \ z \ x) \ z \ Inf X" assumes cSup_upper: "x \ X \ bdd_above X \ x \ Sup X" and cSup_least: "X \ {} \ (\x. x \ X \ x \ z) \ Sup X \ z" begin lemma cSup_upper2: "x \ X \ y \ x \ bdd_above X \ y \ Sup X" by (metis cSup_upper order_trans) lemma cInf_lower2: "x \ X \ x \ y \ bdd_below X \ Inf X \ y" by (metis cInf_lower order_trans) lemma cSup_mono: "B \ {} \ bdd_above A \ (\b. b \ B \ \a\A. b \ a) \ Sup B \ Sup A" by (metis cSup_least cSup_upper2) lemma cInf_mono: "B \ {} \ bdd_below A \ (\b. b \ B \ \a\A. a \ b) \ Inf A \ Inf B" by (metis cInf_greatest cInf_lower2) lemma cSup_subset_mono: "A \ {} \ bdd_above B \ A \ B \ Sup A \ Sup B" by (metis cSup_least cSup_upper subsetD) lemma cInf_superset_mono: "A \ {} \ bdd_below B \ A \ B \ Inf B \ Inf A" by (metis cInf_greatest cInf_lower subsetD) lemma cSup_eq_maximum: "z \ X \ (\x. x \ X \ x \ z) \ Sup X = z" - by (intro antisym cSup_upper[of z X] cSup_least[of X z]) auto + by (intro order.antisym cSup_upper[of z X] cSup_least[of X z]) auto lemma cInf_eq_minimum: "z \ X \ (\x. x \ X \ z \ x) \ Inf X = z" - by (intro antisym cInf_lower[of z X] cInf_greatest[of X z]) auto + by (intro order.antisym cInf_lower[of z X] cInf_greatest[of X z]) auto lemma cSup_le_iff: "S \ {} \ bdd_above S \ Sup S \ a \ (\x\S. x \ a)" by (metis order_trans cSup_upper cSup_least) lemma le_cInf_iff: "S \ {} \ bdd_below S \ a \ Inf S \ (\x\S. a \ x)" by (metis order_trans cInf_lower cInf_greatest) lemma cSup_eq_non_empty: assumes 1: "X \ {}" assumes 2: "\x. x \ X \ x \ a" assumes 3: "\y. (\x. x \ X \ x \ y) \ a \ y" shows "Sup X = a" - by (intro 3 1 antisym cSup_least) (auto intro: 2 1 cSup_upper) + by (intro 3 1 order.antisym cSup_least) (auto intro: 2 1 cSup_upper) lemma cInf_eq_non_empty: assumes 1: "X \ {}" assumes 2: "\x. x \ X \ a \ x" assumes 3: "\y. (\x. x \ X \ y \ x) \ y \ a" shows "Inf X = a" - by (intro 3 1 antisym cInf_greatest) (auto intro: 2 1 cInf_lower) + by (intro 3 1 order.antisym cInf_greatest) (auto intro: 2 1 cInf_lower) lemma cInf_cSup: "S \ {} \ bdd_below S \ Inf S = Sup {x. \s\S. x \ s}" by (rule cInf_eq_non_empty) (auto intro!: cSup_upper cSup_least simp: bdd_below_def) lemma cSup_cInf: "S \ {} \ bdd_above S \ Sup S = Inf {x. \s\S. s \ x}" by (rule cSup_eq_non_empty) (auto intro!: cInf_lower cInf_greatest simp: bdd_above_def) lemma cSup_insert: "X \ {} \ bdd_above X \ Sup (insert a X) = sup a (Sup X)" by (intro cSup_eq_non_empty) (auto intro: le_supI2 cSup_upper cSup_least) lemma cInf_insert: "X \ {} \ bdd_below X \ Inf (insert a X) = inf a (Inf X)" by (intro cInf_eq_non_empty) (auto intro: le_infI2 cInf_lower cInf_greatest) lemma cSup_singleton [simp]: "Sup {x} = x" by (intro cSup_eq_maximum) auto lemma cInf_singleton [simp]: "Inf {x} = x" by (intro cInf_eq_minimum) auto lemma cSup_insert_If: "bdd_above X \ Sup (insert a X) = (if X = {} then a else sup a (Sup X))" using cSup_insert[of X] by simp lemma cInf_insert_If: "bdd_below X \ Inf (insert a X) = (if X = {} then a else inf a (Inf X))" using cInf_insert[of X] by simp lemma le_cSup_finite: "finite X \ x \ X \ x \ Sup X" proof (induct X arbitrary: x rule: finite_induct) case (insert x X y) then show ?case by (cases "X = {}") (auto simp: cSup_insert intro: le_supI2) qed simp lemma cInf_le_finite: "finite X \ x \ X \ Inf X \ x" proof (induct X arbitrary: x rule: finite_induct) case (insert x X y) then show ?case by (cases "X = {}") (auto simp: cInf_insert intro: le_infI2) qed simp lemma cSup_eq_Sup_fin: "finite X \ X \ {} \ Sup X = Sup_fin X" by (induct X rule: finite_ne_induct) (simp_all add: cSup_insert) lemma cInf_eq_Inf_fin: "finite X \ X \ {} \ Inf X = Inf_fin X" by (induct X rule: finite_ne_induct) (simp_all add: cInf_insert) lemma cSup_atMost[simp]: "Sup {..x} = x" by (auto intro!: cSup_eq_maximum) lemma cSup_greaterThanAtMost[simp]: "y < x \ Sup {y<..x} = x" by (auto intro!: cSup_eq_maximum) lemma cSup_atLeastAtMost[simp]: "y \ x \ Sup {y..x} = x" by (auto intro!: cSup_eq_maximum) lemma cInf_atLeast[simp]: "Inf {x..} = x" by (auto intro!: cInf_eq_minimum) lemma cInf_atLeastLessThan[simp]: "y < x \ Inf {y.. x \ Inf {y..x} = y" by (auto intro!: cInf_eq_minimum) lemma cINF_lower: "bdd_below (f ` A) \ x \ A \ \(f ` A) \ f x" using cInf_lower [of _ "f ` A"] by simp lemma cINF_greatest: "A \ {} \ (\x. x \ A \ m \ f x) \ m \ \(f ` A)" using cInf_greatest [of "f ` A"] by auto lemma cSUP_upper: "x \ A \ bdd_above (f ` A) \ f x \ \(f ` A)" using cSup_upper [of _ "f ` A"] by simp lemma cSUP_least: "A \ {} \ (\x. x \ A \ f x \ M) \ \(f ` A) \ M" using cSup_least [of "f ` A"] by auto lemma cINF_lower2: "bdd_below (f ` A) \ x \ A \ f x \ u \ \(f ` A) \ u" by (auto intro: cINF_lower order_trans) lemma cSUP_upper2: "bdd_above (f ` A) \ x \ A \ u \ f x \ u \ \(f ` A)" by (auto intro: cSUP_upper order_trans) lemma cSUP_const [simp]: "A \ {} \ (\x\A. c) = c" - by (intro antisym cSUP_least) (auto intro: cSUP_upper) + by (intro order.antisym cSUP_least) (auto intro: cSUP_upper) lemma cINF_const [simp]: "A \ {} \ (\x\A. c) = c" - by (intro antisym cINF_greatest) (auto intro: cINF_lower) + by (intro order.antisym cINF_greatest) (auto intro: cINF_lower) lemma le_cINF_iff: "A \ {} \ bdd_below (f ` A) \ u \ \(f ` A) \ (\x\A. u \ f x)" by (metis cINF_greatest cINF_lower order_trans) lemma cSUP_le_iff: "A \ {} \ bdd_above (f ` A) \ \(f ` A) \ u \ (\x\A. f x \ u)" by (metis cSUP_least cSUP_upper order_trans) lemma less_cINF_D: "bdd_below (f`A) \ y < (\i\A. f i) \ i \ A \ y < f i" by (metis cINF_lower less_le_trans) lemma cSUP_lessD: "bdd_above (f`A) \ (\i\A. f i) < y \ i \ A \ f i < y" by (metis cSUP_upper le_less_trans) lemma cINF_insert: "A \ {} \ bdd_below (f ` A) \ \(f ` insert a A) = inf (f a) (\(f ` A))" by (simp add: cInf_insert) lemma cSUP_insert: "A \ {} \ bdd_above (f ` A) \ \(f ` insert a A) = sup (f a) (\(f ` A))" by (simp add: cSup_insert) lemma cINF_mono: "B \ {} \ bdd_below (f ` A) \ (\m. m \ B \ \n\A. f n \ g m) \ \(f ` A) \ \(g ` B)" using cInf_mono [of "g ` B" "f ` A"] by auto lemma cSUP_mono: "A \ {} \ bdd_above (g ` B) \ (\n. n \ A \ \m\B. f n \ g m) \ \(f ` A) \ \(g ` B)" using cSup_mono [of "f ` A" "g ` B"] by auto lemma cINF_superset_mono: "A \ {} \ bdd_below (g ` B) \ A \ B \ (\x. x \ B \ g x \ f x) \ \(g ` B) \ \(f ` A)" by (rule cINF_mono) auto lemma cSUP_subset_mono: "\A \ {}; bdd_above (g ` B); A \ B; \x. x \ A \ f x \ g x\ \ \ (f ` A) \ \ (g ` B)" by (rule cSUP_mono) auto lemma less_eq_cInf_inter: "bdd_below A \ bdd_below B \ A \ B \ {} \ inf (Inf A) (Inf B) \ Inf (A \ B)" by (metis cInf_superset_mono lattice_class.inf_sup_ord(1) le_infI1) lemma cSup_inter_less_eq: "bdd_above A \ bdd_above B \ A \ B \ {} \ Sup (A \ B) \ sup (Sup A) (Sup B) " by (metis cSup_subset_mono lattice_class.inf_sup_ord(1) le_supI1) lemma cInf_union_distrib: "A \ {} \ bdd_below A \ B \ {} \ bdd_below B \ Inf (A \ B) = inf (Inf A) (Inf B)" - by (intro antisym le_infI cInf_greatest cInf_lower) (auto intro: le_infI1 le_infI2 cInf_lower) + by (intro order.antisym le_infI cInf_greatest cInf_lower) (auto intro: le_infI1 le_infI2 cInf_lower) lemma cINF_union: "A \ {} \ bdd_below (f ` A) \ B \ {} \ bdd_below (f ` B) \ \ (f ` (A \ B)) = \ (f ` A) \ \ (f ` B)" using cInf_union_distrib [of "f ` A" "f ` B"] by (simp add: image_Un) lemma cSup_union_distrib: "A \ {} \ bdd_above A \ B \ {} \ bdd_above B \ Sup (A \ B) = sup (Sup A) (Sup B)" - by (intro antisym le_supI cSup_least cSup_upper) (auto intro: le_supI1 le_supI2 cSup_upper) + by (intro order.antisym le_supI cSup_least cSup_upper) (auto intro: le_supI1 le_supI2 cSup_upper) lemma cSUP_union: "A \ {} \ bdd_above (f ` A) \ B \ {} \ bdd_above (f ` B) \ \ (f ` (A \ B)) = \ (f ` A) \ \ (f ` B)" using cSup_union_distrib [of "f ` A" "f ` B"] by (simp add: image_Un) lemma cINF_inf_distrib: "A \ {} \ bdd_below (f`A) \ bdd_below (g`A) \ \ (f ` A) \ \ (g ` A) = (\a\A. inf (f a) (g a))" - by (intro antisym le_infI cINF_greatest cINF_lower2) + by (intro order.antisym le_infI cINF_greatest cINF_lower2) (auto intro: le_infI1 le_infI2 cINF_greatest cINF_lower le_infI) lemma SUP_sup_distrib: "A \ {} \ bdd_above (f`A) \ bdd_above (g`A) \ \ (f ` A) \ \ (g ` A) = (\a\A. sup (f a) (g a))" - by (intro antisym le_supI cSUP_least cSUP_upper2) + by (intro order.antisym le_supI cSUP_least cSUP_upper2) (auto intro: le_supI1 le_supI2 cSUP_least cSUP_upper le_supI) lemma cInf_le_cSup: "A \ {} \ bdd_above A \ bdd_below A \ Inf A \ Sup A" by (auto intro!: cSup_upper2[of "SOME a. a \ A"] intro: someI cInf_lower) end instance complete_lattice \ conditionally_complete_lattice by standard (auto intro: Sup_upper Sup_least Inf_lower Inf_greatest) lemma cSup_eq: fixes a :: "'a :: {conditionally_complete_lattice, no_bot}" assumes upper: "\x. x \ X \ x \ a" assumes least: "\y. (\x. x \ X \ x \ y) \ a \ y" shows "Sup X = a" proof cases assume "X = {}" with lt_ex[of a] least show ?thesis by (auto simp: less_le_not_le) qed (intro cSup_eq_non_empty assms) lemma cInf_eq: fixes a :: "'a :: {conditionally_complete_lattice, no_top}" assumes upper: "\x. x \ X \ a \ x" assumes least: "\y. (\x. x \ X \ y \ x) \ y \ a" shows "Inf X = a" proof cases assume "X = {}" with gt_ex[of a] least show ?thesis by (auto simp: less_le_not_le) qed (intro cInf_eq_non_empty assms) class conditionally_complete_linorder = conditionally_complete_lattice + linorder begin lemma less_cSup_iff: "X \ {} \ bdd_above X \ y < Sup X \ (\x\X. y < x)" by (rule iffI) (metis cSup_least not_less, metis cSup_upper less_le_trans) lemma cInf_less_iff: "X \ {} \ bdd_below X \ Inf X < y \ (\x\X. x < y)" by (rule iffI) (metis cInf_greatest not_less, metis cInf_lower le_less_trans) lemma cINF_less_iff: "A \ {} \ bdd_below (f`A) \ (\i\A. f i) < a \ (\x\A. f x < a)" using cInf_less_iff[of "f`A"] by auto lemma less_cSUP_iff: "A \ {} \ bdd_above (f`A) \ a < (\i\A. f i) \ (\x\A. a < f x)" using less_cSup_iff[of "f`A"] by auto lemma less_cSupE: assumes "y < Sup X" "X \ {}" obtains x where "x \ X" "y < x" by (metis cSup_least assms not_le that) lemma less_cSupD: "X \ {} \ z < Sup X \ \x\X. z < x" by (metis less_cSup_iff not_le_imp_less bdd_above_def) lemma cInf_lessD: "X \ {} \ Inf X < z \ \x\X. x < z" by (metis cInf_less_iff not_le_imp_less bdd_below_def) lemma complete_interval: assumes "a < b" and "P a" and "\ P b" shows "\c. a \ c \ c \ b \ (\x. a \ x \ x < c \ P x) \ (\d. (\x. a \ x \ x < d \ P x) \ d \ c)" proof (rule exI [where x = "Sup {d. \x. a \ x \ x < d \ P x}"], auto) show "a \ Sup {d. \c. a \ c \ c < d \ P c}" by (rule cSup_upper, auto simp: bdd_above_def) (metis \a < b\ \\ P b\ linear less_le) next show "Sup {d. \c. a \ c \ c < d \ P c} \ b" apply (rule cSup_least) apply auto apply (metis less_le_not_le) apply (metis \a \\ P b\ linear less_le) done next fix x assume x: "a \ x" and lt: "x < Sup {d. \c. a \ c \ c < d \ P c}" show "P x" apply (rule less_cSupE [OF lt], auto) apply (metis less_le_not_le) apply (metis x) done next fix d assume 0: "\x. a \ x \ x < d \ P x" thus "d \ Sup {d. \c. a \ c \ c < d \ P c}" by (rule_tac cSup_upper, auto simp: bdd_above_def) (metis \a \\ P b\ linear less_le) qed end instance complete_linorder < conditionally_complete_linorder .. lemma cSup_eq_Max: "finite (X::'a::conditionally_complete_linorder set) \ X \ {} \ Sup X = Max X" using cSup_eq_Sup_fin[of X] by (simp add: Sup_fin_Max) lemma cInf_eq_Min: "finite (X::'a::conditionally_complete_linorder set) \ X \ {} \ Inf X = Min X" using cInf_eq_Inf_fin[of X] by (simp add: Inf_fin_Min) lemma cSup_lessThan[simp]: "Sup {.. Sup {y<.. Sup {y.. Inf {y<..x::'a::{conditionally_complete_linorder, dense_linorder}} = y" by (auto intro!: cInf_eq_non_empty intro: dense_ge_bounded) lemma cInf_greaterThanLessThan[simp]: "y < x \ Inf {y<.. Inf (insert x S) = (if S = {} then x else min x (Inf S))" by (simp add: cInf_eq_Min) lemma Sup_insert_finite: fixes S :: "'a::conditionally_complete_linorder set" shows "finite S \ Sup (insert x S) = (if S = {} then x else max x (Sup S))" by (simp add: cSup_insert sup_max) lemma finite_imp_less_Inf: fixes a :: "'a::conditionally_complete_linorder" shows "\finite X; x \ X; \x. x\X \ a < x\ \ a < Inf X" by (induction X rule: finite_induct) (simp_all add: cInf_eq_Min Inf_insert_finite) lemma finite_less_Inf_iff: fixes a :: "'a :: conditionally_complete_linorder" shows "\finite X; X \ {}\ \ a < Inf X \ (\x \ X. a < x)" by (auto simp: cInf_eq_Min) lemma finite_imp_Sup_less: fixes a :: "'a::conditionally_complete_linorder" shows "\finite X; x \ X; \x. x\X \ a > x\ \ a > Sup X" by (induction X rule: finite_induct) (simp_all add: cSup_eq_Max Sup_insert_finite) lemma finite_Sup_less_iff: fixes a :: "'a :: conditionally_complete_linorder" shows "\finite X; X \ {}\ \ a > Sup X \ (\x \ X. a > x)" by (auto simp: cSup_eq_Max) class linear_continuum = conditionally_complete_linorder + dense_linorder + assumes UNIV_not_singleton: "\a b::'a. a \ b" begin lemma ex_gt_or_lt: "\b. a < b \ b < a" by (metis UNIV_not_singleton neq_iff) end instantiation nat :: conditionally_complete_linorder begin definition "Sup (X::nat set) = (if X={} then 0 else Max X)" definition "Inf (X::nat set) = (LEAST n. n \ X)" lemma bdd_above_nat: "bdd_above X \ finite (X::nat set)" proof assume "bdd_above X" then obtain z where "X \ {.. z}" by (auto simp: bdd_above_def) then show "finite X" by (rule finite_subset) simp qed simp instance proof fix x :: nat fix X :: "nat set" show "Inf X \ x" if "x \ X" "bdd_below X" using that by (simp add: Inf_nat_def Least_le) show "x \ Inf X" if "X \ {}" "\y. y \ X \ x \ y" using that unfolding Inf_nat_def ex_in_conv[symmetric] by (rule LeastI2_ex) show "x \ Sup X" if "x \ X" "bdd_above X" using that by (auto simp add: Sup_nat_def bdd_above_nat) show "Sup X \ x" if "X \ {}" "\y. y \ X \ y \ x" proof - from that have "bdd_above X" by (auto simp: bdd_above_def) with that show ?thesis by (simp add: Sup_nat_def bdd_above_nat) qed qed end lemma Inf_nat_def1: fixes K::"nat set" assumes "K \ {}" shows "Inf K \ K" by (auto simp add: Min_def Inf_nat_def) (meson LeastI assms bot.extremum_unique subsetI) lemma Sup_nat_empty [simp]: "Sup {} = (0::nat)" by (auto simp add: Sup_nat_def) instantiation int :: conditionally_complete_linorder begin definition "Sup (X::int set) = (THE x. x \ X \ (\y\X. y \ x))" definition "Inf (X::int set) = - (Sup (uminus ` X))" instance proof { fix x :: int and X :: "int set" assume "X \ {}" "bdd_above X" then obtain x y where "X \ {..y}" "x \ X" by (auto simp: bdd_above_def) then have *: "finite (X \ {x..y})" "X \ {x..y} \ {}" and "x \ y" by (auto simp: subset_eq) have "\!x\X. (\y\X. y \ x)" proof { fix z assume "z \ X" have "z \ Max (X \ {x..y})" proof cases assume "x \ z" with \z \ X\ \X \ {..y}\ *(1) show ?thesis by (auto intro!: Max_ge) next assume "\ x \ z" then have "z < x" by simp also have "x \ Max (X \ {x..y})" using \x \ X\ *(1) \x \ y\ by (intro Max_ge) auto finally show ?thesis by simp qed } note le = this with Max_in[OF *] show ex: "Max (X \ {x..y}) \ X \ (\z\X. z \ Max (X \ {x..y}))" by auto fix z assume *: "z \ X \ (\y\X. y \ z)" with le have "z \ Max (X \ {x..y})" by auto moreover have "Max (X \ {x..y}) \ z" using * ex by auto ultimately show "z = Max (X \ {x..y})" by auto qed then have "Sup X \ X \ (\y\X. y \ Sup X)" unfolding Sup_int_def by (rule theI') } note Sup_int = this { fix x :: int and X :: "int set" assume "x \ X" "bdd_above X" then show "x \ Sup X" using Sup_int[of X] by auto } note le_Sup = this { fix x :: int and X :: "int set" assume "X \ {}" "\y. y \ X \ y \ x" then show "Sup X \ x" using Sup_int[of X] by (auto simp: bdd_above_def) } note Sup_le = this { fix x :: int and X :: "int set" assume "x \ X" "bdd_below X" then show "Inf X \ x" using le_Sup[of "-x" "uminus ` X"] by (auto simp: Inf_int_def) } { fix x :: int and X :: "int set" assume "X \ {}" "\y. y \ X \ x \ y" then show "x \ Inf X" using Sup_le[of "uminus ` X" "-x"] by (force simp: Inf_int_def) } qed end lemma interval_cases: fixes S :: "'a :: conditionally_complete_linorder set" assumes ivl: "\a b x. a \ S \ b \ S \ a \ x \ x \ b \ x \ S" shows "\a b. S = {} \ S = UNIV \ S = {.. S = {..b} \ S = {a<..} \ S = {a..} \ S = {a<.. S = {a<..b} \ S = {a.. S = {a..b}" proof - define lower upper where "lower = {x. \s\S. s \ x}" and "upper = {x. \s\S. x \ s}" with ivl have "S = lower \ upper" by auto moreover have "\a. upper = UNIV \ upper = {} \ upper = {.. a} \ upper = {..< a}" proof cases assume *: "bdd_above S \ S \ {}" from * have "upper \ {.. Sup S}" by (auto simp: upper_def intro: cSup_upper2) moreover from * have "{..< Sup S} \ upper" by (force simp add: less_cSup_iff upper_def subset_eq Ball_def) ultimately have "upper = {.. Sup S} \ upper = {..< Sup S}" unfolding ivl_disj_un(2)[symmetric] by auto then show ?thesis by auto next assume "\ (bdd_above S \ S \ {})" then have "upper = UNIV \ upper = {}" by (auto simp: upper_def bdd_above_def not_le dest: less_imp_le) then show ?thesis by auto qed moreover have "\b. lower = UNIV \ lower = {} \ lower = {b ..} \ lower = {b <..}" proof cases assume *: "bdd_below S \ S \ {}" from * have "lower \ {Inf S ..}" by (auto simp: lower_def intro: cInf_lower2) moreover from * have "{Inf S <..} \ lower" by (force simp add: cInf_less_iff lower_def subset_eq Ball_def) ultimately have "lower = {Inf S ..} \ lower = {Inf S <..}" unfolding ivl_disj_un(1)[symmetric] by auto then show ?thesis by auto next assume "\ (bdd_below S \ S \ {})" then have "lower = UNIV \ lower = {}" by (auto simp: lower_def bdd_below_def not_le dest: less_imp_le) then show ?thesis by auto qed ultimately show ?thesis unfolding greaterThanAtMost_def greaterThanLessThan_def atLeastAtMost_def atLeastLessThan_def by (metis inf_bot_left inf_bot_right inf_top.left_neutral inf_top.right_neutral) qed lemma cSUP_eq_cINF_D: fixes f :: "_ \ 'b::conditionally_complete_lattice" assumes eq: "(\x\A. f x) = (\x\A. f x)" and bdd: "bdd_above (f ` A)" "bdd_below (f ` A)" and a: "a \ A" shows "f a = (\x\A. f x)" apply (rule antisym) using a bdd apply (auto simp: cINF_lower) apply (metis eq cSUP_upper) done lemma cSUP_UNION: fixes f :: "_ \ 'b::conditionally_complete_lattice" assumes ne: "A \ {}" "\x. x \ A \ B(x) \ {}" and bdd_UN: "bdd_above (\x\A. f ` B x)" shows "(\z \ \x\A. B x. f z) = (\x\A. \z\B x. f z)" proof - have bdd: "\x. x \ A \ bdd_above (f ` B x)" using bdd_UN by (meson UN_upper bdd_above_mono) obtain M where "\x y. x \ A \ y \ B(x) \ f y \ M" using bdd_UN by (auto simp: bdd_above_def) then have bdd2: "bdd_above ((\x. \z\B x. f z) ` A)" unfolding bdd_above_def by (force simp: bdd cSUP_le_iff ne(2)) have "(\z \ \x\A. B x. f z) \ (\x\A. \z\B x. f z)" using assms by (fastforce simp add: intro!: cSUP_least intro: cSUP_upper2 simp: bdd2 bdd) moreover have "(\x\A. \z\B x. f z) \ (\ z \ \x\A. B x. f z)" using assms by (fastforce simp add: intro!: cSUP_least intro: cSUP_upper simp: image_UN bdd_UN) ultimately show ?thesis by (rule order_antisym) qed lemma cINF_UNION: fixes f :: "_ \ 'b::conditionally_complete_lattice" assumes ne: "A \ {}" "\x. x \ A \ B(x) \ {}" and bdd_UN: "bdd_below (\x\A. f ` B x)" shows "(\z \ \x\A. B x. f z) = (\x\A. \z\B x. f z)" proof - have bdd: "\x. x \ A \ bdd_below (f ` B x)" using bdd_UN by (meson UN_upper bdd_below_mono) obtain M where "\x y. x \ A \ y \ B(x) \ f y \ M" using bdd_UN by (auto simp: bdd_below_def) then have bdd2: "bdd_below ((\x. \z\B x. f z) ` A)" unfolding bdd_below_def by (force simp: bdd le_cINF_iff ne(2)) have "(\z \ \x\A. B x. f z) \ (\x\A. \z\B x. f z)" using assms by (fastforce simp add: intro!: cINF_greatest intro: cINF_lower simp: bdd2 bdd) moreover have "(\x\A. \z\B x. f z) \ (\z \ \x\A. B x. f z)" using assms by (fastforce simp add: intro!: cINF_greatest intro: cINF_lower2 simp: bdd bdd_UN bdd2) ultimately show ?thesis by (rule order_antisym) qed lemma cSup_abs_le: fixes S :: "('a::{linordered_idom,conditionally_complete_linorder}) set" shows "S \ {} \ (\x. x\S \ \x\ \ a) \ \Sup S\ \ a" apply (auto simp add: abs_le_iff intro: cSup_least) by (metis bdd_aboveI cSup_upper neg_le_iff_le order_trans) end diff --git a/src/HOL/Fields.thy b/src/HOL/Fields.thy --- a/src/HOL/Fields.thy +++ b/src/HOL/Fields.thy @@ -1,1348 +1,1348 @@ (* Title: HOL/Fields.thy Author: Gertrud Bauer Author: Steven Obua Author: Tobias Nipkow Author: Lawrence C Paulson Author: Markus Wenzel Author: Jeremy Avigad *) section \Fields\ theory Fields imports Nat begin context idom begin lemma inj_mult_left [simp]: \inj ((*) a) \ a \ 0\ (is \?P \ ?Q\) proof assume ?P show ?Q proof assume \a = 0\ with \?P\ have "inj ((*) 0)" by simp moreover have "0 * 0 = 0 * 1" by simp ultimately have "0 = 1" by (rule injD) then show False by simp qed next assume ?Q then show ?P by (auto intro: injI) qed end subsection \Division rings\ text \ A division ring is like a field, but without the commutativity requirement. \ class inverse = divide + fixes inverse :: "'a \ 'a" begin abbreviation inverse_divide :: "'a \ 'a \ 'a" (infixl "'/" 70) where "inverse_divide \ divide" end text \Setup for linear arithmetic prover\ ML_file \~~/src/Provers/Arith/fast_lin_arith.ML\ ML_file \Tools/lin_arith.ML\ setup \Lin_Arith.global_setup\ declaration \K ( Lin_Arith.init_arith_data #> Lin_Arith.add_discrete_type \<^type_name>\nat\ #> Lin_Arith.add_lessD @{thm Suc_leI} #> Lin_Arith.add_simps @{thms simp_thms ring_distribs if_True if_False minus_diff_eq add_0_left add_0_right order_less_irrefl zero_neq_one zero_less_one zero_le_one zero_neq_one [THEN not_sym] not_one_le_zero not_one_less_zero add_Suc add_Suc_right nat.inject Suc_le_mono Suc_less_eq Zero_not_Suc Suc_not_Zero le_0_eq One_nat_def} #> Lin_Arith.add_simprocs [\<^simproc>\group_cancel_add\, \<^simproc>\group_cancel_diff\, \<^simproc>\group_cancel_eq\, \<^simproc>\group_cancel_le\, \<^simproc>\group_cancel_less\, \<^simproc>\nateq_cancel_sums\,\<^simproc>\natless_cancel_sums\, \<^simproc>\natle_cancel_sums\])\ simproc_setup fast_arith_nat ("(m::nat) < n" | "(m::nat) \ n" | "(m::nat) = n") = \K Lin_Arith.simproc\ \ \Because of this simproc, the arithmetic solver is really only useful to detect inconsistencies among the premises for subgoals which are \<^emph>\not\ themselves (in)equalities, because the latter activate \<^text>\fast_nat_arith_simproc\ anyway. However, it seems cheaper to activate the solver all the time rather than add the additional check.\ lemmas [arith_split] = nat_diff_split split_min split_max text\Lemmas \divide_simps\ move division to the outside and eliminates them on (in)equalities.\ named_theorems divide_simps "rewrite rules to eliminate divisions" class division_ring = ring_1 + inverse + assumes left_inverse [simp]: "a \ 0 \ inverse a * a = 1" assumes right_inverse [simp]: "a \ 0 \ a * inverse a = 1" assumes divide_inverse: "a / b = a * inverse b" assumes inverse_zero [simp]: "inverse 0 = 0" begin subclass ring_1_no_zero_divisors proof fix a b :: 'a assume a: "a \ 0" and b: "b \ 0" show "a * b \ 0" proof assume ab: "a * b = 0" hence "0 = inverse a * (a * b) * inverse b" by simp also have "\ = (inverse a * a) * (b * inverse b)" by (simp only: mult.assoc) also have "\ = 1" using a b by simp finally show False by simp qed qed lemma nonzero_imp_inverse_nonzero: "a \ 0 \ inverse a \ 0" proof assume ianz: "inverse a = 0" assume "a \ 0" hence "1 = a * inverse a" by simp also have "... = 0" by (simp add: ianz) finally have "1 = 0" . thus False by (simp add: eq_commute) qed lemma inverse_zero_imp_zero: assumes "inverse a = 0" shows "a = 0" proof (rule ccontr) assume "a \ 0" then have "inverse a \ 0" by (simp add: nonzero_imp_inverse_nonzero) with assms show False by auto qed lemma inverse_unique: assumes ab: "a * b = 1" shows "inverse a = b" proof - have "a \ 0" using ab by (cases "a = 0") simp_all moreover have "inverse a * (a * b) = inverse a" by (simp add: ab) ultimately show ?thesis by (simp add: mult.assoc [symmetric]) qed lemma nonzero_inverse_minus_eq: "a \ 0 \ inverse (- a) = - inverse a" by (rule inverse_unique) simp lemma nonzero_inverse_inverse_eq: "a \ 0 \ inverse (inverse a) = a" by (rule inverse_unique) simp lemma nonzero_inverse_eq_imp_eq: assumes "inverse a = inverse b" and "a \ 0" and "b \ 0" shows "a = b" proof - from \inverse a = inverse b\ have "inverse (inverse a) = inverse (inverse b)" by (rule arg_cong) with \a \ 0\ and \b \ 0\ show "a = b" by (simp add: nonzero_inverse_inverse_eq) qed lemma inverse_1 [simp]: "inverse 1 = 1" by (rule inverse_unique) simp lemma nonzero_inverse_mult_distrib: assumes "a \ 0" and "b \ 0" shows "inverse (a * b) = inverse b * inverse a" proof - have "a * (b * inverse b) * inverse a = 1" using assms by simp hence "a * b * (inverse b * inverse a) = 1" by (simp only: mult.assoc) thus ?thesis by (rule inverse_unique) qed lemma division_ring_inverse_add: "a \ 0 \ b \ 0 \ inverse a + inverse b = inverse a * (a + b) * inverse b" by (simp add: algebra_simps) lemma division_ring_inverse_diff: "a \ 0 \ b \ 0 \ inverse a - inverse b = inverse a * (b - a) * inverse b" by (simp add: algebra_simps) lemma right_inverse_eq: "b \ 0 \ a / b = 1 \ a = b" proof assume neq: "b \ 0" { hence "a = (a / b) * b" by (simp add: divide_inverse mult.assoc) also assume "a / b = 1" finally show "a = b" by simp next assume "a = b" with neq show "a / b = 1" by (simp add: divide_inverse) } qed lemma nonzero_inverse_eq_divide: "a \ 0 \ inverse a = 1 / a" by (simp add: divide_inverse) lemma divide_self [simp]: "a \ 0 \ a / a = 1" by (simp add: divide_inverse) lemma inverse_eq_divide [field_simps, field_split_simps, divide_simps]: "inverse a = 1 / a" by (simp add: divide_inverse) lemma add_divide_distrib: "(a+b) / c = a/c + b/c" by (simp add: divide_inverse algebra_simps) lemma times_divide_eq_right [simp]: "a * (b / c) = (a * b) / c" by (simp add: divide_inverse mult.assoc) lemma minus_divide_left: "- (a / b) = (-a) / b" by (simp add: divide_inverse) lemma nonzero_minus_divide_right: "b \ 0 \ - (a / b) = a / (- b)" by (simp add: divide_inverse nonzero_inverse_minus_eq) lemma nonzero_minus_divide_divide: "b \ 0 \ (-a) / (-b) = a / b" by (simp add: divide_inverse nonzero_inverse_minus_eq) lemma divide_minus_left [simp]: "(-a) / b = - (a / b)" by (simp add: divide_inverse) lemma diff_divide_distrib: "(a - b) / c = a / c - b / c" using add_divide_distrib [of a "- b" c] by simp lemma nonzero_eq_divide_eq [field_simps]: "c \ 0 \ a = b / c \ a * c = b" proof - assume [simp]: "c \ 0" have "a = b / c \ a * c = (b / c) * c" by simp also have "... \ a * c = b" by (simp add: divide_inverse mult.assoc) finally show ?thesis . qed lemma nonzero_divide_eq_eq [field_simps]: "c \ 0 \ b / c = a \ b = a * c" proof - assume [simp]: "c \ 0" have "b / c = a \ (b / c) * c = a * c" by simp also have "... \ b = a * c" by (simp add: divide_inverse mult.assoc) finally show ?thesis . qed lemma nonzero_neg_divide_eq_eq [field_simps]: "b \ 0 \ - (a / b) = c \ - a = c * b" using nonzero_divide_eq_eq[of b "-a" c] by simp lemma nonzero_neg_divide_eq_eq2 [field_simps]: "b \ 0 \ c = - (a / b) \ c * b = - a" using nonzero_neg_divide_eq_eq[of b a c] by auto lemma divide_eq_imp: "c \ 0 \ b = a * c \ b / c = a" by (simp add: divide_inverse mult.assoc) lemma eq_divide_imp: "c \ 0 \ a * c = b \ a = b / c" by (drule sym) (simp add: divide_inverse mult.assoc) lemma add_divide_eq_iff [field_simps]: "z \ 0 \ x + y / z = (x * z + y) / z" by (simp add: add_divide_distrib nonzero_eq_divide_eq) lemma divide_add_eq_iff [field_simps]: "z \ 0 \ x / z + y = (x + y * z) / z" by (simp add: add_divide_distrib nonzero_eq_divide_eq) lemma diff_divide_eq_iff [field_simps]: "z \ 0 \ x - y / z = (x * z - y) / z" by (simp add: diff_divide_distrib nonzero_eq_divide_eq eq_diff_eq) lemma minus_divide_add_eq_iff [field_simps]: "z \ 0 \ - (x / z) + y = (- x + y * z) / z" by (simp add: add_divide_distrib diff_divide_eq_iff) lemma divide_diff_eq_iff [field_simps]: "z \ 0 \ x / z - y = (x - y * z) / z" by (simp add: field_simps) lemma minus_divide_diff_eq_iff [field_simps]: "z \ 0 \ - (x / z) - y = (- x - y * z) / z" by (simp add: divide_diff_eq_iff[symmetric]) lemma division_ring_divide_zero [simp]: "a / 0 = 0" by (simp add: divide_inverse) lemma divide_self_if [simp]: "a / a = (if a = 0 then 0 else 1)" by simp lemma inverse_nonzero_iff_nonzero [simp]: "inverse a = 0 \ a = 0" by rule (fact inverse_zero_imp_zero, simp) lemma inverse_minus_eq [simp]: "inverse (- a) = - inverse a" proof cases assume "a=0" thus ?thesis by simp next assume "a\0" thus ?thesis by (simp add: nonzero_inverse_minus_eq) qed lemma inverse_inverse_eq [simp]: "inverse (inverse a) = a" proof cases assume "a=0" thus ?thesis by simp next assume "a\0" thus ?thesis by (simp add: nonzero_inverse_inverse_eq) qed lemma inverse_eq_imp_eq: "inverse a = inverse b \ a = b" by (drule arg_cong [where f="inverse"], simp) lemma inverse_eq_iff_eq [simp]: "inverse a = inverse b \ a = b" by (force dest!: inverse_eq_imp_eq) lemma mult_commute_imp_mult_inverse_commute: assumes "y * x = x * y" shows "inverse y * x = x * inverse y" proof (cases "y=0") case False hence "x * inverse y = inverse y * y * x * inverse y" by simp also have "\ = inverse y * (x * y * inverse y)" by (simp add: mult.assoc assms) finally show ?thesis by (simp add: mult.assoc False) qed simp lemmas mult_inverse_of_nat_commute = mult_commute_imp_mult_inverse_commute[OF mult_of_nat_commute] lemma divide_divide_eq_left': "(a / b) / c = a / (c * b)" by (cases "b = 0 \ c = 0") (auto simp: divide_inverse mult.assoc nonzero_inverse_mult_distrib) lemma add_divide_eq_if_simps [field_split_simps, divide_simps]: "a + b / z = (if z = 0 then a else (a * z + b) / z)" "a / z + b = (if z = 0 then b else (a + b * z) / z)" "- (a / z) + b = (if z = 0 then b else (-a + b * z) / z)" "a - b / z = (if z = 0 then a else (a * z - b) / z)" "a / z - b = (if z = 0 then -b else (a - b * z) / z)" "- (a / z) - b = (if z = 0 then -b else (- a - b * z) / z)" by (simp_all add: add_divide_eq_iff divide_add_eq_iff diff_divide_eq_iff divide_diff_eq_iff minus_divide_diff_eq_iff) lemma [field_split_simps, divide_simps]: shows divide_eq_eq: "b / c = a \ (if c \ 0 then b = a * c else a = 0)" and eq_divide_eq: "a = b / c \ (if c \ 0 then a * c = b else a = 0)" and minus_divide_eq_eq: "- (b / c) = a \ (if c \ 0 then - b = a * c else a = 0)" and eq_minus_divide_eq: "a = - (b / c) \ (if c \ 0 then a * c = - b else a = 0)" by (auto simp add: field_simps) end subsection \Fields\ class field = comm_ring_1 + inverse + assumes field_inverse: "a \ 0 \ inverse a * a = 1" assumes field_divide_inverse: "a / b = a * inverse b" assumes field_inverse_zero: "inverse 0 = 0" begin subclass division_ring proof fix a :: 'a assume "a \ 0" thus "inverse a * a = 1" by (rule field_inverse) thus "a * inverse a = 1" by (simp only: mult.commute) next fix a b :: 'a show "a / b = a * inverse b" by (rule field_divide_inverse) next show "inverse 0 = 0" by (fact field_inverse_zero) qed subclass idom_divide proof fix b a assume "b \ 0" then show "a * b / b = a" by (simp add: divide_inverse ac_simps) next fix a show "a / 0 = 0" by (simp add: divide_inverse) qed text\There is no slick version using division by zero.\ lemma inverse_add: "a \ 0 \ b \ 0 \ inverse a + inverse b = (a + b) * inverse a * inverse b" by (simp add: division_ring_inverse_add ac_simps) lemma nonzero_mult_divide_mult_cancel_left [simp]: assumes [simp]: "c \ 0" shows "(c * a) / (c * b) = a / b" proof (cases "b = 0") case True then show ?thesis by simp next case False then have "(c*a)/(c*b) = c * a * (inverse b * inverse c)" by (simp add: divide_inverse nonzero_inverse_mult_distrib) also have "... = a * inverse b * (inverse c * c)" by (simp only: ac_simps) also have "... = a * inverse b" by simp finally show ?thesis by (simp add: divide_inverse) qed lemma nonzero_mult_divide_mult_cancel_right [simp]: "c \ 0 \ (a * c) / (b * c) = a / b" using nonzero_mult_divide_mult_cancel_left [of c a b] by (simp add: ac_simps) lemma times_divide_eq_left [simp]: "(b / c) * a = (b * a) / c" by (simp add: divide_inverse ac_simps) lemma divide_inverse_commute: "a / b = inverse b * a" by (simp add: divide_inverse mult.commute) lemma add_frac_eq: assumes "y \ 0" and "z \ 0" shows "x / y + w / z = (x * z + w * y) / (y * z)" proof - have "x / y + w / z = (x * z) / (y * z) + (y * w) / (y * z)" using assms by simp also have "\ = (x * z + y * w) / (y * z)" by (simp only: add_divide_distrib) finally show ?thesis by (simp only: mult.commute) qed text\Special Cancellation Simprules for Division\ lemma nonzero_divide_mult_cancel_right [simp]: "b \ 0 \ b / (a * b) = 1 / a" using nonzero_mult_divide_mult_cancel_right [of b 1 a] by simp lemma nonzero_divide_mult_cancel_left [simp]: "a \ 0 \ a / (a * b) = 1 / b" using nonzero_mult_divide_mult_cancel_left [of a 1 b] by simp lemma nonzero_mult_divide_mult_cancel_left2 [simp]: "c \ 0 \ (c * a) / (b * c) = a / b" using nonzero_mult_divide_mult_cancel_left [of c a b] by (simp add: ac_simps) lemma nonzero_mult_divide_mult_cancel_right2 [simp]: "c \ 0 \ (a * c) / (c * b) = a / b" using nonzero_mult_divide_mult_cancel_right [of b c a] by (simp add: ac_simps) lemma diff_frac_eq: "y \ 0 \ z \ 0 \ x / y - w / z = (x * z - w * y) / (y * z)" by (simp add: field_simps) lemma frac_eq_eq: "y \ 0 \ z \ 0 \ (x / y = w / z) = (x * z = w * y)" by (simp add: field_simps) lemma divide_minus1 [simp]: "x / - 1 = - x" using nonzero_minus_divide_right [of "1" x] by simp text\This version builds in division by zero while also re-orienting the right-hand side.\ lemma inverse_mult_distrib [simp]: "inverse (a * b) = inverse a * inverse b" proof cases assume "a \ 0 \ b \ 0" thus ?thesis by (simp add: nonzero_inverse_mult_distrib ac_simps) next assume "\ (a \ 0 \ b \ 0)" thus ?thesis by force qed lemma inverse_divide [simp]: "inverse (a / b) = b / a" by (simp add: divide_inverse mult.commute) text \Calculations with fractions\ text\There is a whole bunch of simp-rules just for class \field\ but none for class \field\ and \nonzero_divides\ because the latter are covered by a simproc.\ lemmas mult_divide_mult_cancel_left = nonzero_mult_divide_mult_cancel_left lemmas mult_divide_mult_cancel_right = nonzero_mult_divide_mult_cancel_right lemma divide_divide_eq_right [simp]: "a / (b / c) = (a * c) / b" by (simp add: divide_inverse ac_simps) lemma divide_divide_eq_left [simp]: "(a / b) / c = a / (b * c)" by (simp add: divide_inverse mult.assoc) lemma divide_divide_times_eq: "(x / y) / (z / w) = (x * w) / (y * z)" by simp text \Special Cancellation Simprules for Division\ lemma mult_divide_mult_cancel_left_if [simp]: shows "(c * a) / (c * b) = (if c = 0 then 0 else a / b)" by simp text \Division and Unary Minus\ lemma minus_divide_right: "- (a / b) = a / - b" by (simp add: divide_inverse) lemma divide_minus_right [simp]: "a / - b = - (a / b)" by (simp add: divide_inverse) lemma minus_divide_divide: "(- a) / (- b) = a / b" by (cases "b=0") (simp_all add: nonzero_minus_divide_divide) lemma inverse_eq_1_iff [simp]: "inverse x = 1 \ x = 1" by (insert inverse_eq_iff_eq [of x 1], simp) lemma divide_eq_0_iff [simp]: "a / b = 0 \ a = 0 \ b = 0" by (simp add: divide_inverse) lemma divide_cancel_right [simp]: "a / c = b / c \ c = 0 \ a = b" by (cases "c=0") (simp_all add: divide_inverse) lemma divide_cancel_left [simp]: "c / a = c / b \ c = 0 \ a = b" by (cases "c=0") (simp_all add: divide_inverse) lemma divide_eq_1_iff [simp]: "a / b = 1 \ b \ 0 \ a = b" by (cases "b=0") (simp_all add: right_inverse_eq) lemma one_eq_divide_iff [simp]: "1 = a / b \ b \ 0 \ a = b" by (simp add: eq_commute [of 1]) lemma divide_eq_minus_1_iff: "(a / b = - 1) \ b \ 0 \ a = - b" using divide_eq_1_iff by fastforce lemma times_divide_times_eq: "(x / y) * (z / w) = (x * z) / (y * w)" by simp lemma add_frac_num: "y \ 0 \ x / y + z = (x + z * y) / y" by (simp add: add_divide_distrib) lemma add_num_frac: "y \ 0 \ z + x / y = (x + z * y) / y" by (simp add: add_divide_distrib add.commute) lemma dvd_field_iff: "a dvd b \ (a = 0 \ b = 0)" proof (cases "a = 0") case False then have "b = a * (b / a)" by (simp add: field_simps) then have "a dvd b" .. with False show ?thesis by simp qed simp lemma inj_divide_right [simp]: "inj (\b. b / a) \ a \ 0" proof - have "(\b. b / a) = (*) (inverse a)" by (simp add: field_simps fun_eq_iff) then have "inj (\y. y / a) \ inj ((*) (inverse a))" by simp also have "\ \ inverse a \ 0" by simp also have "\ \ a \ 0" by simp finally show ?thesis by simp qed end class field_char_0 = field + ring_char_0 subsection \Ordered fields\ class field_abs_sgn = field + idom_abs_sgn begin lemma sgn_inverse [simp]: "sgn (inverse a) = inverse (sgn a)" proof (cases "a = 0") case True then show ?thesis by simp next case False then have "a * inverse a = 1" by simp then have "sgn (a * inverse a) = sgn 1" by simp then have "sgn a * sgn (inverse a) = 1" by (simp add: sgn_mult) then have "inverse (sgn a) * (sgn a * sgn (inverse a)) = inverse (sgn a) * 1" by simp then have "(inverse (sgn a) * sgn a) * sgn (inverse a) = inverse (sgn a)" by (simp add: ac_simps) with False show ?thesis by (simp add: sgn_eq_0_iff) qed lemma abs_inverse [simp]: "\inverse a\ = inverse \a\" proof - from sgn_mult_abs [of "inverse a"] sgn_mult_abs [of a] have "inverse (sgn a) * \inverse a\ = inverse (sgn a * \a\)" by simp then show ?thesis by (auto simp add: sgn_eq_0_iff) qed lemma sgn_divide [simp]: "sgn (a / b) = sgn a / sgn b" unfolding divide_inverse sgn_mult by simp lemma abs_divide [simp]: "\a / b\ = \a\ / \b\" unfolding divide_inverse abs_mult by simp end class linordered_field = field + linordered_idom begin lemma positive_imp_inverse_positive: assumes a_gt_0: "0 < a" shows "0 < inverse a" proof - have "0 < a * inverse a" by (simp add: a_gt_0 [THEN less_imp_not_eq2]) thus "0 < inverse a" by (simp add: a_gt_0 [THEN less_not_sym] zero_less_mult_iff) qed lemma negative_imp_inverse_negative: "a < 0 \ inverse a < 0" by (insert positive_imp_inverse_positive [of "-a"], simp add: nonzero_inverse_minus_eq less_imp_not_eq) lemma inverse_le_imp_le: assumes invle: "inverse a \ inverse b" and apos: "0 < a" shows "b \ a" proof (rule classical) assume "\ b \ a" hence "a < b" by (simp add: linorder_not_le) hence bpos: "0 < b" by (blast intro: apos less_trans) hence "a * inverse a \ a * inverse b" by (simp add: apos invle less_imp_le mult_left_mono) hence "(a * inverse a) * b \ (a * inverse b) * b" by (simp add: bpos less_imp_le mult_right_mono) thus "b \ a" by (simp add: mult.assoc apos bpos less_imp_not_eq2) qed lemma inverse_positive_imp_positive: assumes inv_gt_0: "0 < inverse a" and nz: "a \ 0" shows "0 < a" proof - have "0 < inverse (inverse a)" using inv_gt_0 by (rule positive_imp_inverse_positive) thus "0 < a" using nz by (simp add: nonzero_inverse_inverse_eq) qed lemma inverse_negative_imp_negative: assumes inv_less_0: "inverse a < 0" and nz: "a \ 0" shows "a < 0" proof - have "inverse (inverse a) < 0" using inv_less_0 by (rule negative_imp_inverse_negative) thus "a < 0" using nz by (simp add: nonzero_inverse_inverse_eq) qed lemma linordered_field_no_lb: "\x. \y. y < x" proof fix x::'a have m1: "- (1::'a) < 0" by simp from add_strict_right_mono[OF m1, where c=x] have "(- 1) + x < x" by simp thus "\y. y < x" by blast qed lemma linordered_field_no_ub: "\ x. \y. y > x" proof fix x::'a have m1: " (1::'a) > 0" by simp from add_strict_right_mono[OF m1, where c=x] have "1 + x > x" by simp thus "\y. y > x" by blast qed lemma less_imp_inverse_less: assumes less: "a < b" and apos: "0 < a" shows "inverse b < inverse a" proof (rule ccontr) assume "\ inverse b < inverse a" hence "inverse a \ inverse b" by simp hence "\ (a < b)" by (simp add: not_less inverse_le_imp_le [OF _ apos]) thus False by (rule notE [OF _ less]) qed lemma inverse_less_imp_less: assumes "inverse a < inverse b" "0 < a" shows "b < a" proof - have "a \ b" using assms by (simp add: less_le) moreover have "b \ a" using assms by (force simp: less_le dest: inverse_le_imp_le) ultimately show ?thesis by (simp add: less_le) qed text\Both premises are essential. Consider -1 and 1.\ lemma inverse_less_iff_less [simp]: "0 < a \ 0 < b \ inverse a < inverse b \ b < a" by (blast intro: less_imp_inverse_less dest: inverse_less_imp_less) lemma le_imp_inverse_le: "a \ b \ 0 < a \ inverse b \ inverse a" by (force simp add: le_less less_imp_inverse_less) lemma inverse_le_iff_le [simp]: "0 < a \ 0 < b \ inverse a \ inverse b \ b \ a" by (blast intro: le_imp_inverse_le dest: inverse_le_imp_le) text\These results refer to both operands being negative. The opposite-sign case is trivial, since inverse preserves signs.\ lemma inverse_le_imp_le_neg: assumes "inverse a \ inverse b" "b < 0" shows "b \ a" proof (rule classical) assume "\ b \ a" with \b < 0\ have "a < 0" by force with assms show "b \ a" using inverse_le_imp_le [of "-b" "-a"] by (simp add: nonzero_inverse_minus_eq) qed lemma less_imp_inverse_less_neg: assumes "a < b" "b < 0" shows "inverse b < inverse a" proof - have "a < 0" using assms by (blast intro: less_trans) with less_imp_inverse_less [of "-b" "-a"] show ?thesis by (simp add: nonzero_inverse_minus_eq assms) qed lemma inverse_less_imp_less_neg: assumes "inverse a < inverse b" "b < 0" shows "b < a" proof (rule classical) assume "\ b < a" with \b < 0\ have "a < 0" by force with inverse_less_imp_less [of "-b" "-a"] show ?thesis by (simp add: nonzero_inverse_minus_eq assms) qed lemma inverse_less_iff_less_neg [simp]: "a < 0 \ b < 0 \ inverse a < inverse b \ b < a" using inverse_less_iff_less [of "-b" "-a"] by (simp del: inverse_less_iff_less add: nonzero_inverse_minus_eq) lemma le_imp_inverse_le_neg: "a \ b \ b < 0 \ inverse b \ inverse a" by (force simp add: le_less less_imp_inverse_less_neg) lemma inverse_le_iff_le_neg [simp]: "a < 0 \ b < 0 \ inverse a \ inverse b \ b \ a" by (blast intro: le_imp_inverse_le_neg dest: inverse_le_imp_le_neg) lemma one_less_inverse: "0 < a \ a < 1 \ 1 < inverse a" using less_imp_inverse_less [of a 1, unfolded inverse_1] . lemma one_le_inverse: "0 < a \ a \ 1 \ 1 \ inverse a" using le_imp_inverse_le [of a 1, unfolded inverse_1] . lemma pos_le_divide_eq [field_simps]: assumes "0 < c" shows "a \ b / c \ a * c \ b" proof - from assms have "a \ b / c \ a * c \ (b / c) * c" using mult_le_cancel_right [of a c "b * inverse c"] by (auto simp add: field_simps) also have "... \ a * c \ b" by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma pos_less_divide_eq [field_simps]: assumes "0 < c" shows "a < b / c \ a * c < b" proof - from assms have "a < b / c \ a * c < (b / c) * c" using mult_less_cancel_right [of a c "b / c"] by auto also have "... = (a*c < b)" by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma neg_less_divide_eq [field_simps]: assumes "c < 0" shows "a < b / c \ b < a * c" proof - from assms have "a < b / c \ (b / c) * c < a * c" using mult_less_cancel_right [of "b / c" c a] by auto also have "... \ b < a * c" by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma neg_le_divide_eq [field_simps]: assumes "c < 0" shows "a \ b / c \ b \ a * c" proof - from assms have "a \ b / c \ (b / c) * c \ a * c" using mult_le_cancel_right [of "b * inverse c" c a] by (auto simp add: field_simps) also have "... \ b \ a * c" by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma pos_divide_le_eq [field_simps]: assumes "0 < c" shows "b / c \ a \ b \ a * c" proof - from assms have "b / c \ a \ (b / c) * c \ a * c" using mult_le_cancel_right [of "b / c" c a] by auto also have "... \ b \ a * c" by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma pos_divide_less_eq [field_simps]: assumes "0 < c" shows "b / c < a \ b < a * c" proof - from assms have "b / c < a \ (b / c) * c < a * c" using mult_less_cancel_right [of "b / c" c a] by auto also have "... \ b < a * c" by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma neg_divide_le_eq [field_simps]: assumes "c < 0" shows "b / c \ a \ a * c \ b" proof - from assms have "b / c \ a \ a * c \ (b / c) * c" using mult_le_cancel_right [of a c "b / c"] by auto also have "... \ a * c \ b" by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed lemma neg_divide_less_eq [field_simps]: assumes "c < 0" shows "b / c < a \ a * c < b" proof - from assms have "b / c < a \ a * c < b / c * c" using mult_less_cancel_right [of a c "b / c"] by auto also have "... \ a * c < b" by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc) finally show ?thesis . qed text\The following \field_simps\ rules are necessary, as minus is always moved atop of division but we want to get rid of division.\ lemma pos_le_minus_divide_eq [field_simps]: "0 < c \ a \ - (b / c) \ a * c \ - b" unfolding minus_divide_left by (rule pos_le_divide_eq) lemma neg_le_minus_divide_eq [field_simps]: "c < 0 \ a \ - (b / c) \ - b \ a * c" unfolding minus_divide_left by (rule neg_le_divide_eq) lemma pos_less_minus_divide_eq [field_simps]: "0 < c \ a < - (b / c) \ a * c < - b" unfolding minus_divide_left by (rule pos_less_divide_eq) lemma neg_less_minus_divide_eq [field_simps]: "c < 0 \ a < - (b / c) \ - b < a * c" unfolding minus_divide_left by (rule neg_less_divide_eq) lemma pos_minus_divide_less_eq [field_simps]: "0 < c \ - (b / c) < a \ - b < a * c" unfolding minus_divide_left by (rule pos_divide_less_eq) lemma neg_minus_divide_less_eq [field_simps]: "c < 0 \ - (b / c) < a \ a * c < - b" unfolding minus_divide_left by (rule neg_divide_less_eq) lemma pos_minus_divide_le_eq [field_simps]: "0 < c \ - (b / c) \ a \ - b \ a * c" unfolding minus_divide_left by (rule pos_divide_le_eq) lemma neg_minus_divide_le_eq [field_simps]: "c < 0 \ - (b / c) \ a \ a * c \ - b" unfolding minus_divide_left by (rule neg_divide_le_eq) lemma frac_less_eq: "y \ 0 \ z \ 0 \ x / y < w / z \ (x * z - w * y) / (y * z) < 0" by (subst less_iff_diff_less_0) (simp add: diff_frac_eq ) lemma frac_le_eq: "y \ 0 \ z \ 0 \ x / y \ w / z \ (x * z - w * y) / (y * z) \ 0" by (subst le_iff_diff_le_0) (simp add: diff_frac_eq ) lemma divide_pos_pos[simp]: "0 < x \ 0 < y \ 0 < x / y" by(simp add:field_simps) lemma divide_nonneg_pos: "0 \ x \ 0 < y \ 0 \ x / y" by(simp add:field_simps) lemma divide_neg_pos: "x < 0 \ 0 < y \ x / y < 0" by(simp add:field_simps) lemma divide_nonpos_pos: "x \ 0 \ 0 < y \ x / y \ 0" by(simp add:field_simps) lemma divide_pos_neg: "0 < x \ y < 0 \ x / y < 0" by(simp add:field_simps) lemma divide_nonneg_neg: "0 \ x \ y < 0 \ x / y \ 0" by(simp add:field_simps) lemma divide_neg_neg: "x < 0 \ y < 0 \ 0 < x / y" by(simp add:field_simps) lemma divide_nonpos_neg: "x \ 0 \ y < 0 \ 0 \ x / y" by(simp add:field_simps) lemma divide_strict_right_mono: "\a < b; 0 < c\ \ a / c < b / c" by (simp add: less_imp_not_eq2 divide_inverse mult_strict_right_mono positive_imp_inverse_positive) lemma divide_strict_right_mono_neg: assumes "b < a" "c < 0" shows "a / c < b / c" proof - have "b / - c < a / - c" by (rule divide_strict_right_mono) (use assms in auto) then show ?thesis by (simp add: less_imp_not_eq) qed text\The last premise ensures that \<^term>\a\ and \<^term>\b\ have the same sign\ lemma divide_strict_left_mono: "\b < a; 0 < c; 0 < a*b\ \ c / a < c / b" by (auto simp: field_simps zero_less_mult_iff mult_strict_right_mono) lemma divide_left_mono: "\b \ a; 0 \ c; 0 < a*b\ \ c / a \ c / b" by (auto simp: field_simps zero_less_mult_iff mult_right_mono) lemma divide_strict_left_mono_neg: "\a < b; c < 0; 0 < a*b\ \ c / a < c / b" by (auto simp: field_simps zero_less_mult_iff mult_strict_right_mono_neg) lemma mult_imp_div_pos_le: "0 < y \ x \ z * y \ x / y \ z" by (subst pos_divide_le_eq, assumption+) lemma mult_imp_le_div_pos: "0 < y \ z * y \ x \ z \ x / y" by(simp add:field_simps) lemma mult_imp_div_pos_less: "0 < y \ x < z * y \ x / y < z" by(simp add:field_simps) lemma mult_imp_less_div_pos: "0 < y \ z * y < x \ z < x / y" by(simp add:field_simps) lemma frac_le: assumes "0 \ y" "x \ y" "0 < w" "w \ z" shows "x / z \ y / w" proof (rule mult_imp_div_pos_le) show "z > 0" using assms by simp have "x \ y * z / w" proof (rule mult_imp_le_div_pos [OF \0 < w\]) show "x * w \ y * z" using assms by (auto intro: mult_mono) qed also have "... = y / w * z" by simp finally show "x \ y / w * z" . qed lemma frac_less: assumes "0 \ x" "x < y" "0 < w" "w \ z" shows "x / z < y / w" proof (rule mult_imp_div_pos_less) show "z > 0" using assms by simp have "x < y * z / w" proof (rule mult_imp_less_div_pos [OF \0 < w\]) show "x * w < y * z" using assms by (auto intro: mult_less_le_imp_less) qed also have "... = y / w * z" by simp finally show "x < y / w * z" . qed lemma frac_less2: assumes "0 < x" "x \ y" "0 < w" "w < z" shows "x / z < y / w" proof (rule mult_imp_div_pos_less) show "z > 0" using assms by simp show "x < y / w * z" using assms by (force intro: mult_imp_less_div_pos mult_le_less_imp_less) qed lemma less_half_sum: "a < b \ a < (a+b) / (1+1)" by (simp add: field_simps zero_less_two) lemma gt_half_sum: "a < b \ (a+b)/(1+1) < b" by (simp add: field_simps zero_less_two) subclass unbounded_dense_linorder proof fix x y :: 'a from less_add_one show "\y. x < y" .. from less_add_one have "x + (- 1) < (x + 1) + (- 1)" by (rule add_strict_right_mono) then have "x - 1 < x + 1 - 1" by simp then have "x - 1 < x" by (simp add: algebra_simps) then show "\y. y < x" .. show "x < y \ \z>x. z < y" by (blast intro!: less_half_sum gt_half_sum) qed subclass field_abs_sgn .. lemma inverse_sgn [simp]: "inverse (sgn a) = sgn a" by (cases a 0 rule: linorder_cases) simp_all lemma divide_sgn [simp]: "a / sgn b = a * sgn b" by (cases b 0 rule: linorder_cases) simp_all lemma nonzero_abs_inverse: "a \ 0 \ \inverse a\ = inverse \a\" by (rule abs_inverse) lemma nonzero_abs_divide: "b \ 0 \ \a / b\ = \a\ / \b\" by (rule abs_divide) lemma field_le_epsilon: assumes e: "\e. 0 < e \ x \ y + e" shows "x \ y" proof (rule dense_le) fix t assume "t < x" hence "0 < x - t" by (simp add: less_diff_eq) from e [OF this] have "x + 0 \ x + (y - t)" by (simp add: algebra_simps) then have "0 \ y - t" by (simp only: add_le_cancel_left) then show "t \ y" by (simp add: algebra_simps) qed lemma inverse_positive_iff_positive [simp]: "(0 < inverse a) = (0 < a)" proof (cases "a = 0") case False then show ?thesis by (blast intro: inverse_positive_imp_positive positive_imp_inverse_positive) qed auto lemma inverse_negative_iff_negative [simp]: "(inverse a < 0) = (a < 0)" proof (cases "a = 0") case False then show ?thesis by (blast intro: inverse_negative_imp_negative negative_imp_inverse_negative) qed auto lemma inverse_nonnegative_iff_nonnegative [simp]: "0 \ inverse a \ 0 \ a" by (simp add: not_less [symmetric]) lemma inverse_nonpositive_iff_nonpositive [simp]: "inverse a \ 0 \ a \ 0" by (simp add: not_less [symmetric]) lemma one_less_inverse_iff: "1 < inverse x \ 0 < x \ x < 1" using less_trans[of 1 x 0 for x] by (cases x 0 rule: linorder_cases) (auto simp add: field_simps) lemma one_le_inverse_iff: "1 \ inverse x \ 0 < x \ x \ 1" proof (cases "x = 1") case True then show ?thesis by simp next case False then have "inverse x \ 1" by simp then have "1 \ inverse x" by blast then have "1 \ inverse x \ 1 < inverse x" by (simp add: le_less) with False show ?thesis by (auto simp add: one_less_inverse_iff) qed lemma inverse_less_1_iff: "inverse x < 1 \ x \ 0 \ 1 < x" by (simp add: not_le [symmetric] one_le_inverse_iff) lemma inverse_le_1_iff: "inverse x \ 1 \ x \ 0 \ 1 \ x" by (simp add: not_less [symmetric] one_less_inverse_iff) lemma [field_split_simps, divide_simps]: shows le_divide_eq: "a \ b / c \ (if 0 < c then a * c \ b else if c < 0 then b \ a * c else a \ 0)" and divide_le_eq: "b / c \ a \ (if 0 < c then b \ a * c else if c < 0 then a * c \ b else 0 \ a)" and less_divide_eq: "a < b / c \ (if 0 < c then a * c < b else if c < 0 then b < a * c else a < 0)" and divide_less_eq: "b / c < a \ (if 0 < c then b < a * c else if c < 0 then a * c < b else 0 < a)" and le_minus_divide_eq: "a \ - (b / c) \ (if 0 < c then a * c \ - b else if c < 0 then - b \ a * c else a \ 0)" and minus_divide_le_eq: "- (b / c) \ a \ (if 0 < c then - b \ a * c else if c < 0 then a * c \ - b else 0 \ a)" and less_minus_divide_eq: "a < - (b / c) \ (if 0 < c then a * c < - b else if c < 0 then - b < a * c else a < 0)" and minus_divide_less_eq: "- (b / c) < a \ (if 0 < c then - b < a * c else if c < 0 then a * c < - b else 0 < a)" - by (auto simp: field_simps not_less dest: antisym) + by (auto simp: field_simps not_less dest: order.antisym) text \Division and Signs\ lemma shows zero_less_divide_iff: "0 < a / b \ 0 < a \ 0 < b \ a < 0 \ b < 0" and divide_less_0_iff: "a / b < 0 \ 0 < a \ b < 0 \ a < 0 \ 0 < b" and zero_le_divide_iff: "0 \ a / b \ 0 \ a \ 0 \ b \ a \ 0 \ b \ 0" and divide_le_0_iff: "a / b \ 0 \ 0 \ a \ b \ 0 \ a \ 0 \ 0 \ b" by (auto simp add: field_split_simps) text \Division and the Number One\ text\Simplify expressions equated with 1\ lemma zero_eq_1_divide_iff [simp]: "0 = 1 / a \ a = 0" by (cases "a = 0") (auto simp: field_simps) lemma one_divide_eq_0_iff [simp]: "1 / a = 0 \ a = 0" using zero_eq_1_divide_iff[of a] by simp text\Simplify expressions such as \0 < 1/x\ to \0 < x\\ lemma zero_le_divide_1_iff [simp]: "0 \ 1 / a \ 0 \ a" by (simp add: zero_le_divide_iff) lemma zero_less_divide_1_iff [simp]: "0 < 1 / a \ 0 < a" by (simp add: zero_less_divide_iff) lemma divide_le_0_1_iff [simp]: "1 / a \ 0 \ a \ 0" by (simp add: divide_le_0_iff) lemma divide_less_0_1_iff [simp]: "1 / a < 0 \ a < 0" by (simp add: divide_less_0_iff) lemma divide_right_mono: "\a \ b; 0 \ c\ \ a/c \ b/c" by (force simp add: divide_strict_right_mono le_less) lemma divide_right_mono_neg: "a \ b \ c \ 0 \ b / c \ a / c" by (auto dest: divide_right_mono [of _ _ "- c"]) lemma divide_left_mono_neg: "a \ b \ c \ 0 \ 0 < a * b \ c / a \ c / b" by (auto simp add: mult.commute dest: divide_left_mono [of _ _ "- c"]) lemma inverse_le_iff: "inverse a \ inverse b \ (0 < a * b \ b \ a) \ (a * b \ 0 \ a \ b)" by (cases a 0 b 0 rule: linorder_cases[case_product linorder_cases]) (auto simp add: field_simps zero_less_mult_iff mult_le_0_iff) lemma inverse_less_iff: "inverse a < inverse b \ (0 < a * b \ b < a) \ (a * b \ 0 \ a < b)" by (subst less_le) (auto simp: inverse_le_iff) lemma divide_le_cancel: "a / c \ b / c \ (0 < c \ a \ b) \ (c < 0 \ b \ a)" by (simp add: divide_inverse mult_le_cancel_right) lemma divide_less_cancel: "a / c < b / c \ (0 < c \ a < b) \ (c < 0 \ b < a) \ c \ 0" by (auto simp add: divide_inverse mult_less_cancel_right) text\Simplify quotients that are compared with the value 1.\ lemma le_divide_eq_1: "(1 \ b / a) = ((0 < a \ a \ b) \ (a < 0 \ b \ a))" by (auto simp add: le_divide_eq) lemma divide_le_eq_1: "(b / a \ 1) = ((0 < a \ b \ a) \ (a < 0 \ a \ b) \ a=0)" by (auto simp add: divide_le_eq) lemma less_divide_eq_1: "(1 < b / a) = ((0 < a \ a < b) \ (a < 0 \ b < a))" by (auto simp add: less_divide_eq) lemma divide_less_eq_1: "(b / a < 1) = ((0 < a \ b < a) \ (a < 0 \ a < b) \ a=0)" by (auto simp add: divide_less_eq) lemma divide_nonneg_nonneg [simp]: "0 \ x \ 0 \ y \ 0 \ x / y" by (auto simp add: field_split_simps) lemma divide_nonpos_nonpos: "x \ 0 \ y \ 0 \ 0 \ x / y" by (auto simp add: field_split_simps) lemma divide_nonneg_nonpos: "0 \ x \ y \ 0 \ x / y \ 0" by (auto simp add: field_split_simps) lemma divide_nonpos_nonneg: "x \ 0 \ 0 \ y \ x / y \ 0" by (auto simp add: field_split_simps) text \Conditional Simplification Rules: No Case Splits\ lemma le_divide_eq_1_pos [simp]: "0 < a \ (1 \ b/a) = (a \ b)" by (auto simp add: le_divide_eq) lemma le_divide_eq_1_neg [simp]: "a < 0 \ (1 \ b/a) = (b \ a)" by (auto simp add: le_divide_eq) lemma divide_le_eq_1_pos [simp]: "0 < a \ (b/a \ 1) = (b \ a)" by (auto simp add: divide_le_eq) lemma divide_le_eq_1_neg [simp]: "a < 0 \ (b/a \ 1) = (a \ b)" by (auto simp add: divide_le_eq) lemma less_divide_eq_1_pos [simp]: "0 < a \ (1 < b/a) = (a < b)" by (auto simp add: less_divide_eq) lemma less_divide_eq_1_neg [simp]: "a < 0 \ (1 < b/a) = (b < a)" by (auto simp add: less_divide_eq) lemma divide_less_eq_1_pos [simp]: "0 < a \ (b/a < 1) = (b < a)" by (auto simp add: divide_less_eq) lemma divide_less_eq_1_neg [simp]: "a < 0 \ b/a < 1 \ a < b" by (auto simp add: divide_less_eq) lemma eq_divide_eq_1 [simp]: "(1 = b/a) = ((a \ 0 \ a = b))" by (auto simp add: eq_divide_eq) lemma divide_eq_eq_1 [simp]: "(b/a = 1) = ((a \ 0 \ a = b))" by (auto simp add: divide_eq_eq) lemma abs_div_pos: "0 < y \ \x\ / y = \x / y\" by (simp add: order_less_imp_le) lemma zero_le_divide_abs_iff [simp]: "(0 \ a / \b\) = (0 \ a \ b = 0)" by (auto simp: zero_le_divide_iff) lemma divide_le_0_abs_iff [simp]: "(a / \b\ \ 0) = (a \ 0 \ b = 0)" by (auto simp: divide_le_0_iff) lemma field_le_mult_one_interval: assumes *: "\z. \ 0 < z ; z < 1 \ \ z * x \ y" shows "x \ y" proof (cases "0 < x") assume "0 < x" thus ?thesis using dense_le_bounded[of 0 1 "y/x"] * unfolding le_divide_eq if_P[OF \0 < x\] by simp next assume "\0 < x" hence "x \ 0" by simp obtain s::'a where s: "0 < s" "s < 1" using dense[of 0 "1::'a"] by auto hence "x \ s * x" using mult_le_cancel_right[of 1 x s] \x \ 0\ by auto also note *[OF s] finally show ?thesis . qed text\For creating values between \<^term>\u\ and \<^term>\v\.\ lemma scaling_mono: assumes "u \ v" "0 \ r" "r \ s" shows "u + r * (v - u) / s \ v" proof - have "r/s \ 1" using assms using divide_le_eq_1 by fastforce moreover have "0 \ v - u" using assms by simp ultimately have "(r/s) * (v - u) \ 1 * (v - u)" by (rule mult_right_mono) then show ?thesis by (simp add: field_simps) qed end text \Min/max Simplification Rules\ lemma min_mult_distrib_left: fixes x::"'a::linordered_idom" shows "p * min x y = (if 0 \ p then min (p*x) (p*y) else max (p*x) (p*y))" by (auto simp add: min_def max_def mult_le_cancel_left) lemma min_mult_distrib_right: fixes x::"'a::linordered_idom" shows "min x y * p = (if 0 \ p then min (x*p) (y*p) else max (x*p) (y*p))" by (auto simp add: min_def max_def mult_le_cancel_right) lemma min_divide_distrib_right: fixes x::"'a::linordered_field" shows "min x y / p = (if 0 \ p then min (x/p) (y/p) else max (x/p) (y/p))" by (simp add: min_mult_distrib_right divide_inverse) lemma max_mult_distrib_left: fixes x::"'a::linordered_idom" shows "p * max x y = (if 0 \ p then max (p*x) (p*y) else min (p*x) (p*y))" by (auto simp add: min_def max_def mult_le_cancel_left) lemma max_mult_distrib_right: fixes x::"'a::linordered_idom" shows "max x y * p = (if 0 \ p then max (x*p) (y*p) else min (x*p) (y*p))" by (auto simp add: min_def max_def mult_le_cancel_right) lemma max_divide_distrib_right: fixes x::"'a::linordered_field" shows "max x y / p = (if 0 \ p then max (x/p) (y/p) else min (x/p) (y/p))" by (simp add: max_mult_distrib_right divide_inverse) hide_fact (open) field_inverse field_divide_inverse field_inverse_zero code_identifier code_module Fields \ (SML) Arith and (OCaml) Arith and (Haskell) Arith end diff --git a/src/HOL/Groups.thy b/src/HOL/Groups.thy --- a/src/HOL/Groups.thy +++ b/src/HOL/Groups.thy @@ -1,1495 +1,1495 @@ (* Title: HOL/Groups.thy Author: Gertrud Bauer Author: Steven Obua Author: Lawrence C Paulson Author: Markus Wenzel Author: Jeremy Avigad *) section \Groups, also combined with orderings\ theory Groups imports Orderings begin subsection \Dynamic facts\ named_theorems ac_simps "associativity and commutativity simplification rules" and algebra_simps "algebra simplification rules for rings" and algebra_split_simps "algebra simplification rules for rings, with potential goal splitting" and field_simps "algebra simplification rules for fields" and field_split_simps "algebra simplification rules for fields, with potential goal splitting" text \ The rewrites accumulated in \algebra_simps\ deal with the classical algebraic structures of groups, rings and family. They simplify terms by multiplying everything out (in case of a ring) and bringing sums and products into a canonical form (by ordered rewriting). As a result it decides group and ring equalities but also helps with inequalities. Of course it also works for fields, but it knows nothing about multiplicative inverses or division. This is catered for by \field_simps\. Facts in \field_simps\ multiply with denominators in (in)equations if they can be proved to be non-zero (for equations) or positive/negative (for inequalities). Can be too aggressive and is therefore separate from the more benign \algebra_simps\. Collections \algebra_split_simps\ and \field_split_simps\ correspond to \algebra_simps\ and \field_simps\ but contain more aggresive rules that may lead to goal splitting. \ subsection \Abstract structures\ text \ These locales provide basic structures for interpretation into bigger structures; extensions require careful thinking, otherwise undesired effects may occur due to interpretation. \ locale semigroup = fixes f :: "'a \ 'a \ 'a" (infixl "\<^bold>*" 70) assumes assoc [ac_simps]: "a \<^bold>* b \<^bold>* c = a \<^bold>* (b \<^bold>* c)" locale abel_semigroup = semigroup + assumes commute [ac_simps]: "a \<^bold>* b = b \<^bold>* a" begin lemma left_commute [ac_simps]: "b \<^bold>* (a \<^bold>* c) = a \<^bold>* (b \<^bold>* c)" proof - have "(b \<^bold>* a) \<^bold>* c = (a \<^bold>* b) \<^bold>* c" by (simp only: commute) then show ?thesis by (simp only: assoc) qed end locale monoid = semigroup + fixes z :: 'a ("\<^bold>1") assumes left_neutral [simp]: "\<^bold>1 \<^bold>* a = a" assumes right_neutral [simp]: "a \<^bold>* \<^bold>1 = a" locale comm_monoid = abel_semigroup + fixes z :: 'a ("\<^bold>1") assumes comm_neutral: "a \<^bold>* \<^bold>1 = a" begin sublocale monoid by standard (simp_all add: commute comm_neutral) end locale group = semigroup + fixes z :: 'a ("\<^bold>1") fixes inverse :: "'a \ 'a" assumes group_left_neutral: "\<^bold>1 \<^bold>* a = a" assumes left_inverse [simp]: "inverse a \<^bold>* a = \<^bold>1" begin lemma left_cancel: "a \<^bold>* b = a \<^bold>* c \ b = c" proof assume "a \<^bold>* b = a \<^bold>* c" then have "inverse a \<^bold>* (a \<^bold>* b) = inverse a \<^bold>* (a \<^bold>* c)" by simp then have "(inverse a \<^bold>* a) \<^bold>* b = (inverse a \<^bold>* a) \<^bold>* c" by (simp only: assoc) then show "b = c" by (simp add: group_left_neutral) qed simp sublocale monoid proof fix a have "inverse a \<^bold>* a = \<^bold>1" by simp then have "inverse a \<^bold>* (a \<^bold>* \<^bold>1) = inverse a \<^bold>* a" by (simp add: group_left_neutral assoc [symmetric]) with left_cancel show "a \<^bold>* \<^bold>1 = a" by (simp only: left_cancel) qed (fact group_left_neutral) lemma inverse_unique: assumes "a \<^bold>* b = \<^bold>1" shows "inverse a = b" proof - from assms have "inverse a \<^bold>* (a \<^bold>* b) = inverse a" by simp then show ?thesis by (simp add: assoc [symmetric]) qed lemma inverse_neutral [simp]: "inverse \<^bold>1 = \<^bold>1" by (rule inverse_unique) simp lemma inverse_inverse [simp]: "inverse (inverse a) = a" by (rule inverse_unique) simp lemma right_inverse [simp]: "a \<^bold>* inverse a = \<^bold>1" proof - have "a \<^bold>* inverse a = inverse (inverse a) \<^bold>* inverse a" by simp also have "\ = \<^bold>1" by (rule left_inverse) then show ?thesis by simp qed lemma inverse_distrib_swap: "inverse (a \<^bold>* b) = inverse b \<^bold>* inverse a" proof (rule inverse_unique) have "a \<^bold>* b \<^bold>* (inverse b \<^bold>* inverse a) = a \<^bold>* (b \<^bold>* inverse b) \<^bold>* inverse a" by (simp only: assoc) also have "\ = \<^bold>1" by simp finally show "a \<^bold>* b \<^bold>* (inverse b \<^bold>* inverse a) = \<^bold>1" . qed lemma right_cancel: "b \<^bold>* a = c \<^bold>* a \ b = c" proof assume "b \<^bold>* a = c \<^bold>* a" then have "b \<^bold>* a \<^bold>* inverse a= c \<^bold>* a \<^bold>* inverse a" by simp then show "b = c" by (simp add: assoc) qed simp end subsection \Generic operations\ class zero = fixes zero :: 'a ("0") class one = fixes one :: 'a ("1") hide_const (open) zero one lemma Let_0 [simp]: "Let 0 f = f 0" unfolding Let_def .. lemma Let_1 [simp]: "Let 1 f = f 1" unfolding Let_def .. setup \ Reorient_Proc.add (fn Const(\<^const_name>\Groups.zero\, _) => true | Const(\<^const_name>\Groups.one\, _) => true | _ => false) \ simproc_setup reorient_zero ("0 = x") = Reorient_Proc.proc simproc_setup reorient_one ("1 = x") = Reorient_Proc.proc typed_print_translation \ let fun tr' c = (c, fn ctxt => fn T => fn ts => if null ts andalso Printer.type_emphasis ctxt T then Syntax.const \<^syntax_const>\_constrain\ $ Syntax.const c $ Syntax_Phases.term_of_typ ctxt T else raise Match); in map tr' [\<^const_syntax>\Groups.one\, \<^const_syntax>\Groups.zero\] end \ \ \show types that are presumably too general\ class plus = fixes plus :: "'a \ 'a \ 'a" (infixl "+" 65) class minus = fixes minus :: "'a \ 'a \ 'a" (infixl "-" 65) class uminus = fixes uminus :: "'a \ 'a" ("- _" [81] 80) class times = fixes times :: "'a \ 'a \ 'a" (infixl "*" 70) subsection \Semigroups and Monoids\ class semigroup_add = plus + assumes add_assoc [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "(a + b) + c = a + (b + c)" begin sublocale add: semigroup plus by standard (fact add_assoc) end hide_fact add_assoc class ab_semigroup_add = semigroup_add + assumes add_commute [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a + b = b + a" begin sublocale add: abel_semigroup plus by standard (fact add_commute) declare add.left_commute [algebra_simps, algebra_split_simps, field_simps, field_split_simps] lemmas add_ac = add.assoc add.commute add.left_commute end hide_fact add_commute lemmas add_ac = add.assoc add.commute add.left_commute class semigroup_mult = times + assumes mult_assoc [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "(a * b) * c = a * (b * c)" begin sublocale mult: semigroup times by standard (fact mult_assoc) end hide_fact mult_assoc class ab_semigroup_mult = semigroup_mult + assumes mult_commute [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a * b = b * a" begin sublocale mult: abel_semigroup times by standard (fact mult_commute) declare mult.left_commute [algebra_simps, algebra_split_simps, field_simps, field_split_simps] lemmas mult_ac = mult.assoc mult.commute mult.left_commute end hide_fact mult_commute lemmas mult_ac = mult.assoc mult.commute mult.left_commute class monoid_add = zero + semigroup_add + assumes add_0_left: "0 + a = a" and add_0_right: "a + 0 = a" begin sublocale add: monoid plus 0 by standard (fact add_0_left add_0_right)+ end lemma zero_reorient: "0 = x \ x = 0" by (fact eq_commute) class comm_monoid_add = zero + ab_semigroup_add + assumes add_0: "0 + a = a" begin subclass monoid_add by standard (simp_all add: add_0 add.commute [of _ 0]) sublocale add: comm_monoid plus 0 by standard (simp add: ac_simps) end class monoid_mult = one + semigroup_mult + assumes mult_1_left: "1 * a = a" and mult_1_right: "a * 1 = a" begin sublocale mult: monoid times 1 by standard (fact mult_1_left mult_1_right)+ end lemma one_reorient: "1 = x \ x = 1" by (fact eq_commute) class comm_monoid_mult = one + ab_semigroup_mult + assumes mult_1: "1 * a = a" begin subclass monoid_mult by standard (simp_all add: mult_1 mult.commute [of _ 1]) sublocale mult: comm_monoid times 1 by standard (simp add: ac_simps) end class cancel_semigroup_add = semigroup_add + assumes add_left_imp_eq: "a + b = a + c \ b = c" assumes add_right_imp_eq: "b + a = c + a \ b = c" begin lemma add_left_cancel [simp]: "a + b = a + c \ b = c" by (blast dest: add_left_imp_eq) lemma add_right_cancel [simp]: "b + a = c + a \ b = c" by (blast dest: add_right_imp_eq) end class cancel_ab_semigroup_add = ab_semigroup_add + minus + assumes add_diff_cancel_left' [simp]: "(a + b) - a = b" assumes diff_diff_add [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a - b - c = a - (b + c)" begin lemma add_diff_cancel_right' [simp]: "(a + b) - b = a" using add_diff_cancel_left' [of b a] by (simp add: ac_simps) subclass cancel_semigroup_add proof fix a b c :: 'a assume "a + b = a + c" then have "a + b - a = a + c - a" by simp then show "b = c" by simp next fix a b c :: 'a assume "b + a = c + a" then have "b + a - a = c + a - a" by simp then show "b = c" by simp qed lemma add_diff_cancel_left [simp]: "(c + a) - (c + b) = a - b" unfolding diff_diff_add [symmetric] by simp lemma add_diff_cancel_right [simp]: "(a + c) - (b + c) = a - b" using add_diff_cancel_left [symmetric] by (simp add: ac_simps) lemma diff_right_commute: "a - c - b = a - b - c" by (simp add: diff_diff_add add.commute) end class cancel_comm_monoid_add = cancel_ab_semigroup_add + comm_monoid_add begin lemma diff_zero [simp]: "a - 0 = a" using add_diff_cancel_right' [of a 0] by simp lemma diff_cancel [simp]: "a - a = 0" proof - have "(a + 0) - (a + 0) = 0" by (simp only: add_diff_cancel_left diff_zero) then show ?thesis by simp qed lemma add_implies_diff: assumes "c + b = a" shows "c = a - b" proof - from assms have "(b + c) - (b + 0) = a - b" by (simp add: add.commute) then show "c = a - b" by simp qed lemma add_cancel_right_right [simp]: "a = a + b \ b = 0" (is "?P \ ?Q") proof assume ?Q then show ?P by simp next assume ?P then have "a - a = a + b - a" by simp then show ?Q by simp qed lemma add_cancel_right_left [simp]: "a = b + a \ b = 0" using add_cancel_right_right [of a b] by (simp add: ac_simps) lemma add_cancel_left_right [simp]: "a + b = a \ b = 0" by (auto dest: sym) lemma add_cancel_left_left [simp]: "b + a = a \ b = 0" by (auto dest: sym) end class comm_monoid_diff = cancel_comm_monoid_add + assumes zero_diff [simp]: "0 - a = 0" begin lemma diff_add_zero [simp]: "a - (a + b) = 0" proof - have "a - (a + b) = (a + 0) - (a + b)" by simp also have "\ = 0" by (simp only: add_diff_cancel_left zero_diff) finally show ?thesis . qed end subsection \Groups\ class group_add = minus + uminus + monoid_add + assumes left_minus: "- a + a = 0" assumes add_uminus_conv_diff [simp]: "a + (- b) = a - b" begin lemma diff_conv_add_uminus: "a - b = a + (- b)" by simp sublocale add: group plus 0 uminus by standard (simp_all add: left_minus) lemma minus_unique: "a + b = 0 \ - a = b" by (fact add.inverse_unique) lemma minus_zero: "- 0 = 0" by (fact add.inverse_neutral) lemma minus_minus: "- (- a) = a" by (fact add.inverse_inverse) lemma right_minus: "a + - a = 0" by (fact add.right_inverse) lemma diff_self [simp]: "a - a = 0" using right_minus [of a] by simp subclass cancel_semigroup_add by standard (simp_all add: add.left_cancel add.right_cancel) lemma minus_add_cancel [simp]: "- a + (a + b) = b" by (simp add: add.assoc [symmetric]) lemma add_minus_cancel [simp]: "a + (- a + b) = b" by (simp add: add.assoc [symmetric]) lemma diff_add_cancel [simp]: "a - b + b = a" by (simp only: diff_conv_add_uminus add.assoc) simp lemma add_diff_cancel [simp]: "a + b - b = a" by (simp only: diff_conv_add_uminus add.assoc) simp lemma minus_add: "- (a + b) = - b + - a" by (fact add.inverse_distrib_swap) lemma right_minus_eq [simp]: "a - b = 0 \ a = b" proof assume "a - b = 0" have "a = (a - b) + b" by (simp add: add.assoc) also have "\ = b" using \a - b = 0\ by simp finally show "a = b" . next assume "a = b" then show "a - b = 0" by simp qed lemma eq_iff_diff_eq_0: "a = b \ a - b = 0" by (fact right_minus_eq [symmetric]) lemma diff_0 [simp]: "0 - a = - a" by (simp only: diff_conv_add_uminus add_0_left) lemma diff_0_right [simp]: "a - 0 = a" by (simp only: diff_conv_add_uminus minus_zero add_0_right) lemma diff_minus_eq_add [simp]: "a - - b = a + b" by (simp only: diff_conv_add_uminus minus_minus) lemma neg_equal_iff_equal [simp]: "- a = - b \ a = b" proof assume "- a = - b" then have "- (- a) = - (- b)" by simp then show "a = b" by simp next assume "a = b" then show "- a = - b" by simp qed lemma neg_equal_0_iff_equal [simp]: "- a = 0 \ a = 0" by (subst neg_equal_iff_equal [symmetric]) simp lemma neg_0_equal_iff_equal [simp]: "0 = - a \ 0 = a" by (subst neg_equal_iff_equal [symmetric]) simp text \The next two equations can make the simplifier loop!\ lemma equation_minus_iff: "a = - b \ b = - a" proof - have "- (- a) = - b \ - a = b" by (rule neg_equal_iff_equal) then show ?thesis by (simp add: eq_commute) qed lemma minus_equation_iff: "- a = b \ - b = a" proof - have "- a = - (- b) \ a = -b" by (rule neg_equal_iff_equal) then show ?thesis by (simp add: eq_commute) qed lemma eq_neg_iff_add_eq_0: "a = - b \ a + b = 0" proof assume "a = - b" then show "a + b = 0" by simp next assume "a + b = 0" moreover have "a + (b + - b) = (a + b) + - b" by (simp only: add.assoc) ultimately show "a = - b" by simp qed lemma add_eq_0_iff2: "a + b = 0 \ a = - b" by (fact eq_neg_iff_add_eq_0 [symmetric]) lemma neg_eq_iff_add_eq_0: "- a = b \ a + b = 0" by (auto simp add: add_eq_0_iff2) lemma add_eq_0_iff: "a + b = 0 \ b = - a" by (auto simp add: neg_eq_iff_add_eq_0 [symmetric]) lemma minus_diff_eq [simp]: "- (a - b) = b - a" by (simp only: neg_eq_iff_add_eq_0 diff_conv_add_uminus add.assoc minus_add_cancel) simp lemma add_diff_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a + (b - c) = (a + b) - c" by (simp only: diff_conv_add_uminus add.assoc) lemma diff_add_eq_diff_diff_swap: "a - (b + c) = a - c - b" by (simp only: diff_conv_add_uminus add.assoc minus_add) lemma diff_eq_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a - b = c \ a = c + b" by auto lemma eq_diff_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a = c - b \ a + b = c" by auto lemma diff_diff_eq2 [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a - (b - c) = (a + c) - b" by (simp only: diff_conv_add_uminus add.assoc) simp lemma diff_eq_diff_eq: "a - b = c - d \ a = b \ c = d" by (simp only: eq_iff_diff_eq_0 [of a b] eq_iff_diff_eq_0 [of c d]) end class ab_group_add = minus + uminus + comm_monoid_add + assumes ab_left_minus: "- a + a = 0" assumes ab_diff_conv_add_uminus: "a - b = a + (- b)" begin subclass group_add by standard (simp_all add: ab_left_minus ab_diff_conv_add_uminus) subclass cancel_comm_monoid_add proof fix a b c :: 'a have "b + a - a = b" by simp then show "a + b - a = b" by (simp add: ac_simps) show "a - b - c = a - (b + c)" by (simp add: algebra_simps) qed lemma uminus_add_conv_diff [simp]: "- a + b = b - a" by (simp add: add.commute) lemma minus_add_distrib [simp]: "- (a + b) = - a + - b" by (simp add: algebra_simps) lemma diff_add_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "(a - b) + c = (a + c) - b" by (simp add: algebra_simps) lemma minus_diff_commute: "- b - a = - a - b" by (simp only: diff_conv_add_uminus add.commute) end subsection \(Partially) Ordered Groups\ text \ The theory of partially ordered groups is taken from the books: \<^item> \<^emph>\Lattice Theory\ by Garret Birkhoff, American Mathematical Society, 1979 \<^item> \<^emph>\Partially Ordered Algebraic Systems\, Pergamon Press, 1963 Most of the used notions can also be looked up in \<^item> \<^url>\http://www.mathworld.com\ by Eric Weisstein et. al. \<^item> \<^emph>\Algebra I\ by van der Waerden, Springer \ class ordered_ab_semigroup_add = order + ab_semigroup_add + assumes add_left_mono: "a \ b \ c + a \ c + b" begin lemma add_right_mono: "a \ b \ a + c \ b + c" by (simp add: add.commute [of _ c] add_left_mono) text \non-strict, in both arguments\ lemma add_mono: "a \ b \ c \ d \ a + c \ b + d" by (simp add: add.commute add_left_mono add_right_mono [THEN order_trans]) end text \Strict monotonicity in both arguments\ class strict_ordered_ab_semigroup_add = ordered_ab_semigroup_add + assumes add_strict_mono: "a < b \ c < d \ a + c < b + d" class ordered_cancel_ab_semigroup_add = ordered_ab_semigroup_add + cancel_ab_semigroup_add begin lemma add_strict_left_mono: "a < b \ c + a < c + b" by (auto simp add: less_le add_left_mono) lemma add_strict_right_mono: "a < b \ a + c < b + c" by (simp add: add.commute [of _ c] add_strict_left_mono) subclass strict_ordered_ab_semigroup_add proof show "\a b c d. \a < b; c < d\ \ a + c < b + d" by (iprover intro: add_strict_left_mono add_strict_right_mono less_trans) qed lemma add_less_le_mono: "a < b \ c \ d \ a + c < b + d" by (iprover intro: add_left_mono add_strict_right_mono less_le_trans) lemma add_le_less_mono: "a \ b \ c < d \ a + c < b + d" by (iprover intro: add_strict_left_mono add_right_mono less_le_trans) end class ordered_ab_semigroup_add_imp_le = ordered_cancel_ab_semigroup_add + assumes add_le_imp_le_left: "c + a \ c + b \ a \ b" begin lemma add_less_imp_less_left: assumes less: "c + a < c + b" shows "a < b" proof - from less have le: "c + a \ c + b" by (simp add: order_le_less) have "a \ b" using add_le_imp_le_left [OF le] . moreover have "a \ b" proof (rule ccontr) assume "\ ?thesis" then have "a = b" by simp then have "c + a = c + b" by simp with less show "False" by simp qed ultimately show "a < b" by (simp add: order_le_less) qed lemma add_less_imp_less_right: "a + c < b + c \ a < b" by (rule add_less_imp_less_left [of c]) (simp add: add.commute) lemma add_less_cancel_left [simp]: "c + a < c + b \ a < b" by (blast intro: add_less_imp_less_left add_strict_left_mono) lemma add_less_cancel_right [simp]: "a + c < b + c \ a < b" by (blast intro: add_less_imp_less_right add_strict_right_mono) lemma add_le_cancel_left [simp]: "c + a \ c + b \ a \ b" by (auto simp: dest: add_le_imp_le_left add_left_mono) lemma add_le_cancel_right [simp]: "a + c \ b + c \ a \ b" by (simp add: add.commute [of a c] add.commute [of b c]) lemma add_le_imp_le_right: "a + c \ b + c \ a \ b" by simp lemma max_add_distrib_left: "max x y + z = max (x + z) (y + z)" unfolding max_def by auto lemma min_add_distrib_left: "min x y + z = min (x + z) (y + z)" unfolding min_def by auto lemma max_add_distrib_right: "x + max y z = max (x + y) (x + z)" unfolding max_def by auto lemma min_add_distrib_right: "x + min y z = min (x + y) (x + z)" unfolding min_def by auto end subsection \Support for reasoning about signs\ class ordered_comm_monoid_add = comm_monoid_add + ordered_ab_semigroup_add begin lemma add_nonneg_nonneg [simp]: "0 \ a \ 0 \ b \ 0 \ a + b" using add_mono[of 0 a 0 b] by simp lemma add_nonpos_nonpos: "a \ 0 \ b \ 0 \ a + b \ 0" using add_mono[of a 0 b 0] by simp lemma add_nonneg_eq_0_iff: "0 \ x \ 0 \ y \ x + y = 0 \ x = 0 \ y = 0" using add_left_mono[of 0 y x] add_right_mono[of 0 x y] by auto lemma add_nonpos_eq_0_iff: "x \ 0 \ y \ 0 \ x + y = 0 \ x = 0 \ y = 0" using add_left_mono[of y 0 x] add_right_mono[of x 0 y] by auto lemma add_increasing: "0 \ a \ b \ c \ b \ a + c" using add_mono [of 0 a b c] by simp lemma add_increasing2: "0 \ c \ b \ a \ b \ a + c" by (simp add: add_increasing add.commute [of a]) lemma add_decreasing: "a \ 0 \ c \ b \ a + c \ b" using add_mono [of a 0 c b] by simp lemma add_decreasing2: "c \ 0 \ a \ b \ a + c \ b" using add_mono[of a b c 0] by simp lemma add_pos_nonneg: "0 < a \ 0 \ b \ 0 < a + b" using less_le_trans[of 0 a "a + b"] by (simp add: add_increasing2) lemma add_pos_pos: "0 < a \ 0 < b \ 0 < a + b" by (intro add_pos_nonneg less_imp_le) lemma add_nonneg_pos: "0 \ a \ 0 < b \ 0 < a + b" using add_pos_nonneg[of b a] by (simp add: add_commute) lemma add_neg_nonpos: "a < 0 \ b \ 0 \ a + b < 0" using le_less_trans[of "a + b" a 0] by (simp add: add_decreasing2) lemma add_neg_neg: "a < 0 \ b < 0 \ a + b < 0" by (intro add_neg_nonpos less_imp_le) lemma add_nonpos_neg: "a \ 0 \ b < 0 \ a + b < 0" using add_neg_nonpos[of b a] by (simp add: add_commute) lemmas add_sign_intros = add_pos_nonneg add_pos_pos add_nonneg_pos add_nonneg_nonneg add_neg_nonpos add_neg_neg add_nonpos_neg add_nonpos_nonpos end class strict_ordered_comm_monoid_add = comm_monoid_add + strict_ordered_ab_semigroup_add begin lemma pos_add_strict: "0 < a \ b < c \ b < a + c" using add_strict_mono [of 0 a b c] by simp end class ordered_cancel_comm_monoid_add = ordered_comm_monoid_add + cancel_ab_semigroup_add begin subclass ordered_cancel_ab_semigroup_add .. subclass strict_ordered_comm_monoid_add .. lemma add_strict_increasing: "0 < a \ b \ c \ b < a + c" using add_less_le_mono [of 0 a b c] by simp lemma add_strict_increasing2: "0 \ a \ b < c \ b < a + c" using add_le_less_mono [of 0 a b c] by simp end class ordered_ab_semigroup_monoid_add_imp_le = monoid_add + ordered_ab_semigroup_add_imp_le begin lemma add_less_same_cancel1 [simp]: "b + a < b \ a < 0" using add_less_cancel_left [of _ _ 0] by simp lemma add_less_same_cancel2 [simp]: "a + b < b \ a < 0" using add_less_cancel_right [of _ _ 0] by simp lemma less_add_same_cancel1 [simp]: "a < a + b \ 0 < b" using add_less_cancel_left [of _ 0] by simp lemma less_add_same_cancel2 [simp]: "a < b + a \ 0 < b" using add_less_cancel_right [of 0] by simp lemma add_le_same_cancel1 [simp]: "b + a \ b \ a \ 0" using add_le_cancel_left [of _ _ 0] by simp lemma add_le_same_cancel2 [simp]: "a + b \ b \ a \ 0" using add_le_cancel_right [of _ _ 0] by simp lemma le_add_same_cancel1 [simp]: "a \ a + b \ 0 \ b" using add_le_cancel_left [of _ 0] by simp lemma le_add_same_cancel2 [simp]: "a \ b + a \ 0 \ b" using add_le_cancel_right [of 0] by simp subclass cancel_comm_monoid_add by standard auto subclass ordered_cancel_comm_monoid_add by standard end class ordered_ab_group_add = ab_group_add + ordered_ab_semigroup_add begin subclass ordered_cancel_ab_semigroup_add .. subclass ordered_ab_semigroup_monoid_add_imp_le proof fix a b c :: 'a assume "c + a \ c + b" then have "(-c) + (c + a) \ (-c) + (c + b)" by (rule add_left_mono) then have "((-c) + c) + a \ ((-c) + c) + b" by (simp only: add.assoc) then show "a \ b" by simp qed lemma max_diff_distrib_left: "max x y - z = max (x - z) (y - z)" using max_add_distrib_left [of x y "- z"] by simp lemma min_diff_distrib_left: "min x y - z = min (x - z) (y - z)" using min_add_distrib_left [of x y "- z"] by simp lemma le_imp_neg_le: assumes "a \ b" shows "- b \ - a" proof - from assms have "- a + a \ - a + b" by (rule add_left_mono) then have "0 \ - a + b" by simp then have "0 + (- b) \ (- a + b) + (- b)" by (rule add_right_mono) then show ?thesis by (simp add: algebra_simps) qed lemma neg_le_iff_le [simp]: "- b \ - a \ a \ b" proof assume "- b \ - a" then have "- (- a) \ - (- b)" by (rule le_imp_neg_le) then show "a \ b" by simp next assume "a \ b" then show "- b \ - a" by (rule le_imp_neg_le) qed lemma neg_le_0_iff_le [simp]: "- a \ 0 \ 0 \ a" by (subst neg_le_iff_le [symmetric]) simp lemma neg_0_le_iff_le [simp]: "0 \ - a \ a \ 0" by (subst neg_le_iff_le [symmetric]) simp lemma neg_less_iff_less [simp]: "- b < - a \ a < b" by (auto simp add: less_le) lemma neg_less_0_iff_less [simp]: "- a < 0 \ 0 < a" by (subst neg_less_iff_less [symmetric]) simp lemma neg_0_less_iff_less [simp]: "0 < - a \ a < 0" by (subst neg_less_iff_less [symmetric]) simp text \The next several equations can make the simplifier loop!\ lemma less_minus_iff: "a < - b \ b < - a" proof - have "- (- a) < - b \ b < - a" by (rule neg_less_iff_less) then show ?thesis by simp qed lemma minus_less_iff: "- a < b \ - b < a" proof - have "- a < - (- b) \ - b < a" by (rule neg_less_iff_less) then show ?thesis by simp qed lemma le_minus_iff: "a \ - b \ b \ - a" by (auto simp: order.order_iff_strict less_minus_iff) lemma minus_le_iff: "- a \ b \ - b \ a" by (auto simp add: le_less minus_less_iff) lemma diff_less_0_iff_less [simp]: "a - b < 0 \ a < b" proof - have "a - b < 0 \ a + (- b) < b + (- b)" by simp also have "\ \ a < b" by (simp only: add_less_cancel_right) finally show ?thesis . qed lemmas less_iff_diff_less_0 = diff_less_0_iff_less [symmetric] lemma diff_less_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a - b < c \ a < c + b" proof (subst less_iff_diff_less_0 [of a]) show "(a - b < c) = (a - (c + b) < 0)" by (simp add: algebra_simps less_iff_diff_less_0 [of _ c]) qed lemma less_diff_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a < c - b \ a + b < c" proof (subst less_iff_diff_less_0 [of "a + b"]) show "(a < c - b) = (a + b - c < 0)" by (simp add: algebra_simps less_iff_diff_less_0 [of a]) qed lemma diff_gt_0_iff_gt [simp]: "a - b > 0 \ a > b" by (simp add: less_diff_eq) lemma diff_le_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a - b \ c \ a \ c + b" by (auto simp add: le_less diff_less_eq ) lemma le_diff_eq [algebra_simps, algebra_split_simps, field_simps, field_split_simps]: "a \ c - b \ a + b \ c" by (auto simp add: le_less less_diff_eq) lemma diff_le_0_iff_le [simp]: "a - b \ 0 \ a \ b" by (simp add: algebra_simps) lemmas le_iff_diff_le_0 = diff_le_0_iff_le [symmetric] lemma diff_ge_0_iff_ge [simp]: "a - b \ 0 \ a \ b" by (simp add: le_diff_eq) lemma diff_eq_diff_less: "a - b = c - d \ a < b \ c < d" by (auto simp only: less_iff_diff_less_0 [of a b] less_iff_diff_less_0 [of c d]) lemma diff_eq_diff_less_eq: "a - b = c - d \ a \ b \ c \ d" by (auto simp only: le_iff_diff_le_0 [of a b] le_iff_diff_le_0 [of c d]) lemma diff_mono: "a \ b \ d \ c \ a - c \ b - d" by (simp add: field_simps add_mono) lemma diff_left_mono: "b \ a \ c - a \ c - b" by (simp add: field_simps) lemma diff_right_mono: "a \ b \ a - c \ b - c" by (simp add: field_simps) lemma diff_strict_mono: "a < b \ d < c \ a - c < b - d" by (simp add: field_simps add_strict_mono) lemma diff_strict_left_mono: "b < a \ c - a < c - b" by (simp add: field_simps) lemma diff_strict_right_mono: "a < b \ a - c < b - c" by (simp add: field_simps) end locale group_cancel begin lemma add1: "(A::'a::comm_monoid_add) \ k + a \ A + b \ k + (a + b)" by (simp only: ac_simps) lemma add2: "(B::'a::comm_monoid_add) \ k + b \ a + B \ k + (a + b)" by (simp only: ac_simps) lemma sub1: "(A::'a::ab_group_add) \ k + a \ A - b \ k + (a - b)" by (simp only: add_diff_eq) lemma sub2: "(B::'a::ab_group_add) \ k + b \ a - B \ - k + (a - b)" by (simp only: minus_add diff_conv_add_uminus ac_simps) lemma neg1: "(A::'a::ab_group_add) \ k + a \ - A \ - k + - a" by (simp only: minus_add_distrib) lemma rule0: "(a::'a::comm_monoid_add) \ a + 0" by (simp only: add_0_right) end ML_file \Tools/group_cancel.ML\ simproc_setup group_cancel_add ("a + b::'a::ab_group_add") = \fn phi => fn ss => try Group_Cancel.cancel_add_conv\ simproc_setup group_cancel_diff ("a - b::'a::ab_group_add") = \fn phi => fn ss => try Group_Cancel.cancel_diff_conv\ simproc_setup group_cancel_eq ("a = (b::'a::ab_group_add)") = \fn phi => fn ss => try Group_Cancel.cancel_eq_conv\ simproc_setup group_cancel_le ("a \ (b::'a::ordered_ab_group_add)") = \fn phi => fn ss => try Group_Cancel.cancel_le_conv\ simproc_setup group_cancel_less ("a < (b::'a::ordered_ab_group_add)") = \fn phi => fn ss => try Group_Cancel.cancel_less_conv\ class linordered_ab_semigroup_add = linorder + ordered_ab_semigroup_add class linordered_cancel_ab_semigroup_add = linorder + ordered_cancel_ab_semigroup_add begin subclass linordered_ab_semigroup_add .. subclass ordered_ab_semigroup_add_imp_le proof fix a b c :: 'a assume le1: "c + a \ c + b" show "a \ b" proof (rule ccontr) assume *: "\ ?thesis" then have "b \ a" by (simp add: linorder_not_le) then have "c + b \ c + a" by (rule add_left_mono) then have "c + a = c + b" - using le1 by (iprover intro: antisym) + using le1 by (iprover intro: order.antisym) then have "a = b" by simp with * show False by (simp add: linorder_not_le [symmetric]) qed qed end class linordered_ab_group_add = linorder + ordered_ab_group_add begin subclass linordered_cancel_ab_semigroup_add .. lemma equal_neg_zero [simp]: "a = - a \ a = 0" proof assume "a = 0" then show "a = - a" by simp next assume A: "a = - a" show "a = 0" proof (cases "0 \ a") case True with A have "0 \ - a" by auto with le_minus_iff have "a \ 0" by simp with True show ?thesis by (auto intro: order_trans) next case False then have B: "a \ 0" by auto with A have "- a \ 0" by auto with B show ?thesis by (auto intro: order_trans) qed qed lemma neg_equal_zero [simp]: "- a = a \ a = 0" by (auto dest: sym) lemma neg_less_eq_nonneg [simp]: "- a \ a \ 0 \ a" proof assume *: "- a \ a" show "0 \ a" proof (rule classical) assume "\ ?thesis" then have "a < 0" by auto with * have "- a < 0" by (rule le_less_trans) then show ?thesis by auto qed next assume *: "0 \ a" then have "- a \ 0" by (simp add: minus_le_iff) from this * show "- a \ a" by (rule order_trans) qed lemma neg_less_pos [simp]: "- a < a \ 0 < a" by (auto simp add: less_le) lemma less_eq_neg_nonpos [simp]: "a \ - a \ a \ 0" using neg_less_eq_nonneg [of "- a"] by simp lemma less_neg_neg [simp]: "a < - a \ a < 0" using neg_less_pos [of "- a"] by simp lemma double_zero [simp]: "a + a = 0 \ a = 0" proof assume "a + a = 0" then have a: "- a = a" by (rule minus_unique) then show "a = 0" by (simp only: neg_equal_zero) next assume "a = 0" then show "a + a = 0" by simp qed lemma double_zero_sym [simp]: "0 = a + a \ a = 0" using double_zero [of a] by (simp only: eq_commute) lemma zero_less_double_add_iff_zero_less_single_add [simp]: "0 < a + a \ 0 < a" proof assume "0 < a + a" then have "0 - a < a" by (simp only: diff_less_eq) then have "- a < a" by simp then show "0 < a" by simp next assume "0 < a" with this have "0 + 0 < a + a" by (rule add_strict_mono) then show "0 < a + a" by simp qed lemma zero_le_double_add_iff_zero_le_single_add [simp]: "0 \ a + a \ 0 \ a" by (auto simp add: le_less) lemma double_add_less_zero_iff_single_add_less_zero [simp]: "a + a < 0 \ a < 0" proof - have "\ a + a < 0 \ \ a < 0" by (simp add: not_less) then show ?thesis by simp qed lemma double_add_le_zero_iff_single_add_le_zero [simp]: "a + a \ 0 \ a \ 0" proof - have "\ a + a \ 0 \ \ a \ 0" by (simp add: not_le) then show ?thesis by simp qed lemma minus_max_eq_min: "- max x y = min (- x) (- y)" by (auto simp add: max_def min_def) lemma minus_min_eq_max: "- min x y = max (- x) (- y)" by (auto simp add: max_def min_def) end class abs = fixes abs :: "'a \ 'a" ("\_\") class sgn = fixes sgn :: "'a \ 'a" class ordered_ab_group_add_abs = ordered_ab_group_add + abs + assumes abs_ge_zero [simp]: "\a\ \ 0" and abs_ge_self: "a \ \a\" and abs_leI: "a \ b \ - a \ b \ \a\ \ b" and abs_minus_cancel [simp]: "\-a\ = \a\" and abs_triangle_ineq: "\a + b\ \ \a\ + \b\" begin lemma abs_minus_le_zero: "- \a\ \ 0" unfolding neg_le_0_iff_le by simp lemma abs_of_nonneg [simp]: assumes nonneg: "0 \ a" shows "\a\ = a" -proof (rule antisym) +proof (rule order.antisym) show "a \ \a\" by (rule abs_ge_self) from nonneg le_imp_neg_le have "- a \ 0" by simp from this nonneg have "- a \ a" by (rule order_trans) then show "\a\ \ a" by (auto intro: abs_leI) qed lemma abs_idempotent [simp]: "\\a\\ = \a\" - by (rule antisym) (auto intro!: abs_ge_self abs_leI order_trans [of "- \a\" 0 "\a\"]) + by (rule order.antisym) (auto intro!: abs_ge_self abs_leI order_trans [of "- \a\" 0 "\a\"]) lemma abs_eq_0 [simp]: "\a\ = 0 \ a = 0" proof - have "\a\ = 0 \ a = 0" - proof (rule antisym) + proof (rule order.antisym) assume zero: "\a\ = 0" with abs_ge_self show "a \ 0" by auto from zero have "\-a\ = 0" by simp with abs_ge_self [of "- a"] have "- a \ 0" by auto with neg_le_0_iff_le show "0 \ a" by auto qed then show ?thesis by auto qed lemma abs_zero [simp]: "\0\ = 0" by simp lemma abs_0_eq [simp]: "0 = \a\ \ a = 0" proof - have "0 = \a\ \ \a\ = 0" by (simp only: eq_ac) then show ?thesis by simp qed lemma abs_le_zero_iff [simp]: "\a\ \ 0 \ a = 0" proof assume "\a\ \ 0" - then have "\a\ = 0" by (rule antisym) simp + then have "\a\ = 0" by (rule order.antisym) simp then show "a = 0" by simp next assume "a = 0" then show "\a\ \ 0" by simp qed lemma abs_le_self_iff [simp]: "\a\ \ a \ 0 \ a" proof - have "0 \ \a\" using abs_ge_zero by blast then have "\a\ \ a \ 0 \ a" using order.trans by blast then show ?thesis using abs_of_nonneg eq_refl by blast qed lemma zero_less_abs_iff [simp]: "0 < \a\ \ a \ 0" by (simp add: less_le) lemma abs_not_less_zero [simp]: "\ \a\ < 0" proof - have "x \ y \ \ y < x" for x y by auto then show ?thesis by simp qed lemma abs_ge_minus_self: "- a \ \a\" proof - have "- a \ \-a\" by (rule abs_ge_self) then show ?thesis by simp qed lemma abs_minus_commute: "\a - b\ = \b - a\" proof - have "\a - b\ = \- (a - b)\" by (simp only: abs_minus_cancel) also have "\ = \b - a\" by simp finally show ?thesis . qed lemma abs_of_pos: "0 < a \ \a\ = a" by (rule abs_of_nonneg) (rule less_imp_le) lemma abs_of_nonpos [simp]: assumes "a \ 0" shows "\a\ = - a" proof - let ?b = "- a" have "- ?b \ 0 \ \- ?b\ = - (- ?b)" unfolding abs_minus_cancel [of ?b] unfolding neg_le_0_iff_le [of ?b] unfolding minus_minus by (erule abs_of_nonneg) then show ?thesis using assms by auto qed lemma abs_of_neg: "a < 0 \ \a\ = - a" by (rule abs_of_nonpos) (rule less_imp_le) lemma abs_le_D1: "\a\ \ b \ a \ b" using abs_ge_self by (blast intro: order_trans) lemma abs_le_D2: "\a\ \ b \ - a \ b" using abs_le_D1 [of "- a"] by simp lemma abs_le_iff: "\a\ \ b \ a \ b \ - a \ b" by (blast intro: abs_leI dest: abs_le_D1 abs_le_D2) lemma abs_triangle_ineq2: "\a\ - \b\ \ \a - b\" proof - have "\a\ = \b + (a - b)\" by (simp add: algebra_simps) then have "\a\ \ \b\ + \a - b\" by (simp add: abs_triangle_ineq) then show ?thesis by (simp add: algebra_simps) qed lemma abs_triangle_ineq2_sym: "\a\ - \b\ \ \b - a\" by (simp only: abs_minus_commute [of b] abs_triangle_ineq2) lemma abs_triangle_ineq3: "\\a\ - \b\\ \ \a - b\" by (simp add: abs_le_iff abs_triangle_ineq2 abs_triangle_ineq2_sym) lemma abs_triangle_ineq4: "\a - b\ \ \a\ + \b\" proof - have "\a - b\ = \a + - b\" by (simp add: algebra_simps) also have "\ \ \a\ + \- b\" by (rule abs_triangle_ineq) finally show ?thesis by simp qed lemma abs_diff_triangle_ineq: "\a + b - (c + d)\ \ \a - c\ + \b - d\" proof - have "\a + b - (c + d)\ = \(a - c) + (b - d)\" by (simp add: algebra_simps) also have "\ \ \a - c\ + \b - d\" by (rule abs_triangle_ineq) finally show ?thesis . qed lemma abs_add_abs [simp]: "\\a\ + \b\\ = \a\ + \b\" (is "?L = ?R") -proof (rule antisym) +proof (rule order.antisym) show "?L \ ?R" by (rule abs_ge_self) have "?L \ \\a\\ + \\b\\" by (rule abs_triangle_ineq) also have "\ = ?R" by simp finally show "?L \ ?R" . qed end lemma dense_eq0_I: fixes x::"'a::{dense_linorder,ordered_ab_group_add_abs}" assumes "\e. 0 < e \ \x\ \ e" shows "x = 0" proof (cases "\x\ = 0") case False then have "\x\ > 0" by simp then obtain z where "0 < z" "z < \x\" using dense by force then show ?thesis using assms by (simp flip: not_less) qed auto hide_fact (open) ab_diff_conv_add_uminus add_0 mult_1 ab_left_minus lemmas add_0 = add_0_left (* FIXME duplicate *) lemmas mult_1 = mult_1_left (* FIXME duplicate *) lemmas ab_left_minus = left_minus (* FIXME duplicate *) lemmas diff_diff_eq = diff_diff_add (* FIXME duplicate *) subsection \Canonically ordered monoids\ text \Canonically ordered monoids are never groups.\ class canonically_ordered_monoid_add = comm_monoid_add + order + assumes le_iff_add: "a \ b \ (\c. b = a + c)" begin lemma zero_le[simp]: "0 \ x" by (auto simp: le_iff_add) lemma le_zero_eq[simp]: "n \ 0 \ n = 0" - by (auto intro: antisym) + by (auto intro: order.antisym) lemma not_less_zero[simp]: "\ n < 0" by (auto simp: less_le) lemma zero_less_iff_neq_zero: "0 < n \ n \ 0" by (auto simp: less_le) text \This theorem is useful with \blast\\ lemma gr_zeroI: "(n = 0 \ False) \ 0 < n" by (rule zero_less_iff_neq_zero[THEN iffD2]) iprover lemma not_gr_zero[simp]: "\ 0 < n \ n = 0" by (simp add: zero_less_iff_neq_zero) subclass ordered_comm_monoid_add proof qed (auto simp: le_iff_add add_ac) lemma gr_implies_not_zero: "m < n \ n \ 0" by auto lemma add_eq_0_iff_both_eq_0[simp]: "x + y = 0 \ x = 0 \ y = 0" by (intro add_nonneg_eq_0_iff zero_le) lemma zero_eq_add_iff_both_eq_0[simp]: "0 = x + y \ x = 0 \ y = 0" using add_eq_0_iff_both_eq_0[of x y] unfolding eq_commute[of 0] . lemma less_eqE: assumes \a \ b\ obtains c where \b = a + c\ using assms by (auto simp add: le_iff_add) lemma lessE: assumes \a < b\ obtains c where \b = a + c\ and \c \ 0\ proof - from assms have \a \ b\ \a \ b\ by simp_all from \a \ b\ obtain c where \b = a + c\ by (rule less_eqE) moreover have \c \ 0\ using \a \ b\ \b = a + c\ by auto ultimately show ?thesis by (rule that) qed lemmas zero_order = zero_le le_zero_eq not_less_zero zero_less_iff_neq_zero not_gr_zero \ \This should be attributed with \[iff]\, but then \blast\ fails in \Set\.\ end class ordered_cancel_comm_monoid_diff = canonically_ordered_monoid_add + comm_monoid_diff + ordered_ab_semigroup_add_imp_le begin context fixes a b :: 'a assumes le: "a \ b" begin lemma add_diff_inverse: "a + (b - a) = b" using le by (auto simp add: le_iff_add) lemma add_diff_assoc: "c + (b - a) = c + b - a" using le by (auto simp add: le_iff_add add.left_commute [of c]) lemma add_diff_assoc2: "b - a + c = b + c - a" using le by (auto simp add: le_iff_add add.assoc) lemma diff_add_assoc: "c + b - a = c + (b - a)" using le by (simp add: add.commute add_diff_assoc) lemma diff_add_assoc2: "b + c - a = b - a + c" using le by (simp add: add.commute add_diff_assoc) lemma diff_diff_right: "c - (b - a) = c + a - b" by (simp add: add_diff_inverse add_diff_cancel_left [of a c "b - a", symmetric] add.commute) lemma diff_add: "b - a + a = b" by (simp add: add.commute add_diff_inverse) lemma le_add_diff: "c \ b + c - a" by (auto simp add: add.commute diff_add_assoc2 le_iff_add) lemma le_imp_diff_is_add: "a \ b \ b - a = c \ b = c + a" by (auto simp add: add.commute add_diff_inverse) lemma le_diff_conv2: "c \ b - a \ c + a \ b" (is "?P \ ?Q") proof assume ?P then have "c + a \ b - a + a" by (rule add_right_mono) then show ?Q by (simp add: add_diff_inverse add.commute) next assume ?Q then have "a + c \ a + (b - a)" by (simp add: add_diff_inverse add.commute) then show ?P by simp qed end end subsection \Tools setup\ lemma add_mono_thms_linordered_semiring: fixes i j k :: "'a::ordered_ab_semigroup_add" shows "i \ j \ k \ l \ i + k \ j + l" and "i = j \ k \ l \ i + k \ j + l" and "i \ j \ k = l \ i + k \ j + l" and "i = j \ k = l \ i + k = j + l" by (rule add_mono, clarify+)+ lemma add_mono_thms_linordered_field: fixes i j k :: "'a::ordered_cancel_ab_semigroup_add" shows "i < j \ k = l \ i + k < j + l" and "i = j \ k < l \ i + k < j + l" and "i < j \ k \ l \ i + k < j + l" and "i \ j \ k < l \ i + k < j + l" and "i < j \ k < l \ i + k < j + l" by (auto intro: add_strict_right_mono add_strict_left_mono add_less_le_mono add_le_less_mono add_strict_mono) code_identifier code_module Groups \ (SML) Arith and (OCaml) Arith and (Haskell) Arith end diff --git a/src/HOL/Hilbert_Choice.thy b/src/HOL/Hilbert_Choice.thy --- a/src/HOL/Hilbert_Choice.thy +++ b/src/HOL/Hilbert_Choice.thy @@ -1,1231 +1,1231 @@ (* Title: HOL/Hilbert_Choice.thy Author: Lawrence C Paulson, Tobias Nipkow Author: Viorel Preoteasa (Results about complete distributive lattices) Copyright 2001 University of Cambridge *) section \Hilbert's Epsilon-Operator and the Axiom of Choice\ theory Hilbert_Choice imports Wellfounded keywords "specification" :: thy_goal_defn begin subsection \Hilbert's epsilon\ axiomatization Eps :: "('a \ bool) \ 'a" where someI: "P x \ P (Eps P)" syntax (epsilon) "_Eps" :: "pttrn \ bool \ 'a" ("(3\_./ _)" [0, 10] 10) syntax (input) "_Eps" :: "pttrn \ bool \ 'a" ("(3@ _./ _)" [0, 10] 10) syntax "_Eps" :: "pttrn \ bool \ 'a" ("(3SOME _./ _)" [0, 10] 10) translations "SOME x. P" \ "CONST Eps (\x. P)" print_translation \ [(\<^const_syntax>\Eps\, fn _ => fn [Abs abs] => let val (x, t) = Syntax_Trans.atomic_abs_tr' abs in Syntax.const \<^syntax_const>\_Eps\ $ x $ t end)] \ \ \to avoid eta-contraction of body\ definition inv_into :: "'a set \ ('a \ 'b) \ ('b \ 'a)" where "inv_into A f = (\x. SOME y. y \ A \ f y = x)" lemma inv_into_def2: "inv_into A f x = (SOME y. y \ A \ f y = x)" by(simp add: inv_into_def) abbreviation inv :: "('a \ 'b) \ ('b \ 'a)" where "inv \ inv_into UNIV" subsection \Hilbert's Epsilon-operator\ lemma Eps_cong: assumes "\x. P x = Q x" shows "Eps P = Eps Q" using ext[of P Q, OF assms] by simp text \ Easier to use than \someI\ if the witness comes from an existential formula. \ lemma someI_ex [elim?]: "\x. P x \ P (SOME x. P x)" by (elim exE someI) lemma some_eq_imp: assumes "Eps P = a" "P b" shows "P a" using assms someI_ex by force text \ Easier to use than \someI\ because the conclusion has only one occurrence of \<^term>\P\. \ lemma someI2: "P a \ (\x. P x \ Q x) \ Q (SOME x. P x)" by (blast intro: someI) text \ Easier to use than \someI2\ if the witness comes from an existential formula. \ lemma someI2_ex: "\a. P a \ (\x. P x \ Q x) \ Q (SOME x. P x)" by (blast intro: someI2) lemma someI2_bex: "\a\A. P a \ (\x. x \ A \ P x \ Q x) \ Q (SOME x. x \ A \ P x)" by (blast intro: someI2) lemma some_equality [intro]: "P a \ (\x. P x \ x = a) \ (SOME x. P x) = a" by (blast intro: someI2) lemma some1_equality: "\!x. P x \ P a \ (SOME x. P x) = a" by blast lemma some_eq_ex: "P (SOME x. P x) \ (\x. P x)" by (blast intro: someI) lemma some_in_eq: "(SOME x. x \ A) \ A \ A \ {}" unfolding ex_in_conv[symmetric] by (rule some_eq_ex) lemma some_eq_trivial [simp]: "(SOME y. y = x) = x" by (rule some_equality) (rule refl) lemma some_sym_eq_trivial [simp]: "(SOME y. x = y) = x" by (iprover intro: some_equality) subsection \Axiom of Choice, Proved Using the Description Operator\ lemma choice: "\x. \y. Q x y \ \f. \x. Q x (f x)" by (fast elim: someI) lemma bchoice: "\x\S. \y. Q x y \ \f. \x\S. Q x (f x)" by (fast elim: someI) lemma choice_iff: "(\x. \y. Q x y) \ (\f. \x. Q x (f x))" by (fast elim: someI) lemma choice_iff': "(\x. P x \ (\y. Q x y)) \ (\f. \x. P x \ Q x (f x))" by (fast elim: someI) lemma bchoice_iff: "(\x\S. \y. Q x y) \ (\f. \x\S. Q x (f x))" by (fast elim: someI) lemma bchoice_iff': "(\x\S. P x \ (\y. Q x y)) \ (\f. \x\S. P x \ Q x (f x))" by (fast elim: someI) lemma dependent_nat_choice: assumes 1: "\x. P 0 x" and 2: "\x n. P n x \ \y. P (Suc n) y \ Q n x y" shows "\f. \n. P n (f n) \ Q n (f n) (f (Suc n))" proof (intro exI allI conjI) fix n define f where "f = rec_nat (SOME x. P 0 x) (\n x. SOME y. P (Suc n) y \ Q n x y)" then have "P 0 (f 0)" "\n. P n (f n) \ P (Suc n) (f (Suc n)) \ Q n (f n) (f (Suc n))" using someI_ex[OF 1] someI_ex[OF 2] by simp_all then show "P n (f n)" "Q n (f n) (f (Suc n))" by (induct n) auto qed lemma finite_subset_Union: assumes "finite A" "A \ \\" obtains \ where "finite \" "\ \ \" "A \ \\" proof - have "\x\A. \B\\. x\B" using assms by blast then obtain f where f: "\x. x \ A \ f x \ \ \ x \ f x" by (auto simp add: bchoice_iff Bex_def) show thesis proof show "finite (f ` A)" using assms by auto qed (use f in auto) qed subsection \Function Inverse\ lemma inv_def: "inv f = (\y. SOME x. f x = y)" by (simp add: inv_into_def) lemma inv_into_into: "x \ f ` A \ inv_into A f x \ A" by (simp add: inv_into_def) (fast intro: someI2) lemma inv_identity [simp]: "inv (\a. a) = (\a. a)" by (simp add: inv_def) lemma inv_id [simp]: "inv id = id" by (simp add: id_def) lemma inv_into_f_f [simp]: "inj_on f A \ x \ A \ inv_into A f (f x) = x" by (simp add: inv_into_def inj_on_def) (blast intro: someI2) lemma inv_f_f: "inj f \ inv f (f x) = x" by simp lemma f_inv_into_f: "y \ f`A \ f (inv_into A f y) = y" by (simp add: inv_into_def) (fast intro: someI2) lemma inv_into_f_eq: "inj_on f A \ x \ A \ f x = y \ inv_into A f y = x" by (erule subst) (fast intro: inv_into_f_f) lemma inv_f_eq: "inj f \ f x = y \ inv f y = x" by (simp add:inv_into_f_eq) lemma inj_imp_inv_eq: "inj f \ \x. f (g x) = x \ inv f = g" by (blast intro: inv_into_f_eq) text \But is it useful?\ lemma inj_transfer: assumes inj: "inj f" and minor: "\y. y \ range f \ P (inv f y)" shows "P x" proof - have "f x \ range f" by auto then have "P(inv f (f x))" by (rule minor) then show "P x" by (simp add: inv_into_f_f [OF inj]) qed lemma inj_iff: "inj f \ inv f \ f = id" by (simp add: o_def fun_eq_iff) (blast intro: inj_on_inverseI inv_into_f_f) lemma inv_o_cancel[simp]: "inj f \ inv f \ f = id" by (simp add: inj_iff) lemma o_inv_o_cancel[simp]: "inj f \ g \ inv f \ f = g" by (simp add: comp_assoc) lemma inv_into_image_cancel[simp]: "inj_on f A \ S \ A \ inv_into A f ` f ` S = S" by (fastforce simp: image_def) lemma inj_imp_surj_inv: "inj f \ surj (inv f)" by (blast intro!: surjI inv_into_f_f) lemma surj_f_inv_f: "surj f \ f (inv f y) = y" by (simp add: f_inv_into_f) lemma bij_inv_eq_iff: "bij p \ x = inv p y \ p x = y" using surj_f_inv_f[of p] by (auto simp add: bij_def) lemma inv_into_injective: assumes eq: "inv_into A f x = inv_into A f y" and x: "x \ f`A" and y: "y \ f`A" shows "x = y" proof - from eq have "f (inv_into A f x) = f (inv_into A f y)" by simp with x y show ?thesis by (simp add: f_inv_into_f) qed lemma inj_on_inv_into: "B \ f`A \ inj_on (inv_into A f) B" by (blast intro: inj_onI dest: inv_into_injective injD) lemma inj_imp_bij_betw_inv: "inj f \ bij_betw (inv f) (f ` M) M" by (simp add: bij_betw_def image_subsetI inj_on_inv_into) lemma bij_betw_inv_into: "bij_betw f A B \ bij_betw (inv_into A f) B A" by (auto simp add: bij_betw_def inj_on_inv_into) lemma surj_imp_inj_inv: "surj f \ inj (inv f)" by (simp add: inj_on_inv_into) lemma surj_iff: "surj f \ f \ inv f = id" by (auto intro!: surjI simp: surj_f_inv_f fun_eq_iff[where 'b='a]) lemma surj_iff_all: "surj f \ (\x. f (inv f x) = x)" by (simp add: o_def surj_iff fun_eq_iff) lemma surj_imp_inv_eq: assumes "surj f" and gf: "\x. g (f x) = x" shows "inv f = g" proof (rule ext) fix x have "g (f (inv f x)) = inv f x" by (rule gf) then show "inv f x = g x" by (simp add: surj_f_inv_f \surj f\) qed lemma bij_imp_bij_inv: "bij f \ bij (inv f)" by (simp add: bij_def inj_imp_surj_inv surj_imp_inj_inv) lemma inv_equality: "(\x. g (f x) = x) \ (\y. f (g y) = y) \ inv f = g" by (rule ext) (auto simp add: inv_into_def) lemma inv_inv_eq: "bij f \ inv (inv f) = f" by (rule inv_equality) (auto simp add: bij_def surj_f_inv_f) text \ \bij (inv f)\ implies little about \f\. Consider \f :: bool \ bool\ such that \f True = f False = True\. Then it ia consistent with axiom \someI\ that \inv f\ could be any function at all, including the identity function. If \inv f = id\ then \inv f\ is a bijection, but \inj f\, \surj f\ and \inv (inv f) = f\ all fail. \ lemma inv_into_comp: "inj_on f (g ` A) \ inj_on g A \ x \ f ` g ` A \ inv_into A (f \ g) x = (inv_into A g \ inv_into (g ` A) f) x" by (auto simp: f_inv_into_f inv_into_into intro: inv_into_f_eq comp_inj_on) lemma o_inv_distrib: "bij f \ bij g \ inv (f \ g) = inv g \ inv f" by (rule inv_equality) (auto simp add: bij_def surj_f_inv_f) lemma image_f_inv_f: "surj f \ f ` (inv f ` A) = A" by (simp add: surj_f_inv_f image_comp comp_def) lemma image_inv_f_f: "inj f \ inv f ` (f ` A) = A" by simp lemma bij_image_Collect_eq: assumes "bij f" shows "f ` Collect P = {y. P (inv f y)}" proof show "f ` Collect P \ {y. P (inv f y)}" using assms by (force simp add: bij_is_inj) show "{y. P (inv f y)} \ f ` Collect P" using assms by (blast intro: bij_is_surj [THEN surj_f_inv_f, symmetric]) qed lemma bij_vimage_eq_inv_image: assumes "bij f" shows "f -` A = inv f ` A" proof show "f -` A \ inv f ` A" using assms by (blast intro: bij_is_inj [THEN inv_into_f_f, symmetric]) show "inv f ` A \ f -` A" using assms by (auto simp add: bij_is_surj [THEN surj_f_inv_f]) qed lemma inv_fn_o_fn_is_id: fixes f::"'a \ 'a" assumes "bij f" shows "((inv f)^^n) o (f^^n) = (\x. x)" proof - have "((inv f)^^n)((f^^n) x) = x" for x n proof (induction n) case (Suc n) have *: "(inv f) (f y) = y" for y by (simp add: assms bij_is_inj) have "(inv f ^^ Suc n) ((f ^^ Suc n) x) = (inv f^^n) (inv f (f ((f^^n) x)))" by (simp add: funpow_swap1) also have "... = (inv f^^n) ((f^^n) x)" using * by auto also have "... = x" using Suc.IH by auto finally show ?case by simp qed (auto) then show ?thesis unfolding o_def by blast qed lemma fn_o_inv_fn_is_id: fixes f::"'a \ 'a" assumes "bij f" shows "(f^^n) o ((inv f)^^n) = (\x. x)" proof - have "(f^^n) (((inv f)^^n) x) = x" for x n proof (induction n) case (Suc n) have *: "f(inv f y) = y" for y using bij_inv_eq_iff[OF assms] by auto have "(f ^^ Suc n) ((inv f ^^ Suc n) x) = (f^^n) (f (inv f ((inv f^^n) x)))" by (simp add: funpow_swap1) also have "... = (f^^n) ((inv f^^n) x)" using * by auto also have "... = x" using Suc.IH by auto finally show ?case by simp qed (auto) then show ?thesis unfolding o_def by blast qed lemma inv_fn: fixes f::"'a \ 'a" assumes "bij f" shows "inv (f^^n) = ((inv f)^^n)" proof - have "inv (f^^n) x = ((inv f)^^n) x" for x proof (rule inv_into_f_eq) show "inj (f ^^ n)" by (simp add: inj_fn[OF bij_is_inj [OF assms]]) show "(f ^^ n) ((inv f ^^ n) x) = x" using fn_o_inv_fn_is_id[OF assms, THEN fun_cong] by force qed auto then show ?thesis by auto qed lemma mono_inv: fixes f::"'a::linorder \ 'b::linorder" assumes "mono f" "bij f" shows "mono (inv f)" proof fix x y::'b assume "x \ y" from \bij f\ obtain a b where x: "x = f a" and y: "y = f b" by(fastforce simp: bij_def surj_def) show "inv f x \ inv f y" proof (rule le_cases) assume "a \ b" thus ?thesis using \bij f\ x y by(simp add: bij_def inv_f_f) next assume "b \ a" hence "f b \ f a" by(rule monoD[OF \mono f\]) hence "y \ x" using x y by simp hence "x = y" using \x \ y\ by auto thus ?thesis by simp qed qed lemma strict_mono_inv_on_range: fixes f :: "'a::linorder \ 'b::order" assumes "strict_mono f" shows "strict_mono_on (inv f) (range f)" proof (clarsimp simp: strict_mono_on_def) fix x y assume "f x < f y" then show "inv f (f x) < inv f (f y)" using assms strict_mono_imp_inj_on strict_mono_less by fastforce qed lemma mono_bij_Inf: fixes f :: "'a::complete_linorder \ 'b::complete_linorder" assumes "mono f" "bij f" shows "f (Inf A) = Inf (f`A)" proof - have "surj f" using \bij f\ by (auto simp: bij_betw_def) have *: "(inv f) (Inf (f`A)) \ Inf ((inv f)`(f`A))" using mono_Inf[OF mono_inv[OF assms], of "f`A"] by simp have "Inf (f`A) \ f (Inf ((inv f)`(f`A)))" using monoD[OF \mono f\ *] by(simp add: surj_f_inv_f[OF \surj f\]) also have "... = f(Inf A)" using assms by (simp add: bij_is_inj) finally show ?thesis using mono_Inf[OF assms(1), of A] by auto qed lemma finite_fun_UNIVD1: assumes fin: "finite (UNIV :: ('a \ 'b) set)" and card: "card (UNIV :: 'b set) \ Suc 0" shows "finite (UNIV :: 'a set)" proof - let ?UNIV_b = "UNIV :: 'b set" from fin have "finite ?UNIV_b" by (rule finite_fun_UNIVD2) with card have "card ?UNIV_b \ Suc (Suc 0)" by (cases "card ?UNIV_b") (auto simp: card_eq_0_iff) then have "card ?UNIV_b = Suc (Suc (card ?UNIV_b - Suc (Suc 0)))" by simp then obtain b1 b2 :: 'b where b1b2: "b1 \ b2" by (auto simp: card_Suc_eq) from fin have fin': "finite (range (\f :: 'a \ 'b. inv f b1))" by (rule finite_imageI) have "UNIV = range (\f :: 'a \ 'b. inv f b1)" proof (rule UNIV_eq_I) fix x :: 'a from b1b2 have "x = inv (\y. if y = x then b1 else b2) b1" by (simp add: inv_into_def) then show "x \ range (\f::'a \ 'b. inv f b1)" by blast qed with fin' show ?thesis by simp qed text \ Every infinite set contains a countable subset. More precisely we show that a set \S\ is infinite if and only if there exists an injective function from the naturals into \S\. The ``only if'' direction is harder because it requires the construction of a sequence of pairwise different elements of an infinite set \S\. The idea is to construct a sequence of non-empty and infinite subsets of \S\ obtained by successively removing elements of \S\. \ lemma infinite_countable_subset: assumes inf: "\ finite S" shows "\f::nat \ 'a. inj f \ range f \ S" \ \Courtesy of Stephan Merz\ proof - define Sseq where "Sseq = rec_nat S (\n T. T - {SOME e. e \ T})" define pick where "pick n = (SOME e. e \ Sseq n)" for n have *: "Sseq n \ S" "\ finite (Sseq n)" for n by (induct n) (auto simp: Sseq_def inf) then have **: "\n. pick n \ Sseq n" unfolding pick_def by (subst (asm) finite.simps) (auto simp add: ex_in_conv intro: someI_ex) with * have "range pick \ S" by auto moreover have "pick n \ pick (n + Suc m)" for m n proof - have "pick n \ Sseq (n + Suc m)" by (induct m) (auto simp add: Sseq_def pick_def) with ** show ?thesis by auto qed then have "inj pick" by (intro linorder_injI) (auto simp add: less_iff_Suc_add) ultimately show ?thesis by blast qed lemma infinite_iff_countable_subset: "\ finite S \ (\f::nat \ 'a. inj f \ range f \ S)" \ \Courtesy of Stephan Merz\ using finite_imageD finite_subset infinite_UNIV_char_0 infinite_countable_subset by auto lemma image_inv_into_cancel: assumes surj: "f`A = A'" and sub: "B' \ A'" shows "f `((inv_into A f)`B') = B'" using assms proof (auto simp: f_inv_into_f) let ?f' = "inv_into A f" fix a' assume *: "a' \ B'" with sub have "a' \ A'" by auto with surj have "a' = f (?f' a')" by (auto simp: f_inv_into_f) with * show "a' \ f ` (?f' ` B')" by blast qed lemma inv_into_inv_into_eq: assumes "bij_betw f A A'" and a: "a \ A" shows "inv_into A' (inv_into A f) a = f a" proof - let ?f' = "inv_into A f" let ?f'' = "inv_into A' ?f'" from assms have *: "bij_betw ?f' A' A" by (auto simp: bij_betw_inv_into) with a obtain a' where a': "a' \ A'" "?f' a' = a" unfolding bij_betw_def by force with a * have "?f'' a = a'" by (auto simp: f_inv_into_f bij_betw_def) moreover from assms a' have "f a = a'" by (auto simp: bij_betw_def) ultimately show "?f'' a = f a" by simp qed lemma inj_on_iff_surj: assumes "A \ {}" shows "(\f. inj_on f A \ f ` A \ A') \ (\g. g ` A' = A)" proof safe fix f assume inj: "inj_on f A" and incl: "f ` A \ A'" let ?phi = "\a' a. a \ A \ f a = a'" let ?csi = "\a. a \ A" let ?g = "\a'. if a' \ f ` A then (SOME a. ?phi a' a) else (SOME a. ?csi a)" have "?g ` A' = A" proof show "?g ` A' \ A" proof clarify fix a' assume *: "a' \ A'" show "?g a' \ A" proof (cases "a' \ f ` A") case True then obtain a where "?phi a' a" by blast then have "?phi a' (SOME a. ?phi a' a)" using someI[of "?phi a'" a] by blast with True show ?thesis by auto next case False with assms have "?csi (SOME a. ?csi a)" using someI_ex[of ?csi] by blast with False show ?thesis by auto qed qed next show "A \ ?g ` A'" proof - have "?g (f a) = a \ f a \ A'" if a: "a \ A" for a proof - let ?b = "SOME aa. ?phi (f a) aa" from a have "?phi (f a) a" by auto then have *: "?phi (f a) ?b" using someI[of "?phi(f a)" a] by blast then have "?g (f a) = ?b" using a by auto moreover from inj * a have "a = ?b" by (auto simp add: inj_on_def) ultimately have "?g(f a) = a" by simp with incl a show ?thesis by auto qed then show ?thesis by force qed qed then show "\g. g ` A' = A" by blast next fix g let ?f = "inv_into A' g" have "inj_on ?f (g ` A')" by (auto simp: inj_on_inv_into) moreover have "?f (g a') \ A'" if a': "a' \ A'" for a' proof - let ?phi = "\ b'. b' \ A' \ g b' = g a'" from a' have "?phi a'" by auto then have "?phi (SOME b'. ?phi b')" using someI[of ?phi] by blast then show ?thesis by (auto simp: inv_into_def) qed ultimately show "\f. inj_on f (g ` A') \ f ` g ` A' \ A'" by auto qed lemma Ex_inj_on_UNION_Sigma: "\f. (inj_on f (\i \ I. A i) \ f ` (\i \ I. A i) \ (SIGMA i : I. A i))" proof let ?phi = "\a i. i \ I \ a \ A i" let ?sm = "\a. SOME i. ?phi a i" let ?f = "\a. (?sm a, a)" have "inj_on ?f (\i \ I. A i)" by (auto simp: inj_on_def) moreover have "?sm a \ I \ a \ A(?sm a)" if "i \ I" and "a \ A i" for i a using that someI[of "?phi a" i] by auto then have "?f ` (\i \ I. A i) \ (SIGMA i : I. A i)" by auto ultimately show "inj_on ?f (\i \ I. A i) \ ?f ` (\i \ I. A i) \ (SIGMA i : I. A i)" by auto qed lemma inv_unique_comp: assumes fg: "f \ g = id" and gf: "g \ f = id" shows "inv f = g" using fg gf inv_equality[of g f] by (auto simp add: fun_eq_iff) lemma inv_swap_id: "inv (Fun.swap a b id) = Fun.swap a b id" by (rule inv_unique_comp) simp_all lemma bij_swap_comp: assumes "bij p" shows "Fun.swap a b id \ p = Fun.swap (inv p a) (inv p b) p" using surj_f_inv_f[OF bij_is_surj[OF \bij p\]] by (simp add: fun_eq_iff Fun.swap_def bij_inv_eq_iff[OF \bij p\]) lemma subset_image_inj: "S \ f ` T \ (\U. U \ T \ inj_on f U \ S = f ` U)" proof safe show "\U\T. inj_on f U \ S = f ` U" if "S \ f ` T" proof - from that [unfolded subset_image_iff subset_iff] obtain g where g: "\x. x \ S \ g x \ T \ x = f (g x)" by (auto simp add: image_iff Bex_def choice_iff') show ?thesis proof (intro exI conjI) show "g ` S \ T" by (simp add: g image_subsetI) show "inj_on f (g ` S)" using g by (auto simp: inj_on_def) show "S = f ` (g ` S)" using g image_subset_iff by auto qed qed qed blast subsection \Other Consequences of Hilbert's Epsilon\ text \Hilbert's Epsilon and the \<^term>\split\ Operator\ text \Looping simprule!\ lemma split_paired_Eps: "(SOME x. P x) = (SOME (a, b). P (a, b))" by simp lemma Eps_case_prod: "Eps (case_prod P) = (SOME xy. P (fst xy) (snd xy))" by (simp add: split_def) lemma Eps_case_prod_eq [simp]: "(SOME (x', y'). x = x' \ y = y') = (x, y)" by blast text \A relation is wellfounded iff it has no infinite descending chain.\ lemma wf_iff_no_infinite_down_chain: "wf r \ (\f. \i. (f (Suc i), f i) \ r)" (is "_ \ \ ?ex") proof assume "wf r" show "\ ?ex" proof assume ?ex then obtain f where f: "(f (Suc i), f i) \ r" for i by blast from \wf r\ have minimal: "x \ Q \ \z\Q. \y. (y, z) \ r \ y \ Q" for x Q by (auto simp: wf_eq_minimal) let ?Q = "{w. \i. w = f i}" fix n have "f n \ ?Q" by blast from minimal [OF this] obtain j where "(y, f j) \ r \ y \ ?Q" for y by blast with this [OF \(f (Suc j), f j) \ r\] have "f (Suc j) \ ?Q" by simp then show False by blast qed next assume "\ ?ex" then show "wf r" proof (rule contrapos_np) assume "\ wf r" then obtain Q x where x: "x \ Q" and rec: "z \ Q \ \y. (y, z) \ r \ y \ Q" for z by (auto simp add: wf_eq_minimal) obtain descend :: "nat \ 'a" where descend_0: "descend 0 = x" and descend_Suc: "descend (Suc n) = (SOME y. y \ Q \ (y, descend n) \ r)" for n by (rule that [of "rec_nat x (\_ rec. (SOME y. y \ Q \ (y, rec) \ r))"]) simp_all have descend_Q: "descend n \ Q" for n proof (induct n) case 0 with x show ?case by (simp only: descend_0) next case Suc then show ?case by (simp only: descend_Suc) (rule someI2_ex; use rec in blast) qed have "(descend (Suc i), descend i) \ r" for i by (simp only: descend_Suc) (rule someI2_ex; use descend_Q rec in blast) then show "\f. \i. (f (Suc i), f i) \ r" by blast qed qed lemma wf_no_infinite_down_chainE: assumes "wf r" obtains k where "(f (Suc k), f k) \ r" using assms wf_iff_no_infinite_down_chain[of r] by blast text \A dynamically-scoped fact for TFL\ lemma tfl_some: "\P x. P x \ P (Eps P)" by (blast intro: someI) subsection \An aside: bounded accessible part\ text \Finite monotone eventually stable sequences\ lemma finite_mono_remains_stable_implies_strict_prefix: fixes f :: "nat \ 'a::order" assumes S: "finite (range f)" "mono f" and eq: "\n. f n = f (Suc n) \ f (Suc n) = f (Suc (Suc n))" shows "\N. (\n\N. \m\N. m < n \ f m < f n) \ (\n\N. f N = f n)" using assms proof - have "\n. f n = f (Suc n)" proof (rule ccontr) assume "\ ?thesis" then have "\n. f n \ f (Suc n)" by auto with \mono f\ have "\n. f n < f (Suc n)" by (auto simp: le_less mono_iff_le_Suc) with lift_Suc_mono_less_iff[of f] have *: "\n m. n < m \ f n < f m" by auto have "inj f" proof (intro injI) fix x y assume "f x = f y" then show "x = y" by (cases x y rule: linorder_cases) (auto dest: *) qed with \finite (range f)\ have "finite (UNIV::nat set)" by (rule finite_imageD) then show False by simp qed then obtain n where n: "f n = f (Suc n)" .. define N where "N = (LEAST n. f n = f (Suc n))" have N: "f N = f (Suc N)" unfolding N_def using n by (rule LeastI) show ?thesis proof (intro exI[of _ N] conjI allI impI) fix n assume "N \ n" then have "\m. N \ m \ m \ n \ f m = f N" proof (induct rule: dec_induct) case base then show ?case by simp next case (step n) then show ?case using eq [rule_format, of "n - 1"] N by (cases n) (auto simp add: le_Suc_eq) qed from this[of n] \N \ n\ show "f N = f n" by auto next fix n m :: nat assume "m < n" "n \ N" then show "f m < f n" proof (induct rule: less_Suc_induct) case (1 i) then have "i < N" by simp then have "f i \ f (Suc i)" unfolding N_def by (rule not_less_Least) with \mono f\ show ?case by (simp add: mono_iff_le_Suc less_le) next case 2 then show ?case by simp qed qed qed lemma finite_mono_strict_prefix_implies_finite_fixpoint: fixes f :: "nat \ 'a set" assumes S: "\i. f i \ S" "finite S" and ex: "\N. (\n\N. \m\N. m < n \ f m \ f n) \ (\n\N. f N = f n)" shows "f (card S) = (\n. f n)" proof - from ex obtain N where inj: "\n m. n \ N \ m \ N \ m < n \ f m \ f n" and eq: "\n\N. f N = f n" by atomize auto have "i \ N \ i \ card (f i)" for i proof (induct i) case 0 then show ?case by simp next case (Suc i) with inj [of "Suc i" i] have "(f i) \ (f (Suc i))" by auto moreover have "finite (f (Suc i))" using S by (rule finite_subset) ultimately have "card (f i) < card (f (Suc i))" by (intro psubset_card_mono) with Suc inj show ?case by auto qed then have "N \ card (f N)" by simp also have "\ \ card S" using S by (intro card_mono) finally have \
: "f (card S) = f N" using eq by auto moreover have "\ (range f) \ f N" proof clarify fix x n assume "x \ f n" with eq inj [of N] show "x \ f N" by (cases "n < N") (auto simp: not_less) qed ultimately show ?thesis by auto qed subsection \More on injections, bijections, and inverses\ locale bijection = fixes f :: "'a \ 'a" assumes bij: "bij f" begin lemma bij_inv: "bij (inv f)" using bij by (rule bij_imp_bij_inv) lemma surj [simp]: "surj f" using bij by (rule bij_is_surj) lemma inj: "inj f" using bij by (rule bij_is_inj) lemma surj_inv [simp]: "surj (inv f)" using inj by (rule inj_imp_surj_inv) lemma inj_inv: "inj (inv f)" using surj by (rule surj_imp_inj_inv) lemma eqI: "f a = f b \ a = b" using inj by (rule injD) lemma eq_iff [simp]: "f a = f b \ a = b" by (auto intro: eqI) lemma eq_invI: "inv f a = inv f b \ a = b" using inj_inv by (rule injD) lemma eq_inv_iff [simp]: "inv f a = inv f b \ a = b" by (auto intro: eq_invI) lemma inv_left [simp]: "inv f (f a) = a" using inj by (simp add: inv_f_eq) lemma inv_comp_left [simp]: "inv f \ f = id" by (simp add: fun_eq_iff) lemma inv_right [simp]: "f (inv f a) = a" using surj by (simp add: surj_f_inv_f) lemma inv_comp_right [simp]: "f \ inv f = id" by (simp add: fun_eq_iff) lemma inv_left_eq_iff [simp]: "inv f a = b \ f b = a" by auto lemma inv_right_eq_iff [simp]: "b = inv f a \ f b = a" by auto end lemma infinite_imp_bij_betw: assumes infinite: "\ finite A" shows "\h. bij_betw h A (A - {a})" proof (cases "a \ A") case False then have "A - {a} = A" by blast then show ?thesis using bij_betw_id[of A] by auto next case True with infinite have "\ finite (A - {a})" by auto with infinite_iff_countable_subset[of "A - {a}"] obtain f :: "nat \ 'a" where "inj f" and f: "f ` UNIV \ A - {a}" by blast define g where "g n = (if n = 0 then a else f (Suc n))" for n define A' where "A' = g ` UNIV" have *: "\y. f y \ a" using f by blast have 3: "inj_on g UNIV \ g ` UNIV \ A \ a \ g ` UNIV" using \inj f\ f * unfolding inj_on_def g_def by (auto simp add: True image_subset_iff) then have 4: "bij_betw g UNIV A' \ a \ A' \ A' \ A" using inj_on_imp_bij_betw[of g] by (auto simp: A'_def) then have 5: "bij_betw (inv g) A' UNIV" by (auto simp add: bij_betw_inv_into) from 3 obtain n where n: "g n = a" by auto have 6: "bij_betw g (UNIV - {n}) (A' - {a})" by (rule bij_betw_subset) (use 3 4 n in \auto simp: image_set_diff A'_def\) define v where "v m = (if m < n then m else Suc m)" for m have "m < n \ m = n" if "\k. k < n \ m \ Suc k" for m using that [of "m-1"] by auto then have 7: "bij_betw v UNIV (UNIV - {n})" unfolding bij_betw_def inj_on_def v_def by auto define h' where "h' = g \ v \ (inv g)" with 5 6 7 have 8: "bij_betw h' A' (A' - {a})" by (auto simp add: bij_betw_trans) define h where "h b = (if b \ A' then h' b else b)" for b with 8 have "bij_betw h A' (A' - {a})" using bij_betw_cong[of A' h] by auto moreover have "\b \ A - A'. h b = b" by (auto simp: h_def) then have "bij_betw h (A - A') (A - A')" using bij_betw_cong[of "A - A'" h id] bij_betw_id[of "A - A'"] by auto moreover from 4 have "(A' \ (A - A') = {} \ A' \ (A - A') = A) \ ((A' - {a}) \ (A - A') = {} \ (A' - {a}) \ (A - A') = A - {a})" by blast ultimately have "bij_betw h A (A - {a})" using bij_betw_combine[of h A' "A' - {a}" "A - A'" "A - A'"] by simp then show ?thesis by blast qed lemma infinite_imp_bij_betw2: assumes "\ finite A" shows "\h. bij_betw h A (A \ {a})" proof (cases "a \ A") case True then have "A \ {a} = A" by blast then show ?thesis using bij_betw_id[of A] by auto next case False let ?A' = "A \ {a}" from False have "A = ?A' - {a}" by blast moreover from assms have "\ finite ?A'" by auto ultimately obtain f where "bij_betw f ?A' A" using infinite_imp_bij_betw[of ?A' a] by auto then have "bij_betw (inv_into ?A' f) A ?A'" by (rule bij_betw_inv_into) then show ?thesis by auto qed lemma bij_betw_inv_into_left: "bij_betw f A A' \ a \ A \ inv_into A f (f a) = a" unfolding bij_betw_def by clarify (rule inv_into_f_f) lemma bij_betw_inv_into_right: "bij_betw f A A' \ a' \ A' \ f (inv_into A f a') = a'" unfolding bij_betw_def using f_inv_into_f by force lemma bij_betw_inv_into_subset: "bij_betw f A A' \ B \ A \ f ` B = B' \ bij_betw (inv_into A f) B' B" by (auto simp: bij_betw_def intro: inj_on_inv_into) subsection \Specification package -- Hilbertized version\ lemma exE_some: "Ex P \ c \ Eps P \ P c" by (simp only: someI_ex) ML_file \Tools/choice_specification.ML\ subsection \Complete Distributive Lattices -- Properties depending on Hilbert Choice\ context complete_distrib_lattice begin lemma Sup_Inf: "\ (Inf ` A) = \ (Sup ` {f ` A |f. \B\A. f B \ B})" -proof (rule antisym) +proof (rule order.antisym) show "\ (Inf ` A) \ \ (Sup ` {f ` A |f. \B\A. f B \ B})" using Inf_lower2 Sup_upper by (fastforce simp add: intro: Sup_least INF_greatest) next show "\ (Sup ` {f ` A |f. \B\A. f B \ B}) \ \ (Inf ` A)" proof (simp add: Inf_Sup, rule SUP_least, simp, safe) fix f assume "\Y. (\f. Y = f ` A \ (\Y\A. f Y \ Y)) \ f Y \ Y" then have B: "\ F . (\ Y \ A . F Y \ Y) \ \ Z \ A . f (F ` A) = F Z" by auto show "\(f ` {f ` A |f. \Y\A. f Y \ Y}) \ \(Inf ` A)" proof (cases "\ Z \ A . \(f ` {f ` A |f. \Y\A. f Y \ Y}) \ Inf Z") case True from this obtain Z where [simp]: "Z \ A" and A: "\(f ` {f ` A |f. \Y\A. f Y \ Y}) \ Inf Z" by blast have B: "... \ \(Inf ` A)" by (simp add: SUP_upper) from A and B show ?thesis by simp next case False then have X: "\ Z . Z \ A \ \ x . x \ Z \ \ \(f ` {f ` A |f. \Y\A. f Y \ Y}) \ x" using Inf_greatest by blast define F where "F = (\ Z . SOME x . x \ Z \ \ \(f ` {f ` A |f. \Y\A. f Y \ Y}) \ x)" have C: "\Y. Y \ A \ F Y \ Y" using X by (simp add: F_def, rule someI2_ex, auto) have E: "\Y. Y \ A \ \ \(f ` {f ` A |f. \Y\A. f Y \ Y}) \ F Y" using X by (simp add: F_def, rule someI2_ex, auto) from C and B obtain Z where D: "Z \ A " and Y: "f (F ` A) = F Z" by blast from E and D have W: "\ \(f ` {f ` A |f. \Y\A. f Y \ Y}) \ F Z" by simp have "\(f ` {f ` A |f. \Y\A. f Y \ Y}) \ f (F ` A)" using C by (blast intro: INF_lower) with W Y show ?thesis by simp qed qed qed lemma dual_complete_distrib_lattice: "class.complete_distrib_lattice Sup Inf sup (\) (>) inf \ \" by (simp add: class.complete_distrib_lattice.intro [OF dual_complete_lattice] class.complete_distrib_lattice_axioms_def Sup_Inf) lemma sup_Inf: "a \ \B = \((\) a ` B)" -proof (rule antisym) +proof (rule order.antisym) show "a \ \B \ \((\) a ` B)" using Inf_lower sup.mono by (fastforce intro: INF_greatest) next have "\((\) a ` B) \ \(Sup ` {{f {a}, f B} |f. f {a} = a \ f B \ B})" by (rule INF_greatest, auto simp add: INF_lower) also have "... = \(Inf ` {{a}, B})" by (unfold Sup_Inf, simp) finally show "\((\) a ` B) \ a \ \B" by simp qed lemma inf_Sup: "a \ \B = \((\) a ` B)" using dual_complete_distrib_lattice by (rule complete_distrib_lattice.sup_Inf) lemma INF_SUP: "(\y. \x. P x y) = (\f. \x. P (f x) x)" -proof (rule antisym) +proof (rule order.antisym) show "(SUP x. INF y. P (x y) y) \ (INF y. SUP x. P x y)" by (rule SUP_least, rule INF_greatest, rule SUP_upper2, simp_all, rule INF_lower2, simp, blast) next have "(INF y. SUP x. ((P x y))) \ Inf (Sup ` {{P x y | x . True} | y . True })" (is "?A \ ?B") proof (rule INF_greatest, clarsimp) fix y have "?A \ (SUP x. P x y)" by (rule INF_lower, simp) also have "... \ Sup {uu. \x. uu = P x y}" by (simp add: full_SetCompr_eq) finally show "?A \ Sup {uu. \x. uu = P x y}" by simp qed also have "... \ (SUP x. INF y. P (x y) y)" proof (subst Inf_Sup, rule SUP_least, clarsimp) fix f assume A: "\Y. (\y. Y = {uu. \x. uu = P x y}) \ f Y \ Y" have " \(f ` {uu. \y. uu = {uu. \x. uu = P x y}}) \ (\y. P (SOME x. f {P x y |x. True} = P x y) y)" proof (rule INF_greatest, clarsimp) fix y have "(INF x\{uu. \y. uu = {uu. \x. uu = P x y}}. f x) \ f {uu. \x. uu = P x y}" by (rule INF_lower, blast) also have "... \ P (SOME x. f {uu . \x. uu = P x y} = P x y) y" by (rule someI2_ex) (use A in auto) finally show "\(f ` {uu. \y. uu = {uu. \x. uu = P x y}}) \ P (SOME x. f {uu. \x. uu = P x y} = P x y) y" by simp qed also have "... \ (SUP x. INF y. P (x y) y)" by (rule SUP_upper, simp) finally show "\(f ` {uu. \y. uu = {uu. \x. uu = P x y}}) \ (\x. \y. P (x y) y)" by simp qed finally show "(INF y. SUP x. P x y) \ (SUP x. INF y. P (x y) y)" by simp qed lemma INF_SUP_set: "(\B\A. \(g ` B)) = (\B\{f ` A |f. \C\A. f C \ C}. \(g ` B))" (is "_ = (\B\?F. _)") -proof (rule antisym) +proof (rule order.antisym) have "\ ((g \ f) ` A) \ \ (g ` B)" if "\B. B \ A \ f B \ B" "B \ A" for f B using that by (auto intro: SUP_upper2 INF_lower2) then show "(\x\?F. \a\x. g a) \ (\x\A. \a\x. g a)" by (auto intro!: SUP_least INF_greatest simp add: image_comp) next show "(\x\A. \a\x. g a) \ (\x\?F. \a\x. g a)" proof (cases "{} \ A") case True then show ?thesis by (rule INF_lower2) simp_all next case False {fix x have "(\x\A. \x\x. g x) \ (\u. if x \ A then if u \ x then g u else \ else \)" proof (cases "x \ A") case True then show ?thesis by (intro INF_lower2 SUP_least SUP_upper2) auto qed auto } then have "(\Y\A. \a\Y. g a) \ (\Y. \y. if Y \ A then if y \ Y then g y else \ else \)" by (rule INF_greatest) also have "... = (\x. \Y. if Y \ A then if x Y \ Y then g (x Y) else \ else \)" by (simp only: INF_SUP) also have "... \ (\x\?F. \a\x. g a)" proof (rule SUP_least) show "(\B. if B \ A then if x B \ B then g (x B) else \ else \) \ (\x\?F. \x\x. g x)" for x proof - define G where "G \ \Y. if x Y \ Y then x Y else (SOME x. x \Y)" have "\Y\A. G Y \ Y" using False some_in_eq G_def by auto then have A: "G ` A \ ?F" by blast show "(\Y. if Y \ A then if x Y \ Y then g (x Y) else \ else \) \ (\x\?F. \x\x. g x)" by (fastforce simp: G_def intro: SUP_upper2 [OF A] INF_greatest INF_lower2) qed qed finally show ?thesis by simp qed qed lemma SUP_INF: "(\y. \x. P x y) = (\x. \y. P (x y) y)" using dual_complete_distrib_lattice by (rule complete_distrib_lattice.INF_SUP) lemma SUP_INF_set: "(\x\A. \ (g ` x)) = (\x\{f ` A |f. \Y\A. f Y \ Y}. \ (g ` x))" using dual_complete_distrib_lattice by (rule complete_distrib_lattice.INF_SUP_set) end (*properties of the former complete_distrib_lattice*) context complete_distrib_lattice begin lemma sup_INF: "a \ (\b\B. f b) = (\b\B. a \ f b)" by (simp add: sup_Inf image_comp) lemma inf_SUP: "a \ (\b\B. f b) = (\b\B. a \ f b)" by (simp add: inf_Sup image_comp) lemma Inf_sup: "\B \ a = (\b\B. b \ a)" by (simp add: sup_Inf sup_commute) lemma Sup_inf: "\B \ a = (\b\B. b \ a)" by (simp add: inf_Sup inf_commute) lemma INF_sup: "(\b\B. f b) \ a = (\b\B. f b \ a)" by (simp add: sup_INF sup_commute) lemma SUP_inf: "(\b\B. f b) \ a = (\b\B. f b \ a)" by (simp add: inf_SUP inf_commute) lemma Inf_sup_eq_top_iff: "(\B \ a = \) \ (\b\B. b \ a = \)" by (simp only: Inf_sup INF_top_conv) lemma Sup_inf_eq_bot_iff: "(\B \ a = \) \ (\b\B. b \ a = \)" by (simp only: Sup_inf SUP_bot_conv) lemma INF_sup_distrib2: "(\a\A. f a) \ (\b\B. g b) = (\a\A. \b\B. f a \ g b)" by (subst INF_commute) (simp add: sup_INF INF_sup) lemma SUP_inf_distrib2: "(\a\A. f a) \ (\b\B. g b) = (\a\A. \b\B. f a \ g b)" by (subst SUP_commute) (simp add: inf_SUP SUP_inf) end context complete_boolean_algebra begin lemma dual_complete_boolean_algebra: "class.complete_boolean_algebra Sup Inf sup (\) (>) inf \ \ (\x y. x \ - y) uminus" by (rule class.complete_boolean_algebra.intro, rule dual_complete_distrib_lattice, rule dual_boolean_algebra) end instantiation set :: (type) complete_distrib_lattice begin instance proof (standard, clarsimp) fix A :: "(('a set) set) set" fix x::'a assume A: "\\\A. \X\\. x \ X" define F where "F \ \Y. SOME X. Y \ A \ X \ Y \ x \ X" have "(\S \ F ` A. x \ S)" using A unfolding F_def by (fastforce intro: someI2_ex) moreover have "\Y\A. F Y \ Y" using A unfolding F_def by (fastforce intro: someI2_ex) then have "\f. F ` A = f ` A \ (\Y\A. f Y \ Y)" by blast ultimately show "\X. (\f. X = f ` A \ (\Y\A. f Y \ Y)) \ (\S\X. x \ S)" by auto qed end instance set :: (type) complete_boolean_algebra .. instantiation "fun" :: (type, complete_distrib_lattice) complete_distrib_lattice begin instance by standard (simp add: le_fun_def INF_SUP_set image_comp) end instance "fun" :: (type, complete_boolean_algebra) complete_boolean_algebra .. context complete_linorder begin subclass complete_distrib_lattice proof (standard, rule ccontr) fix A :: "'a set set" let ?F = "{f ` A |f. \Y\A. f Y \ Y}" assume "\ \(Sup ` A) \ \(Inf ` ?F)" then have C: "\(Sup ` A) > \(Inf ` ?F)" by (simp add: not_le) show False proof (cases "\ z . \(Sup ` A) > z \ z > \(Inf ` ?F)") case True then obtain z where A: "z < \(Sup ` A)" and X: "z > \(Inf ` ?F)" by blast then have B: "\Y. Y \ A \ \k \Y . z < k" using local.less_Sup_iff by(force dest: less_INF_D) define G where "G \ \Y. SOME k . k \ Y \ z < k" have E: "\Y. Y \ A \ G Y \ Y" using B unfolding G_def by (fastforce intro: someI2_ex) have "z \ Inf (G ` A)" proof (rule INF_greatest) show "\Y. Y \ A \ z \ G Y" using B unfolding G_def by (fastforce intro: someI2_ex) qed also have "... \ \(Inf ` ?F)" by (rule SUP_upper) (use E in blast) finally have "z \ \(Inf ` ?F)" by simp with X show ?thesis using local.not_less by blast next case False have B: "\Y. Y \ A \ \ k \Y . \(Inf ` ?F) < k" using C local.less_Sup_iff by(force dest: less_INF_D) define G where "G \ \ Y . SOME k . k \ Y \ \(Inf ` ?F) < k" have E: "\Y. Y \ A \ G Y \ Y" using B unfolding G_def by (fastforce intro: someI2_ex) have "\Y. Y \ A \ \(Sup ` A) \ G Y" using B False local.leI unfolding G_def by (fastforce intro: someI2_ex) then have "\(Sup ` A) \ Inf (G ` A)" by (simp add: local.INF_greatest) also have "Inf (G ` A) \ \(Inf ` ?F)" by (rule SUP_upper) (use E in blast) finally have "\(Sup ` A) \ \(Inf ` ?F)" by simp with C show ?thesis using not_less by blast qed qed end end diff --git a/src/HOL/IMP/Abs_Int3.thy b/src/HOL/IMP/Abs_Int3.thy --- a/src/HOL/IMP/Abs_Int3.thy +++ b/src/HOL/IMP/Abs_Int3.thy @@ -1,629 +1,629 @@ (* Author: Tobias Nipkow *) subsection "Widening and Narrowing" theory Abs_Int3 imports Abs_Int2_ivl begin class widen = fixes widen :: "'a \ 'a \ 'a" (infix "\" 65) class narrow = fixes narrow :: "'a \ 'a \ 'a" (infix "\" 65) class wn = widen + narrow + order + assumes widen1: "x \ x \ y" assumes widen2: "y \ x \ y" assumes narrow1: "y \ x \ y \ x \ y" assumes narrow2: "y \ x \ x \ y \ x" begin lemma narrowid[simp]: "x \ x = x" -by (metis eq_iff narrow1 narrow2) +by (rule order.antisym) (simp_all add: narrow1 narrow2) end lemma top_widen_top[simp]: "\ \ \ = (\::_::{wn,order_top})" by (metis eq_iff top_greatest widen2) instantiation ivl :: wn begin definition "widen_rep p1 p2 = (if is_empty_rep p1 then p2 else if is_empty_rep p2 then p1 else let (l1,h1) = p1; (l2,h2) = p2 in (if l2 < l1 then Minf else l1, if h1 < h2 then Pinf else h1))" lift_definition widen_ivl :: "ivl \ ivl \ ivl" is widen_rep by(auto simp: widen_rep_def eq_ivl_iff) definition "narrow_rep p1 p2 = (if is_empty_rep p1 \ is_empty_rep p2 then empty_rep else let (l1,h1) = p1; (l2,h2) = p2 in (if l1 = Minf then l2 else l1, if h1 = Pinf then h2 else h1))" lift_definition narrow_ivl :: "ivl \ ivl \ ivl" is narrow_rep by(auto simp: narrow_rep_def eq_ivl_iff) instance proof qed (transfer, auto simp: widen_rep_def narrow_rep_def le_iff_subset \_rep_def subset_eq is_empty_rep_def empty_rep_def eq_ivl_def split: if_splits extended.splits)+ end instantiation st :: ("{order_top,wn}")wn begin lift_definition widen_st :: "'a st \ 'a st \ 'a st" is "map2_st_rep (\)" by(auto simp: eq_st_def) lift_definition narrow_st :: "'a st \ 'a st \ 'a st" is "map2_st_rep (\)" by(auto simp: eq_st_def) instance proof (standard, goal_cases) case 1 thus ?case by transfer (simp add: less_eq_st_rep_iff widen1) next case 2 thus ?case by transfer (simp add: less_eq_st_rep_iff widen2) next case 3 thus ?case by transfer (simp add: less_eq_st_rep_iff narrow1) next case 4 thus ?case by transfer (simp add: less_eq_st_rep_iff narrow2) qed end instantiation option :: (wn)wn begin fun widen_option where "None \ x = x" | "x \ None = x" | "(Some x) \ (Some y) = Some(x \ y)" fun narrow_option where "None \ x = None" | "x \ None = None" | "(Some x) \ (Some y) = Some(x \ y)" instance proof (standard, goal_cases) case (1 x y) thus ?case by(induct x y rule: widen_option.induct)(simp_all add: widen1) next case (2 x y) thus ?case by(induct x y rule: widen_option.induct)(simp_all add: widen2) next case (3 x y) thus ?case by(induct x y rule: narrow_option.induct) (simp_all add: narrow1) next case (4 y x) thus ?case by(induct x y rule: narrow_option.induct) (simp_all add: narrow2) qed end definition map2_acom :: "('a \ 'a \ 'a) \ 'a acom \ 'a acom \ 'a acom" where "map2_acom f C1 C2 = annotate (\p. f (anno C1 p) (anno C2 p)) (strip C1)" instantiation acom :: (widen)widen begin definition "widen_acom = map2_acom (\)" instance .. end instantiation acom :: (narrow)narrow begin definition "narrow_acom = map2_acom (\)" instance .. end lemma strip_map2_acom[simp]: "strip C1 = strip C2 \ strip(map2_acom f C1 C2) = strip C1" by(simp add: map2_acom_def) (*by(induct f C1 C2 rule: map2_acom.induct) simp_all*) lemma strip_widen_acom[simp]: "strip C1 = strip C2 \ strip(C1 \ C2) = strip C1" by(simp add: widen_acom_def) lemma strip_narrow_acom[simp]: "strip C1 = strip C2 \ strip(C1 \ C2) = strip C1" by(simp add: narrow_acom_def) lemma narrow1_acom: "C2 \ C1 \ C2 \ C1 \ (C2::'a::wn acom)" by(simp add: narrow_acom_def narrow1 map2_acom_def less_eq_acom_def size_annos) lemma narrow2_acom: "C2 \ C1 \ C1 \ (C2::'a::wn acom) \ C1" by(simp add: narrow_acom_def narrow2 map2_acom_def less_eq_acom_def size_annos) subsubsection "Pre-fixpoint computation" definition iter_widen :: "('a \ 'a) \ 'a \ ('a::{order,widen})option" where "iter_widen f = while_option (\x. \ f x \ x) (\x. x \ f x)" definition iter_narrow :: "('a \ 'a) \ 'a \ ('a::{order,narrow})option" where "iter_narrow f = while_option (\x. x \ f x < x) (\x. x \ f x)" definition pfp_wn :: "('a::{order,widen,narrow} \ 'a) \ 'a \ 'a option" where "pfp_wn f x = (case iter_widen f x of None \ None | Some p \ iter_narrow f p)" lemma iter_widen_pfp: "iter_widen f x = Some p \ f p \ p" by(auto simp add: iter_widen_def dest: while_option_stop) lemma iter_widen_inv: assumes "!!x. P x \ P(f x)" "!!x1 x2. P x1 \ P x2 \ P(x1 \ x2)" and "P x" and "iter_widen f x = Some y" shows "P y" using while_option_rule[where P = "P", OF _ assms(4)[unfolded iter_widen_def]] by (blast intro: assms(1-3)) lemma strip_while: fixes f :: "'a acom \ 'a acom" assumes "\C. strip (f C) = strip C" and "while_option P f C = Some C'" shows "strip C' = strip C" using while_option_rule[where P = "\C'. strip C' = strip C", OF _ assms(2)] by (metis assms(1)) lemma strip_iter_widen: fixes f :: "'a::{order,widen} acom \ 'a acom" assumes "\C. strip (f C) = strip C" and "iter_widen f C = Some C'" shows "strip C' = strip C" proof- have "\C. strip(C \ f C) = strip C" by (metis assms(1) strip_map2_acom widen_acom_def) from strip_while[OF this] assms(2) show ?thesis by(simp add: iter_widen_def) qed lemma iter_narrow_pfp: assumes mono: "!!x1 x2::_::wn acom. P x1 \ P x2 \ x1 \ x2 \ f x1 \ f x2" and Pinv: "!!x. P x \ P(f x)" "!!x1 x2. P x1 \ P x2 \ P(x1 \ x2)" and "P p0" and "f p0 \ p0" and "iter_narrow f p0 = Some p" shows "P p \ f p \ p" proof- let ?Q = "%p. P p \ f p \ p \ p \ p0" have "?Q (p \ f p)" if Q: "?Q p" for p proof auto note P = conjunct1[OF Q] and 12 = conjunct2[OF Q] note 1 = conjunct1[OF 12] and 2 = conjunct2[OF 12] let ?p' = "p \ f p" show "P ?p'" by (blast intro: P Pinv) have "f ?p' \ f p" by(rule mono[OF \P (p \ f p)\ P narrow2_acom[OF 1]]) also have "\ \ ?p'" by(rule narrow1_acom[OF 1]) finally show "f ?p' \ ?p'" . have "?p' \ p" by (rule narrow2_acom[OF 1]) also have "p \ p0" by(rule 2) finally show "?p' \ p0" . qed thus ?thesis using while_option_rule[where P = ?Q, OF _ assms(6)[simplified iter_narrow_def]] by (blast intro: assms(4,5) le_refl) qed lemma pfp_wn_pfp: assumes mono: "!!x1 x2::_::wn acom. P x1 \ P x2 \ x1 \ x2 \ f x1 \ f x2" and Pinv: "P x" "!!x. P x \ P(f x)" "!!x1 x2. P x1 \ P x2 \ P(x1 \ x2)" "!!x1 x2. P x1 \ P x2 \ P(x1 \ x2)" and pfp_wn: "pfp_wn f x = Some p" shows "P p \ f p \ p" proof- from pfp_wn obtain p0 where its: "iter_widen f x = Some p0" "iter_narrow f p0 = Some p" by(auto simp: pfp_wn_def split: option.splits) have "P p0" by (blast intro: iter_widen_inv[where P="P"] its(1) Pinv(1-3)) thus ?thesis by - (assumption | rule iter_narrow_pfp[where P=P] mono Pinv(2,4) iter_widen_pfp its)+ qed lemma strip_pfp_wn: "\ \C. strip(f C) = strip C; pfp_wn f C = Some C' \ \ strip C' = strip C" by(auto simp add: pfp_wn_def iter_narrow_def split: option.splits) (metis (mono_tags) strip_iter_widen strip_narrow_acom strip_while) locale Abs_Int_wn = Abs_Int_inv_mono where \=\ for \ :: "'av::{wn,bounded_lattice} \ val set" begin definition AI_wn :: "com \ 'av st option acom option" where "AI_wn c = pfp_wn (step' \) (bot c)" lemma AI_wn_correct: "AI_wn c = Some C \ CS c \ \\<^sub>c C" proof(simp add: CS_def AI_wn_def) assume 1: "pfp_wn (step' \) (bot c) = Some C" have 2: "strip C = c \ step' \ C \ C" by(rule pfp_wn_pfp[where x="bot c"]) (simp_all add: 1 mono_step'_top) have pfp: "step (\\<^sub>o \) (\\<^sub>c C) \ \\<^sub>c C" proof(rule order_trans) show "step (\\<^sub>o \) (\\<^sub>c C) \ \\<^sub>c (step' \ C)" by(rule step_step') show "... \ \\<^sub>c C" by(rule mono_gamma_c[OF conjunct2[OF 2]]) qed have 3: "strip (\\<^sub>c C) = c" by(simp add: strip_pfp_wn[OF _ 1]) have "lfp c (step (\\<^sub>o \)) \ \\<^sub>c C" by(rule lfp_lowerbound[simplified,where f="step (\\<^sub>o \)", OF 3 pfp]) thus "lfp c (step UNIV) \ \\<^sub>c C" by simp qed end global_interpretation Abs_Int_wn where \ = \_ivl and num' = num_ivl and plus' = "(+)" and test_num' = in_ivl and inv_plus' = inv_plus_ivl and inv_less' = inv_less_ivl defines AI_wn_ivl = AI_wn .. subsubsection "Tests" definition "step_up_ivl n = ((\C. C \ step_ivl \ C)^^n)" definition "step_down_ivl n = ((\C. C \ step_ivl \ C)^^n)" text\For \<^const>\test3_ivl\, \<^const>\AI_ivl\ needed as many iterations as the loop took to execute. In contrast, \<^const>\AI_wn_ivl\ converges in a constant number of steps:\ value "show_acom (step_up_ivl 1 (bot test3_ivl))" value "show_acom (step_up_ivl 2 (bot test3_ivl))" value "show_acom (step_up_ivl 3 (bot test3_ivl))" value "show_acom (step_up_ivl 4 (bot test3_ivl))" value "show_acom (step_up_ivl 5 (bot test3_ivl))" value "show_acom (step_up_ivl 6 (bot test3_ivl))" value "show_acom (step_up_ivl 7 (bot test3_ivl))" value "show_acom (step_up_ivl 8 (bot test3_ivl))" value "show_acom (step_down_ivl 1 (step_up_ivl 8 (bot test3_ivl)))" value "show_acom (step_down_ivl 2 (step_up_ivl 8 (bot test3_ivl)))" value "show_acom (step_down_ivl 3 (step_up_ivl 8 (bot test3_ivl)))" value "show_acom (step_down_ivl 4 (step_up_ivl 8 (bot test3_ivl)))" value "show_acom_opt (AI_wn_ivl test3_ivl)" text\Now all the analyses terminate:\ value "show_acom_opt (AI_wn_ivl test4_ivl)" value "show_acom_opt (AI_wn_ivl test5_ivl)" value "show_acom_opt (AI_wn_ivl test6_ivl)" subsubsection "Generic Termination Proof" lemma top_on_opt_widen: "top_on_opt o1 X \ top_on_opt o2 X \ top_on_opt (o1 \ o2 :: _ st option) X" apply(induct o1 o2 rule: widen_option.induct) apply (auto) by transfer simp lemma top_on_opt_narrow: "top_on_opt o1 X \ top_on_opt o2 X \ top_on_opt (o1 \ o2 :: _ st option) X" apply(induct o1 o2 rule: narrow_option.induct) apply (auto) by transfer simp (* FIXME mk anno abbrv *) lemma annos_map2_acom[simp]: "strip C2 = strip C1 \ annos(map2_acom f C1 C2) = map (%(x,y).f x y) (zip (annos C1) (annos C2))" by(simp add: map2_acom_def list_eq_iff_nth_eq size_annos anno_def[symmetric] size_annos_same[of C1 C2]) lemma top_on_acom_widen: "\top_on_acom C1 X; strip C1 = strip C2; top_on_acom C2 X\ \ top_on_acom (C1 \ C2 :: _ st option acom) X" by(auto simp add: widen_acom_def top_on_acom_def)(metis top_on_opt_widen in_set_zipE) lemma top_on_acom_narrow: "\top_on_acom C1 X; strip C1 = strip C2; top_on_acom C2 X\ \ top_on_acom (C1 \ C2 :: _ st option acom) X" by(auto simp add: narrow_acom_def top_on_acom_def)(metis top_on_opt_narrow in_set_zipE) text\The assumptions for widening and narrowing differ because during narrowing we have the invariant \<^prop>\y \ x\ (where \y\ is the next iterate), but during widening there is no such invariant, there we only have that not yet \<^prop>\y \ x\. This complicates the termination proof for widening.\ locale Measure_wn = Measure1 where m=m for m :: "'av::{order_top,wn} \ nat" + fixes n :: "'av \ nat" assumes m_anti_mono: "x \ y \ m x \ m y" assumes m_widen: "~ y \ x \ m(x \ y) < m x" assumes n_narrow: "y \ x \ x \ y < x \ n(x \ y) < n x" begin lemma m_s_anti_mono_rep: assumes "\x. S1 x \ S2 x" shows "(\x\X. m (S2 x)) \ (\x\X. m (S1 x))" proof- from assms have "\x. m(S1 x) \ m(S2 x)" by (metis m_anti_mono) thus "(\x\X. m (S2 x)) \ (\x\X. m (S1 x))" by (metis sum_mono) qed lemma m_s_anti_mono: "S1 \ S2 \ m_s S1 X \ m_s S2 X" unfolding m_s_def apply (transfer fixing: m) apply(simp add: less_eq_st_rep_iff eq_st_def m_s_anti_mono_rep) done lemma m_s_widen_rep: assumes "finite X" "S1 = S2 on -X" "\ S2 x \ S1 x" shows "(\x\X. m (S1 x \ S2 x)) < (\x\X. m (S1 x))" proof- have 1: "\x\X. m(S1 x) \ m(S1 x \ S2 x)" by (metis m_anti_mono wn_class.widen1) have "x \ X" using assms(2,3) by(auto simp add: Ball_def) hence 2: "\x\X. m(S1 x) > m(S1 x \ S2 x)" using assms(3) m_widen by blast from sum_strict_mono_ex1[OF \finite X\ 1 2] show ?thesis . qed lemma m_s_widen: "finite X \ fun S1 = fun S2 on -X ==> ~ S2 \ S1 \ m_s (S1 \ S2) X < m_s S1 X" apply(auto simp add: less_st_def m_s_def) apply (transfer fixing: m) apply(auto simp add: less_eq_st_rep_iff m_s_widen_rep) done lemma m_o_anti_mono: "finite X \ top_on_opt o1 (-X) \ top_on_opt o2 (-X) \ o1 \ o2 \ m_o o1 X \ m_o o2 X" proof(induction o1 o2 rule: less_eq_option.induct) case 1 thus ?case by (simp add: m_o_def)(metis m_s_anti_mono) next case 2 thus ?case by(simp add: m_o_def le_SucI m_s_h split: option.splits) next case 3 thus ?case by simp qed lemma m_o_widen: "\ finite X; top_on_opt S1 (-X); top_on_opt S2 (-X); \ S2 \ S1 \ \ m_o (S1 \ S2) X < m_o S1 X" by(auto simp: m_o_def m_s_h less_Suc_eq_le m_s_widen split: option.split) lemma m_c_widen: "strip C1 = strip C2 \ top_on_acom C1 (-vars C1) \ top_on_acom C2 (-vars C2) \ \ C2 \ C1 \ m_c (C1 \ C2) < m_c C1" apply(auto simp: m_c_def widen_acom_def map2_acom_def size_annos[symmetric] anno_def[symmetric]sum_list_sum_nth) apply(subgoal_tac "length(annos C2) = length(annos C1)") prefer 2 apply (simp add: size_annos_same2) apply (auto) apply(rule sum_strict_mono_ex1) apply(auto simp add: m_o_anti_mono vars_acom_def anno_def top_on_acom_def top_on_opt_widen widen1 less_eq_acom_def listrel_iff_nth) apply(rule_tac x=p in bexI) apply (auto simp: vars_acom_def m_o_widen top_on_acom_def) done definition n_s :: "'av st \ vname set \ nat" ("n\<^sub>s") where "n\<^sub>s S X = (\x\X. n(fun S x))" lemma n_s_narrow_rep: assumes "finite X" "S1 = S2 on -X" "\x. S2 x \ S1 x" "\x. S1 x \ S2 x \ S1 x" "S1 x \ S1 x \ S2 x" shows "(\x\X. n (S1 x \ S2 x)) < (\x\X. n (S1 x))" proof- have 1: "\x. n(S1 x \ S2 x) \ n(S1 x)" by (metis assms(3) assms(4) eq_iff less_le_not_le n_narrow) have "x \ X" by (metis Compl_iff assms(2) assms(5) narrowid) hence 2: "\x\X. n(S1 x \ S2 x) < n(S1 x)" by (metis assms(3-5) eq_iff less_le_not_le n_narrow) show ?thesis apply(rule sum_strict_mono_ex1[OF \finite X\]) using 1 2 by blast+ qed lemma n_s_narrow: "finite X \ fun S1 = fun S2 on -X \ S2 \ S1 \ S1 \ S2 < S1 \ n\<^sub>s (S1 \ S2) X < n\<^sub>s S1 X" apply(auto simp add: less_st_def n_s_def) apply (transfer fixing: n) apply(auto simp add: less_eq_st_rep_iff eq_st_def fun_eq_iff n_s_narrow_rep) done definition n_o :: "'av st option \ vname set \ nat" ("n\<^sub>o") where "n\<^sub>o opt X = (case opt of None \ 0 | Some S \ n\<^sub>s S X + 1)" lemma n_o_narrow: "top_on_opt S1 (-X) \ top_on_opt S2 (-X) \ finite X \ S2 \ S1 \ S1 \ S2 < S1 \ n\<^sub>o (S1 \ S2) X < n\<^sub>o S1 X" apply(induction S1 S2 rule: narrow_option.induct) apply(auto simp: n_o_def n_s_narrow) done definition n_c :: "'av st option acom \ nat" ("n\<^sub>c") where "n\<^sub>c C = sum_list (map (\a. n\<^sub>o a (vars C)) (annos C))" lemma less_annos_iff: "(C1 < C2) = (C1 \ C2 \ (\i top_on_acom C1 (- vars C1) \ top_on_acom C2 (- vars C2) \ C2 \ C1 \ C1 \ C2 < C1 \ n\<^sub>c (C1 \ C2) < n\<^sub>c C1" apply(auto simp: n_c_def narrow_acom_def sum_list_sum_nth) apply(subgoal_tac "length(annos C2) = length(annos C1)") prefer 2 apply (simp add: size_annos_same2) apply (auto) apply(simp add: less_annos_iff le_iff_le_annos) apply(rule sum_strict_mono_ex1) apply (auto simp: vars_acom_def top_on_acom_def) apply (metis n_o_narrow nth_mem finite_cvars less_imp_le le_less order_refl) apply(rule_tac x=i in bexI) prefer 2 apply simp apply(rule n_o_narrow[where X = "vars(strip C2)"]) apply (simp_all) done end lemma iter_widen_termination: fixes m :: "'a::wn acom \ nat" assumes P_f: "\C. P C \ P(f C)" and P_widen: "\C1 C2. P C1 \ P C2 \ P(C1 \ C2)" and m_widen: "\C1 C2. P C1 \ P C2 \ ~ C2 \ C1 \ m(C1 \ C2) < m C1" and "P C" shows "\C'. iter_widen f C = Some C'" proof(simp add: iter_widen_def, rule measure_while_option_Some[where P = P and f=m]) show "P C" by(rule \P C\) next fix C assume "P C" "\ f C \ C" thus "P (C \ f C) \ m (C \ f C) < m C" by(simp add: P_f P_widen m_widen) qed lemma iter_narrow_termination: fixes n :: "'a::wn acom \ nat" assumes P_f: "\C. P C \ P(f C)" and P_narrow: "\C1 C2. P C1 \ P C2 \ P(C1 \ C2)" and mono: "\C1 C2. P C1 \ P C2 \ C1 \ C2 \ f C1 \ f C2" and n_narrow: "\C1 C2. P C1 \ P C2 \ C2 \ C1 \ C1 \ C2 < C1 \ n(C1 \ C2) < n C1" and init: "P C" "f C \ C" shows "\C'. iter_narrow f C = Some C'" proof(simp add: iter_narrow_def, rule measure_while_option_Some[where f=n and P = "%C. P C \ f C \ C"]) show "P C \ f C \ C" using init by blast next fix C assume 1: "P C \ f C \ C" and 2: "C \ f C < C" hence "P (C \ f C)" by(simp add: P_f P_narrow) moreover then have "f (C \ f C) \ C \ f C" by (metis narrow1_acom narrow2_acom 1 mono order_trans) moreover have "n (C \ f C) < n C" using 1 2 by(simp add: n_narrow P_f) ultimately show "(P (C \ f C) \ f (C \ f C) \ C \ f C) \ n(C \ f C) < n C" by blast qed locale Abs_Int_wn_measure = Abs_Int_wn where \=\ + Measure_wn where m=m for \ :: "'av::{wn,bounded_lattice} \ val set" and m :: "'av \ nat" subsubsection "Termination: Intervals" definition m_rep :: "eint2 \ nat" where "m_rep p = (if is_empty_rep p then 3 else let (l,h) = p in (case l of Minf \ 0 | _ \ 1) + (case h of Pinf \ 0 | _ \ 1))" lift_definition m_ivl :: "ivl \ nat" is m_rep by(auto simp: m_rep_def eq_ivl_iff) lemma m_ivl_nice: "m_ivl[l,h] = (if [l,h] = \ then 3 else (if l = Minf then 0 else 1) + (if h = Pinf then 0 else 1))" unfolding bot_ivl_def by transfer (auto simp: m_rep_def eq_ivl_empty split: extended.split) lemma m_ivl_height: "m_ivl iv \ 3" by transfer (simp add: m_rep_def split: prod.split extended.split) lemma m_ivl_anti_mono: "y \ x \ m_ivl x \ m_ivl y" by transfer (auto simp: m_rep_def is_empty_rep_def \_rep_cases le_iff_subset split: prod.split extended.splits if_splits) lemma m_ivl_widen: "~ y \ x \ m_ivl(x \ y) < m_ivl x" by transfer (auto simp: m_rep_def widen_rep_def is_empty_rep_def \_rep_cases le_iff_subset split: prod.split extended.splits if_splits) definition n_ivl :: "ivl \ nat" where "n_ivl iv = 3 - m_ivl iv" lemma n_ivl_narrow: "x \ y < x \ n_ivl(x \ y) < n_ivl x" unfolding n_ivl_def apply(subst (asm) less_le_not_le) apply transfer by(auto simp add: m_rep_def narrow_rep_def is_empty_rep_def empty_rep_def \_rep_cases le_iff_subset split: prod.splits if_splits extended.split) global_interpretation Abs_Int_wn_measure where \ = \_ivl and num' = num_ivl and plus' = "(+)" and test_num' = in_ivl and inv_plus' = inv_plus_ivl and inv_less' = inv_less_ivl and m = m_ivl and n = n_ivl and h = 3 proof (standard, goal_cases) case 2 thus ?case by(rule m_ivl_anti_mono) next case 1 thus ?case by(rule m_ivl_height) next case 3 thus ?case by(rule m_ivl_widen) next case 4 from 4(2) show ?case by(rule n_ivl_narrow) \ \note that the first assms is unnecessary for intervals\ qed lemma iter_winden_step_ivl_termination: "\C. iter_widen (step_ivl \) (bot c) = Some C" apply(rule iter_widen_termination[where m = "m_c" and P = "%C. strip C = c \ top_on_acom C (- vars C)"]) apply (auto simp add: m_c_widen top_on_bot top_on_step'[simplified comp_def vars_acom_def] vars_acom_def top_on_acom_widen) done lemma iter_narrow_step_ivl_termination: "top_on_acom C (- vars C) \ step_ivl \ C \ C \ \C'. iter_narrow (step_ivl \) C = Some C'" apply(rule iter_narrow_termination[where n = "n_c" and P = "%C'. strip C = strip C' \ top_on_acom C' (-vars C')"]) apply(auto simp: top_on_step'[simplified comp_def vars_acom_def] mono_step'_top n_c_narrow vars_acom_def top_on_acom_narrow) done theorem AI_wn_ivl_termination: "\C. AI_wn_ivl c = Some C" apply(auto simp: AI_wn_def pfp_wn_def iter_winden_step_ivl_termination split: option.split) apply(rule iter_narrow_step_ivl_termination) apply(rule conjunct2) apply(rule iter_widen_inv[where f = "step' \" and P = "%C. c = strip C & top_on_acom C (- vars C)"]) apply(auto simp: top_on_acom_widen top_on_step'[simplified comp_def vars_acom_def] iter_widen_pfp top_on_bot vars_acom_def) done (*unused_thms Abs_Int_init - *) subsubsection "Counterexamples" text\Widening is increasing by assumption, but \<^prop>\x \ f x\ is not an invariant of widening. It can already be lost after the first step:\ lemma assumes "!!x y::'a::wn. x \ y \ f x \ f y" and "x \ f x" and "\ f x \ x" shows "x \ f x \ f(x \ f x)" nitpick[card = 3, expect = genuine, show_consts, timeout = 120] (* 1 < 2 < 3, f x = 2, x widen y = 3 -- guarantees termination with top=3 x = 1 Now f is mono, x <= f x, not f x <= x but x widen f x = 3, f 3 = 2, but not 3 <= 2 *) oops text\Widening terminates but may converge more slowly than Kleene iteration. In the following model, Kleene iteration goes from 0 to the least pfp in one step but widening takes 2 steps to reach a strictly larger pfp:\ lemma assumes "!!x y::'a::wn. x \ y \ f x \ f y" and "x \ f x" and "\ f x \ x" and "f(f x) \ f x" shows "f(x \ f x) \ x \ f x" nitpick[card = 4, expect = genuine, show_consts, timeout = 120] (* 0 < 1 < 2 < 3 f: 1 1 3 3 0 widen 1 = 2 2 widen 3 = 3 and x widen y arbitrary, eg 3, which guarantees termination Kleene: f(f 0) = f 1 = 1 <= 1 = f 1 but because not f 0 <= 0, we obtain 0 widen f 0 = 0 wide 1 = 2, which is again not a pfp: not f 2 = 3 <= 2 Another widening step yields 2 widen f 2 = 2 widen 3 = 3 *) oops end diff --git a/src/HOL/Lattices.thy b/src/HOL/Lattices.thy --- a/src/HOL/Lattices.thy +++ b/src/HOL/Lattices.thy @@ -1,986 +1,986 @@ (* Title: HOL/Lattices.thy Author: Tobias Nipkow *) section \Abstract lattices\ theory Lattices imports Groups begin subsection \Abstract semilattice\ text \ These locales provide a basic structure for interpretation into bigger structures; extensions require careful thinking, otherwise undesired effects may occur due to interpretation. \ locale semilattice = abel_semigroup + assumes idem [simp]: "a \<^bold>* a = a" begin lemma left_idem [simp]: "a \<^bold>* (a \<^bold>* b) = a \<^bold>* b" by (simp add: assoc [symmetric]) lemma right_idem [simp]: "(a \<^bold>* b) \<^bold>* b = a \<^bold>* b" by (simp add: assoc) end locale semilattice_neutr = semilattice + comm_monoid locale semilattice_order = semilattice + fixes less_eq :: "'a \ 'a \ bool" (infix "\<^bold>\" 50) and less :: "'a \ 'a \ bool" (infix "\<^bold><" 50) assumes order_iff: "a \<^bold>\ b \ a = a \<^bold>* b" and strict_order_iff: "a \<^bold>< b \ a = a \<^bold>* b \ a \ b" begin lemma orderI: "a = a \<^bold>* b \ a \<^bold>\ b" by (simp add: order_iff) lemma orderE: assumes "a \<^bold>\ b" obtains "a = a \<^bold>* b" using assms by (unfold order_iff) sublocale ordering less_eq less proof show "a \<^bold>< b \ a \<^bold>\ b \ a \ b" for a b by (simp add: order_iff strict_order_iff) next show "a \<^bold>\ a" for a by (simp add: order_iff) next fix a b assume "a \<^bold>\ b" "b \<^bold>\ a" then have "a = a \<^bold>* b" "a \<^bold>* b = b" by (simp_all add: order_iff commute) then show "a = b" by simp next fix a b c assume "a \<^bold>\ b" "b \<^bold>\ c" then have "a = a \<^bold>* b" "b = b \<^bold>* c" by (simp_all add: order_iff commute) then have "a = a \<^bold>* (b \<^bold>* c)" by simp then have "a = (a \<^bold>* b) \<^bold>* c" by (simp add: assoc) with \a = a \<^bold>* b\ [symmetric] have "a = a \<^bold>* c" by simp then show "a \<^bold>\ c" by (rule orderI) qed lemma cobounded1 [simp]: "a \<^bold>* b \<^bold>\ a" by (simp add: order_iff commute) lemma cobounded2 [simp]: "a \<^bold>* b \<^bold>\ b" by (simp add: order_iff) lemma boundedI: assumes "a \<^bold>\ b" and "a \<^bold>\ c" shows "a \<^bold>\ b \<^bold>* c" proof (rule orderI) from assms obtain "a \<^bold>* b = a" and "a \<^bold>* c = a" by (auto elim!: orderE) then show "a = a \<^bold>* (b \<^bold>* c)" by (simp add: assoc [symmetric]) qed lemma boundedE: assumes "a \<^bold>\ b \<^bold>* c" obtains "a \<^bold>\ b" and "a \<^bold>\ c" using assms by (blast intro: trans cobounded1 cobounded2) lemma bounded_iff [simp]: "a \<^bold>\ b \<^bold>* c \ a \<^bold>\ b \ a \<^bold>\ c" by (blast intro: boundedI elim: boundedE) lemma strict_boundedE: assumes "a \<^bold>< b \<^bold>* c" obtains "a \<^bold>< b" and "a \<^bold>< c" using assms by (auto simp add: commute strict_iff_order elim: orderE intro!: that)+ lemma coboundedI1: "a \<^bold>\ c \ a \<^bold>* b \<^bold>\ c" by (rule trans) auto lemma coboundedI2: "b \<^bold>\ c \ a \<^bold>* b \<^bold>\ c" by (rule trans) auto lemma strict_coboundedI1: "a \<^bold>< c \ a \<^bold>* b \<^bold>< c" using irrefl by (auto intro: not_eq_order_implies_strict coboundedI1 strict_implies_order elim: strict_boundedE) lemma strict_coboundedI2: "b \<^bold>< c \ a \<^bold>* b \<^bold>< c" using strict_coboundedI1 [of b c a] by (simp add: commute) lemma mono: "a \<^bold>\ c \ b \<^bold>\ d \ a \<^bold>* b \<^bold>\ c \<^bold>* d" by (blast intro: boundedI coboundedI1 coboundedI2) lemma absorb1: "a \<^bold>\ b \ a \<^bold>* b = a" by (rule antisym) (auto simp: refl) lemma absorb2: "b \<^bold>\ a \ a \<^bold>* b = b" by (rule antisym) (auto simp: refl) lemma absorb_iff1: "a \<^bold>\ b \ a \<^bold>* b = a" using order_iff by auto lemma absorb_iff2: "b \<^bold>\ a \ a \<^bold>* b = b" using order_iff by (auto simp add: commute) end locale semilattice_neutr_order = semilattice_neutr + semilattice_order begin sublocale ordering_top less_eq less "\<^bold>1" by standard (simp add: order_iff) lemma eq_neutr_iff [simp]: \a \<^bold>* b = \<^bold>1 \ a = \<^bold>1 \ b = \<^bold>1\ by (simp add: eq_iff) lemma neutr_eq_iff [simp]: \\<^bold>1 = a \<^bold>* b \ a = \<^bold>1 \ b = \<^bold>1\ by (simp add: eq_iff) end text \Interpretations for boolean operators\ interpretation conj: semilattice_neutr \(\)\ True by standard auto interpretation disj: semilattice_neutr \(\)\ False by standard auto declare conj_assoc [ac_simps del] disj_assoc [ac_simps del] \ \already simp by default\ subsection \Syntactic infimum and supremum operations\ class inf = fixes inf :: "'a \ 'a \ 'a" (infixl "\" 70) class sup = fixes sup :: "'a \ 'a \ 'a" (infixl "\" 65) subsection \Concrete lattices\ class semilattice_inf = order + inf + assumes inf_le1 [simp]: "x \ y \ x" and inf_le2 [simp]: "x \ y \ y" and inf_greatest: "x \ y \ x \ z \ x \ y \ z" class semilattice_sup = order + sup + assumes sup_ge1 [simp]: "x \ x \ y" and sup_ge2 [simp]: "y \ x \ y" and sup_least: "y \ x \ z \ x \ y \ z \ x" begin text \Dual lattice.\ lemma dual_semilattice: "class.semilattice_inf sup greater_eq greater" by (rule class.semilattice_inf.intro, rule dual_order) (unfold_locales, simp_all add: sup_least) end class lattice = semilattice_inf + semilattice_sup subsubsection \Intro and elim rules\ context semilattice_inf begin lemma le_infI1: "a \ x \ a \ b \ x" by (rule order_trans) auto lemma le_infI2: "b \ x \ a \ b \ x" by (rule order_trans) auto lemma le_infI: "x \ a \ x \ b \ x \ a \ b" by (fact inf_greatest) (* FIXME: duplicate lemma *) lemma le_infE: "x \ a \ b \ (x \ a \ x \ b \ P) \ P" by (blast intro: order_trans inf_le1 inf_le2) lemma le_inf_iff: "x \ y \ z \ x \ y \ x \ z" by (blast intro: le_infI elim: le_infE) lemma le_iff_inf: "x \ y \ x \ y = x" - by (auto intro: le_infI1 antisym dest: eq_iff [THEN iffD1] simp add: le_inf_iff) + by (auto intro: le_infI1 order.antisym dest: order.eq_iff [THEN iffD1] simp add: le_inf_iff) lemma inf_mono: "a \ c \ b \ d \ a \ b \ c \ d" by (fast intro: inf_greatest le_infI1 le_infI2) lemma mono_inf: "mono f \ f (A \ B) \ f A \ f B" for f :: "'a \ 'b::semilattice_inf" by (auto simp add: mono_def intro: Lattices.inf_greatest) end context semilattice_sup begin lemma le_supI1: "x \ a \ x \ a \ b" by (rule order_trans) auto lemma le_supI2: "x \ b \ x \ a \ b" by (rule order_trans) auto lemma le_supI: "a \ x \ b \ x \ a \ b \ x" by (fact sup_least) (* FIXME: duplicate lemma *) lemma le_supE: "a \ b \ x \ (a \ x \ b \ x \ P) \ P" by (blast intro: order_trans sup_ge1 sup_ge2) lemma le_sup_iff: "x \ y \ z \ x \ z \ y \ z" by (blast intro: le_supI elim: le_supE) lemma le_iff_sup: "x \ y \ x \ y = y" - by (auto intro: le_supI2 antisym dest: eq_iff [THEN iffD1] simp add: le_sup_iff) + by (auto intro: le_supI2 order.antisym dest: order.eq_iff [THEN iffD1] simp add: le_sup_iff) lemma sup_mono: "a \ c \ b \ d \ a \ b \ c \ d" by (fast intro: sup_least le_supI1 le_supI2) lemma mono_sup: "mono f \ f A \ f B \ f (A \ B)" for f :: "'a \ 'b::semilattice_sup" by (auto simp add: mono_def intro: Lattices.sup_least) end subsubsection \Equational laws\ context semilattice_inf begin sublocale inf: semilattice inf proof fix a b c show "(a \ b) \ c = a \ (b \ c)" - by (rule antisym) (auto intro: le_infI1 le_infI2 simp add: le_inf_iff) + by (rule order.antisym) (auto intro: le_infI1 le_infI2 simp add: le_inf_iff) show "a \ b = b \ a" - by (rule antisym) (auto simp add: le_inf_iff) + by (rule order.antisym) (auto simp add: le_inf_iff) show "a \ a = a" - by (rule antisym) (auto simp add: le_inf_iff) + by (rule order.antisym) (auto simp add: le_inf_iff) qed sublocale inf: semilattice_order inf less_eq less by standard (auto simp add: le_iff_inf less_le) lemma inf_assoc: "(x \ y) \ z = x \ (y \ z)" by (fact inf.assoc) lemma inf_commute: "(x \ y) = (y \ x)" by (fact inf.commute) lemma inf_left_commute: "x \ (y \ z) = y \ (x \ z)" by (fact inf.left_commute) lemma inf_idem: "x \ x = x" by (fact inf.idem) (* already simp *) lemma inf_left_idem: "x \ (x \ y) = x \ y" by (fact inf.left_idem) (* already simp *) lemma inf_right_idem: "(x \ y) \ y = x \ y" by (fact inf.right_idem) (* already simp *) lemma inf_absorb1: "x \ y \ x \ y = x" - by (rule antisym) auto + by (rule order.antisym) auto lemma inf_absorb2: "y \ x \ x \ y = y" - by (rule antisym) auto + by (rule order.antisym) auto lemmas inf_aci = inf_commute inf_assoc inf_left_commute inf_left_idem end context semilattice_sup begin sublocale sup: semilattice sup proof fix a b c show "(a \ b) \ c = a \ (b \ c)" - by (rule antisym) (auto intro: le_supI1 le_supI2 simp add: le_sup_iff) + by (rule order.antisym) (auto intro: le_supI1 le_supI2 simp add: le_sup_iff) show "a \ b = b \ a" - by (rule antisym) (auto simp add: le_sup_iff) + by (rule order.antisym) (auto simp add: le_sup_iff) show "a \ a = a" - by (rule antisym) (auto simp add: le_sup_iff) + by (rule order.antisym) (auto simp add: le_sup_iff) qed sublocale sup: semilattice_order sup greater_eq greater by standard (auto simp add: le_iff_sup sup.commute less_le) lemma sup_assoc: "(x \ y) \ z = x \ (y \ z)" by (fact sup.assoc) lemma sup_commute: "(x \ y) = (y \ x)" by (fact sup.commute) lemma sup_left_commute: "x \ (y \ z) = y \ (x \ z)" by (fact sup.left_commute) lemma sup_idem: "x \ x = x" by (fact sup.idem) (* already simp *) lemma sup_left_idem [simp]: "x \ (x \ y) = x \ y" by (fact sup.left_idem) lemma sup_absorb1: "y \ x \ x \ y = x" - by (rule antisym) auto + by (rule order.antisym) auto lemma sup_absorb2: "x \ y \ x \ y = y" - by (rule antisym) auto + by (rule order.antisym) auto lemmas sup_aci = sup_commute sup_assoc sup_left_commute sup_left_idem end context lattice begin lemma dual_lattice: "class.lattice sup (\) (>) inf" by (rule class.lattice.intro, rule dual_semilattice, rule class.semilattice_sup.intro, rule dual_order) (unfold_locales, auto) lemma inf_sup_absorb [simp]: "x \ (x \ y) = x" - by (blast intro: antisym inf_le1 inf_greatest sup_ge1) + by (blast intro: order.antisym inf_le1 inf_greatest sup_ge1) lemma sup_inf_absorb [simp]: "x \ (x \ y) = x" - by (blast intro: antisym sup_ge1 sup_least inf_le1) + by (blast intro: order.antisym sup_ge1 sup_least inf_le1) lemmas inf_sup_aci = inf_aci sup_aci lemmas inf_sup_ord = inf_le1 inf_le2 sup_ge1 sup_ge2 text \Towards distributivity.\ lemma distrib_sup_le: "x \ (y \ z) \ (x \ y) \ (x \ z)" by (auto intro: le_infI1 le_infI2 le_supI1 le_supI2) lemma distrib_inf_le: "(x \ y) \ (x \ z) \ x \ (y \ z)" by (auto intro: le_infI1 le_infI2 le_supI1 le_supI2) text \If you have one of them, you have them all.\ lemma distrib_imp1: assumes distrib: "\x y z. x \ (y \ z) = (x \ y) \ (x \ z)" shows "x \ (y \ z) = (x \ y) \ (x \ z)" proof- have "x \ (y \ z) = (x \ (x \ z)) \ (y \ z)" by simp also have "\ = x \ (z \ (x \ y))" by (simp add: distrib inf_commute sup_assoc del: sup_inf_absorb) also have "\ = ((x \ y) \ x) \ ((x \ y) \ z)" by (simp add: inf_commute) also have "\ = (x \ y) \ (x \ z)" by(simp add:distrib) finally show ?thesis . qed lemma distrib_imp2: assumes distrib: "\x y z. x \ (y \ z) = (x \ y) \ (x \ z)" shows "x \ (y \ z) = (x \ y) \ (x \ z)" proof- have "x \ (y \ z) = (x \ (x \ z)) \ (y \ z)" by simp also have "\ = x \ (z \ (x \ y))" by (simp add: distrib sup_commute inf_assoc del: inf_sup_absorb) also have "\ = ((x \ y) \ x) \ ((x \ y) \ z)" by (simp add: sup_commute) also have "\ = (x \ y) \ (x \ z)" by (simp add:distrib) finally show ?thesis . qed end subsubsection \Strict order\ context semilattice_inf begin lemma less_infI1: "a < x \ a \ b < x" by (auto simp add: less_le inf_absorb1 intro: le_infI1) lemma less_infI2: "b < x \ a \ b < x" by (auto simp add: less_le inf_absorb2 intro: le_infI2) end context semilattice_sup begin lemma less_supI1: "x < a \ x < a \ b" using dual_semilattice by (rule semilattice_inf.less_infI1) lemma less_supI2: "x < b \ x < a \ b" using dual_semilattice by (rule semilattice_inf.less_infI2) end subsection \Distributive lattices\ class distrib_lattice = lattice + assumes sup_inf_distrib1: "x \ (y \ z) = (x \ y) \ (x \ z)" context distrib_lattice begin lemma sup_inf_distrib2: "(y \ z) \ x = (y \ x) \ (z \ x)" by (simp add: sup_commute sup_inf_distrib1) lemma inf_sup_distrib1: "x \ (y \ z) = (x \ y) \ (x \ z)" by (rule distrib_imp2 [OF sup_inf_distrib1]) lemma inf_sup_distrib2: "(y \ z) \ x = (y \ x) \ (z \ x)" by (simp add: inf_commute inf_sup_distrib1) lemma dual_distrib_lattice: "class.distrib_lattice sup (\) (>) inf" by (rule class.distrib_lattice.intro, rule dual_lattice) (unfold_locales, fact inf_sup_distrib1) lemmas sup_inf_distrib = sup_inf_distrib1 sup_inf_distrib2 lemmas inf_sup_distrib = inf_sup_distrib1 inf_sup_distrib2 lemmas distrib = sup_inf_distrib1 sup_inf_distrib2 inf_sup_distrib1 inf_sup_distrib2 end subsection \Bounded lattices and boolean algebras\ class bounded_semilattice_inf_top = semilattice_inf + order_top begin sublocale inf_top: semilattice_neutr inf top + inf_top: semilattice_neutr_order inf top less_eq less proof show "x \ \ = x" for x by (rule inf_absorb1) simp qed lemma inf_top_left: "\ \ x = x" by (fact inf_top.left_neutral) lemma inf_top_right: "x \ \ = x" by (fact inf_top.right_neutral) lemma inf_eq_top_iff: "x \ y = \ \ x = \ \ y = \" by (fact inf_top.eq_neutr_iff) lemma top_eq_inf_iff: "\ = x \ y \ x = \ \ y = \" by (fact inf_top.neutr_eq_iff) end class bounded_semilattice_sup_bot = semilattice_sup + order_bot begin sublocale sup_bot: semilattice_neutr sup bot + sup_bot: semilattice_neutr_order sup bot greater_eq greater proof show "x \ \ = x" for x by (rule sup_absorb1) simp qed lemma sup_bot_left: "\ \ x = x" by (fact sup_bot.left_neutral) lemma sup_bot_right: "x \ \ = x" by (fact sup_bot.right_neutral) lemma sup_eq_bot_iff: "x \ y = \ \ x = \ \ y = \" by (fact sup_bot.eq_neutr_iff) lemma bot_eq_sup_iff: "\ = x \ y \ x = \ \ y = \" by (fact sup_bot.neutr_eq_iff) end class bounded_lattice_bot = lattice + order_bot begin subclass bounded_semilattice_sup_bot .. lemma inf_bot_left [simp]: "\ \ x = \" by (rule inf_absorb1) simp lemma inf_bot_right [simp]: "x \ \ = \" by (rule inf_absorb2) simp end class bounded_lattice_top = lattice + order_top begin subclass bounded_semilattice_inf_top .. lemma sup_top_left [simp]: "\ \ x = \" by (rule sup_absorb1) simp lemma sup_top_right [simp]: "x \ \ = \" by (rule sup_absorb2) simp end class bounded_lattice = lattice + order_bot + order_top begin subclass bounded_lattice_bot .. subclass bounded_lattice_top .. lemma dual_bounded_lattice: "class.bounded_lattice sup greater_eq greater inf \ \" by unfold_locales (auto simp add: less_le_not_le) end class boolean_algebra = distrib_lattice + bounded_lattice + minus + uminus + assumes inf_compl_bot: "x \ - x = \" and sup_compl_top: "x \ - x = \" assumes diff_eq: "x - y = x \ - y" begin lemma dual_boolean_algebra: "class.boolean_algebra (\x y. x \ - y) uminus sup greater_eq greater inf \ \" by (rule class.boolean_algebra.intro, rule dual_bounded_lattice, rule dual_distrib_lattice) (unfold_locales, auto simp add: inf_compl_bot sup_compl_top diff_eq) lemma compl_inf_bot [simp]: "- x \ x = \" by (simp add: inf_commute inf_compl_bot) lemma compl_sup_top [simp]: "- x \ x = \" by (simp add: sup_commute sup_compl_top) lemma compl_unique: assumes "x \ y = \" and "x \ y = \" shows "- x = y" proof - have "(x \ - x) \ (- x \ y) = (x \ y) \ (- x \ y)" using inf_compl_bot assms(1) by simp then have "(- x \ x) \ (- x \ y) = (y \ x) \ (y \ - x)" by (simp add: inf_commute) then have "- x \ (x \ y) = y \ (x \ - x)" by (simp add: inf_sup_distrib1) then have "- x \ \ = y \ \" using sup_compl_top assms(2) by simp then show "- x = y" by simp qed lemma double_compl [simp]: "- (- x) = x" using compl_inf_bot compl_sup_top by (rule compl_unique) lemma compl_eq_compl_iff [simp]: "- x = - y \ x = y" proof assume "- x = - y" then have "- (- x) = - (- y)" by (rule arg_cong) then show "x = y" by simp next assume "x = y" then show "- x = - y" by simp qed lemma compl_bot_eq [simp]: "- \ = \" proof - from sup_compl_top have "\ \ - \ = \" . then show ?thesis by simp qed lemma compl_top_eq [simp]: "- \ = \" proof - from inf_compl_bot have "\ \ - \ = \" . then show ?thesis by simp qed lemma compl_inf [simp]: "- (x \ y) = - x \ - y" proof (rule compl_unique) have "(x \ y) \ (- x \ - y) = (y \ (x \ - x)) \ (x \ (y \ - y))" by (simp only: inf_sup_distrib inf_aci) then show "(x \ y) \ (- x \ - y) = \" by (simp add: inf_compl_bot) next have "(x \ y) \ (- x \ - y) = (- y \ (x \ - x)) \ (- x \ (y \ - y))" by (simp only: sup_inf_distrib sup_aci) then show "(x \ y) \ (- x \ - y) = \" by (simp add: sup_compl_top) qed lemma compl_sup [simp]: "- (x \ y) = - x \ - y" using dual_boolean_algebra by (rule boolean_algebra.compl_inf) lemma compl_mono: assumes "x \ y" shows "- y \ - x" proof - from assms have "x \ y = y" by (simp only: le_iff_sup) then have "- (x \ y) = - y" by simp then have "- x \ - y = - y" by simp then have "- y \ - x = - y" by (simp only: inf_commute) then show ?thesis by (simp only: le_iff_inf) qed lemma compl_le_compl_iff [simp]: "- x \ - y \ y \ x" by (auto dest: compl_mono) lemma compl_le_swap1: assumes "y \ - x" shows "x \ -y" proof - from assms have "- (- x) \ - y" by (simp only: compl_le_compl_iff) then show ?thesis by simp qed lemma compl_le_swap2: assumes "- y \ x" shows "- x \ y" proof - from assms have "- x \ - (- y)" by (simp only: compl_le_compl_iff) then show ?thesis by simp qed lemma compl_less_compl_iff: "- x < - y \ y < x" (* TODO: declare [simp] ? *) by (auto simp add: less_le) lemma compl_less_swap1: assumes "y < - x" shows "x < - y" proof - from assms have "- (- x) < - y" by (simp only: compl_less_compl_iff) then show ?thesis by simp qed lemma compl_less_swap2: assumes "- y < x" shows "- x < y" proof - from assms have "- x < - (- y)" by (simp only: compl_less_compl_iff) then show ?thesis by simp qed lemma sup_cancel_left1: "sup (sup x a) (sup (- x) b) = top" by (simp add: inf_sup_aci sup_compl_top) lemma sup_cancel_left2: "sup (sup (- x) a) (sup x b) = top" by (simp add: inf_sup_aci sup_compl_top) lemma inf_cancel_left1: "inf (inf x a) (inf (- x) b) = bot" by (simp add: inf_sup_aci inf_compl_bot) lemma inf_cancel_left2: "inf (inf (- x) a) (inf x b) = bot" by (simp add: inf_sup_aci inf_compl_bot) declare inf_compl_bot [simp] and sup_compl_top [simp] lemma sup_compl_top_left1 [simp]: "sup (- x) (sup x y) = top" by (simp add: sup_assoc[symmetric]) lemma sup_compl_top_left2 [simp]: "sup x (sup (- x) y) = top" using sup_compl_top_left1[of "- x" y] by simp lemma inf_compl_bot_left1 [simp]: "inf (- x) (inf x y) = bot" by (simp add: inf_assoc[symmetric]) lemma inf_compl_bot_left2 [simp]: "inf x (inf (- x) y) = bot" using inf_compl_bot_left1[of "- x" y] by simp lemma inf_compl_bot_right [simp]: "inf x (inf y (- x)) = bot" by (subst inf_left_commute) simp end locale boolean_algebra_cancel begin lemma sup1: "(A::'a::semilattice_sup) \ sup k a \ sup A b \ sup k (sup a b)" by (simp only: ac_simps) lemma sup2: "(B::'a::semilattice_sup) \ sup k b \ sup a B \ sup k (sup a b)" by (simp only: ac_simps) lemma sup0: "(a::'a::bounded_semilattice_sup_bot) \ sup a bot" by simp lemma inf1: "(A::'a::semilattice_inf) \ inf k a \ inf A b \ inf k (inf a b)" by (simp only: ac_simps) lemma inf2: "(B::'a::semilattice_inf) \ inf k b \ inf a B \ inf k (inf a b)" by (simp only: ac_simps) lemma inf0: "(a::'a::bounded_semilattice_inf_top) \ inf a top" by simp end ML_file \Tools/boolean_algebra_cancel.ML\ simproc_setup boolean_algebra_cancel_sup ("sup a b::'a::boolean_algebra") = \fn phi => fn ss => try Boolean_Algebra_Cancel.cancel_sup_conv\ simproc_setup boolean_algebra_cancel_inf ("inf a b::'a::boolean_algebra") = \fn phi => fn ss => try Boolean_Algebra_Cancel.cancel_inf_conv\ subsection \\min/max\ as special case of lattice\ context linorder begin sublocale min: semilattice_order min less_eq less + max: semilattice_order max greater_eq greater by standard (auto simp add: min_def max_def) lemma min_le_iff_disj: "min x y \ z \ x \ z \ y \ z" unfolding min_def using linear by (auto intro: order_trans) lemma le_max_iff_disj: "z \ max x y \ z \ x \ z \ y" unfolding max_def using linear by (auto intro: order_trans) lemma min_less_iff_disj: "min x y < z \ x < z \ y < z" unfolding min_def le_less using less_linear by (auto intro: less_trans) lemma less_max_iff_disj: "z < max x y \ z < x \ z < y" unfolding max_def le_less using less_linear by (auto intro: less_trans) lemma min_less_iff_conj [simp]: "z < min x y \ z < x \ z < y" unfolding min_def le_less using less_linear by (auto intro: less_trans) lemma max_less_iff_conj [simp]: "max x y < z \ x < z \ y < z" unfolding max_def le_less using less_linear by (auto intro: less_trans) lemma min_max_distrib1: "min (max b c) a = max (min b a) (min c a)" by (auto simp add: min_def max_def not_le dest: le_less_trans less_trans intro: antisym) lemma min_max_distrib2: "min a (max b c) = max (min a b) (min a c)" by (auto simp add: min_def max_def not_le dest: le_less_trans less_trans intro: antisym) lemma max_min_distrib1: "max (min b c) a = min (max b a) (max c a)" by (auto simp add: min_def max_def not_le dest: le_less_trans less_trans intro: antisym) lemma max_min_distrib2: "max a (min b c) = min (max a b) (max a c)" by (auto simp add: min_def max_def not_le dest: le_less_trans less_trans intro: antisym) lemmas min_max_distribs = min_max_distrib1 min_max_distrib2 max_min_distrib1 max_min_distrib2 lemma split_min [no_atp]: "P (min i j) \ (i \ j \ P i) \ (\ i \ j \ P j)" by (simp add: min_def) lemma split_max [no_atp]: "P (max i j) \ (i \ j \ P j) \ (\ i \ j \ P i)" by (simp add: max_def) lemma split_min_lin [no_atp]: \P (min a b) \ (b = a \ P a) \ (a < b \ P a) \ (b < a \ P b)\ by (cases a b rule: linorder_cases) (auto simp add: min.absorb1 min.absorb2) lemma split_max_lin [no_atp]: \P (max a b) \ (b = a \ P a) \ (a < b \ P b) \ (b < a \ P a)\ by (cases a b rule: linorder_cases) (auto simp add: max.absorb1 max.absorb2) lemma min_of_mono: "mono f \ min (f m) (f n) = f (min m n)" for f :: "'a \ 'b::linorder" by (auto simp: mono_def Orderings.min_def min_def intro: Orderings.antisym) lemma max_of_mono: "mono f \ max (f m) (f n) = f (max m n)" for f :: "'a \ 'b::linorder" by (auto simp: mono_def Orderings.max_def max_def intro: Orderings.antisym) end lemma max_of_antimono: "antimono f \ max (f x) (f y) = f (min x y)" and min_of_antimono: "antimono f \ min (f x) (f y) = f (max x y)" for f::"'a::linorder \ 'b::linorder" by (auto simp: antimono_def Orderings.max_def min_def intro!: antisym) lemma inf_min: "inf = (min :: 'a::{semilattice_inf,linorder} \ 'a \ 'a)" by (auto intro: antisym simp add: min_def fun_eq_iff) lemma sup_max: "sup = (max :: 'a::{semilattice_sup,linorder} \ 'a \ 'a)" by (auto intro: antisym simp add: max_def fun_eq_iff) subsection \Uniqueness of inf and sup\ lemma (in semilattice_inf) inf_unique: fixes f (infixl "\" 70) assumes le1: "\x y. x \ y \ x" and le2: "\x y. x \ y \ y" and greatest: "\x y z. x \ y \ x \ z \ x \ y \ z" shows "x \ y = x \ y" -proof (rule antisym) +proof (rule order.antisym) show "x \ y \ x \ y" by (rule le_infI) (rule le1, rule le2) have leI: "\x y z. x \ y \ x \ z \ x \ y \ z" by (blast intro: greatest) show "x \ y \ x \ y" by (rule leI) simp_all qed lemma (in semilattice_sup) sup_unique: fixes f (infixl "\" 70) assumes ge1 [simp]: "\x y. x \ x \ y" and ge2: "\x y. y \ x \ y" and least: "\x y z. y \ x \ z \ x \ y \ z \ x" shows "x \ y = x \ y" -proof (rule antisym) +proof (rule order.antisym) show "x \ y \ x \ y" by (rule le_supI) (rule ge1, rule ge2) have leI: "\x y z. x \ z \ y \ z \ x \ y \ z" by (blast intro: least) show "x \ y \ x \ y" by (rule leI) simp_all qed subsection \Lattice on \<^typ>\bool\\ instantiation bool :: boolean_algebra begin definition bool_Compl_def [simp]: "uminus = Not" definition bool_diff_def [simp]: "A - B \ A \ \ B" definition [simp]: "P \ Q \ P \ Q" definition [simp]: "P \ Q \ P \ Q" instance by standard auto end lemma sup_boolI1: "P \ P \ Q" by simp lemma sup_boolI2: "Q \ P \ Q" by simp lemma sup_boolE: "P \ Q \ (P \ R) \ (Q \ R) \ R" by auto subsection \Lattice on \<^typ>\_ \ _\\ instantiation "fun" :: (type, semilattice_sup) semilattice_sup begin definition "f \ g = (\x. f x \ g x)" lemma sup_apply [simp, code]: "(f \ g) x = f x \ g x" by (simp add: sup_fun_def) instance by standard (simp_all add: le_fun_def) end instantiation "fun" :: (type, semilattice_inf) semilattice_inf begin definition "f \ g = (\x. f x \ g x)" lemma inf_apply [simp, code]: "(f \ g) x = f x \ g x" by (simp add: inf_fun_def) instance by standard (simp_all add: le_fun_def) end instance "fun" :: (type, lattice) lattice .. instance "fun" :: (type, distrib_lattice) distrib_lattice by standard (rule ext, simp add: sup_inf_distrib1) instance "fun" :: (type, bounded_lattice) bounded_lattice .. instantiation "fun" :: (type, uminus) uminus begin definition fun_Compl_def: "- A = (\x. - A x)" lemma uminus_apply [simp, code]: "(- A) x = - (A x)" by (simp add: fun_Compl_def) instance .. end instantiation "fun" :: (type, minus) minus begin definition fun_diff_def: "A - B = (\x. A x - B x)" lemma minus_apply [simp, code]: "(A - B) x = A x - B x" by (simp add: fun_diff_def) instance .. end instance "fun" :: (type, boolean_algebra) boolean_algebra by standard (rule ext, simp_all add: inf_compl_bot sup_compl_top diff_eq)+ subsection \Lattice on unary and binary predicates\ lemma inf1I: "A x \ B x \ (A \ B) x" by (simp add: inf_fun_def) lemma inf2I: "A x y \ B x y \ (A \ B) x y" by (simp add: inf_fun_def) lemma inf1E: "(A \ B) x \ (A x \ B x \ P) \ P" by (simp add: inf_fun_def) lemma inf2E: "(A \ B) x y \ (A x y \ B x y \ P) \ P" by (simp add: inf_fun_def) lemma inf1D1: "(A \ B) x \ A x" by (rule inf1E) lemma inf2D1: "(A \ B) x y \ A x y" by (rule inf2E) lemma inf1D2: "(A \ B) x \ B x" by (rule inf1E) lemma inf2D2: "(A \ B) x y \ B x y" by (rule inf2E) lemma sup1I1: "A x \ (A \ B) x" by (simp add: sup_fun_def) lemma sup2I1: "A x y \ (A \ B) x y" by (simp add: sup_fun_def) lemma sup1I2: "B x \ (A \ B) x" by (simp add: sup_fun_def) lemma sup2I2: "B x y \ (A \ B) x y" by (simp add: sup_fun_def) lemma sup1E: "(A \ B) x \ (A x \ P) \ (B x \ P) \ P" by (simp add: sup_fun_def) iprover lemma sup2E: "(A \ B) x y \ (A x y \ P) \ (B x y \ P) \ P" by (simp add: sup_fun_def) iprover text \ \<^medskip> Classical introduction rule: no commitment to \A\ vs \B\.\ lemma sup1CI: "(\ B x \ A x) \ (A \ B) x" by (auto simp add: sup_fun_def) lemma sup2CI: "(\ B x y \ A x y) \ (A \ B) x y" by (auto simp add: sup_fun_def) end diff --git a/src/HOL/Lattices_Big.thy b/src/HOL/Lattices_Big.thy --- a/src/HOL/Lattices_Big.thy +++ b/src/HOL/Lattices_Big.thy @@ -1,1071 +1,1071 @@ (* Title: HOL/Lattices_Big.thy Author: Tobias Nipkow, Lawrence C Paulson and Markus Wenzel with contributions by Jeremy Avigad *) section \Big infimum (minimum) and supremum (maximum) over finite (non-empty) sets\ theory Lattices_Big imports Option begin subsection \Generic lattice operations over a set\ subsubsection \Without neutral element\ locale semilattice_set = semilattice begin interpretation comp_fun_idem f by standard (simp_all add: fun_eq_iff left_commute) definition F :: "'a set \ 'a" where eq_fold': "F A = the (Finite_Set.fold (\x y. Some (case y of None \ x | Some z \ f x z)) None A)" lemma eq_fold: assumes "finite A" shows "F (insert x A) = Finite_Set.fold f x A" proof (rule sym) let ?f = "\x y. Some (case y of None \ x | Some z \ f x z)" interpret comp_fun_idem "?f" by standard (simp_all add: fun_eq_iff commute left_commute split: option.split) from assms show "Finite_Set.fold f x A = F (insert x A)" proof induct case empty then show ?case by (simp add: eq_fold') next case (insert y B) then show ?case by (simp add: insert_commute [of x] eq_fold') qed qed lemma singleton [simp]: "F {x} = x" by (simp add: eq_fold) lemma insert_not_elem: assumes "finite A" and "x \ A" and "A \ {}" shows "F (insert x A) = x \<^bold>* F A" proof - from \A \ {}\ obtain b where "b \ A" by blast then obtain B where *: "A = insert b B" "b \ B" by (blast dest: mk_disjoint_insert) with \finite A\ and \x \ A\ have "finite (insert x B)" and "b \ insert x B" by auto then have "F (insert b (insert x B)) = x \<^bold>* F (insert b B)" by (simp add: eq_fold) then show ?thesis by (simp add: * insert_commute) qed lemma in_idem: assumes "finite A" and "x \ A" shows "x \<^bold>* F A = F A" proof - from assms have "A \ {}" by auto with \finite A\ show ?thesis using \x \ A\ by (induct A rule: finite_ne_induct) (auto simp add: ac_simps insert_not_elem) qed lemma insert [simp]: assumes "finite A" and "A \ {}" shows "F (insert x A) = x \<^bold>* F A" using assms by (cases "x \ A") (simp_all add: insert_absorb in_idem insert_not_elem) lemma union: assumes "finite A" "A \ {}" and "finite B" "B \ {}" shows "F (A \ B) = F A \<^bold>* F B" using assms by (induct A rule: finite_ne_induct) (simp_all add: ac_simps) lemma remove: assumes "finite A" and "x \ A" shows "F A = (if A - {x} = {} then x else x \<^bold>* F (A - {x}))" proof - from assms obtain B where "A = insert x B" and "x \ B" by (blast dest: mk_disjoint_insert) with assms show ?thesis by simp qed lemma insert_remove: assumes "finite A" shows "F (insert x A) = (if A - {x} = {} then x else x \<^bold>* F (A - {x}))" using assms by (cases "x \ A") (simp_all add: insert_absorb remove) lemma subset: assumes "finite A" "B \ {}" and "B \ A" shows "F B \<^bold>* F A = F A" proof - from assms have "A \ {}" and "finite B" by (auto dest: finite_subset) with assms show ?thesis by (simp add: union [symmetric] Un_absorb1) qed lemma closed: assumes "finite A" "A \ {}" and elem: "\x y. x \<^bold>* y \ {x, y}" shows "F A \ A" using \finite A\ \A \ {}\ proof (induct rule: finite_ne_induct) case singleton then show ?case by simp next case insert with elem show ?case by force qed lemma hom_commute: assumes hom: "\x y. h (x \<^bold>* y) = h x \<^bold>* h y" and N: "finite N" "N \ {}" shows "h (F N) = F (h ` N)" using N proof (induct rule: finite_ne_induct) case singleton thus ?case by simp next case (insert n N) then have "h (F (insert n N)) = h (n \<^bold>* F N)" by simp also have "\ = h n \<^bold>* h (F N)" by (rule hom) also have "h (F N) = F (h ` N)" by (rule insert) also have "h n \<^bold>* \ = F (insert (h n) (h ` N))" using insert by simp also have "insert (h n) (h ` N) = h ` insert n N" by simp finally show ?case . qed lemma infinite: "\ finite A \ F A = the None" unfolding eq_fold' by (cases "finite (UNIV::'a set)") (auto intro: finite_subset fold_infinite) end locale semilattice_order_set = binary?: semilattice_order + semilattice_set begin lemma bounded_iff: assumes "finite A" and "A \ {}" shows "x \<^bold>\ F A \ (\a\A. x \<^bold>\ a)" using assms by (induct rule: finite_ne_induct) simp_all lemma boundedI: assumes "finite A" assumes "A \ {}" assumes "\a. a \ A \ x \<^bold>\ a" shows "x \<^bold>\ F A" using assms by (simp add: bounded_iff) lemma boundedE: assumes "finite A" and "A \ {}" and "x \<^bold>\ F A" obtains "\a. a \ A \ x \<^bold>\ a" using assms by (simp add: bounded_iff) lemma coboundedI: assumes "finite A" and "a \ A" shows "F A \<^bold>\ a" proof - from assms have "A \ {}" by auto from \finite A\ \A \ {}\ \a \ A\ show ?thesis proof (induct rule: finite_ne_induct) case singleton thus ?case by (simp add: refl) next case (insert x B) from insert have "a = x \ a \ B" by simp then show ?case using insert by (auto intro: coboundedI2) qed qed lemma subset_imp: assumes "A \ B" and "A \ {}" and "finite B" shows "F B \<^bold>\ F A" proof (cases "A = B") case True then show ?thesis by (simp add: refl) next case False have B: "B = A \ (B - A)" using \A \ B\ by blast then have "F B = F (A \ (B - A))" by simp also have "\ = F A \<^bold>* F (B - A)" using False assms by (subst union) (auto intro: finite_subset) also have "\ \<^bold>\ F A" by simp finally show ?thesis . qed end subsubsection \With neutral element\ locale semilattice_neutr_set = semilattice_neutr begin interpretation comp_fun_idem f by standard (simp_all add: fun_eq_iff left_commute) definition F :: "'a set \ 'a" where eq_fold: "F A = Finite_Set.fold f \<^bold>1 A" lemma infinite [simp]: "\ finite A \ F A = \<^bold>1" by (simp add: eq_fold) lemma empty [simp]: "F {} = \<^bold>1" by (simp add: eq_fold) lemma insert [simp]: assumes "finite A" shows "F (insert x A) = x \<^bold>* F A" using assms by (simp add: eq_fold) lemma in_idem: assumes "finite A" and "x \ A" shows "x \<^bold>* F A = F A" proof - from assms have "A \ {}" by auto with \finite A\ show ?thesis using \x \ A\ by (induct A rule: finite_ne_induct) (auto simp add: ac_simps) qed lemma union: assumes "finite A" and "finite B" shows "F (A \ B) = F A \<^bold>* F B" using assms by (induct A) (simp_all add: ac_simps) lemma remove: assumes "finite A" and "x \ A" shows "F A = x \<^bold>* F (A - {x})" proof - from assms obtain B where "A = insert x B" and "x \ B" by (blast dest: mk_disjoint_insert) with assms show ?thesis by simp qed lemma insert_remove: assumes "finite A" shows "F (insert x A) = x \<^bold>* F (A - {x})" using assms by (cases "x \ A") (simp_all add: insert_absorb remove) lemma subset: assumes "finite A" and "B \ A" shows "F B \<^bold>* F A = F A" proof - from assms have "finite B" by (auto dest: finite_subset) with assms show ?thesis by (simp add: union [symmetric] Un_absorb1) qed lemma closed: assumes "finite A" "A \ {}" and elem: "\x y. x \<^bold>* y \ {x, y}" shows "F A \ A" using \finite A\ \A \ {}\ proof (induct rule: finite_ne_induct) case singleton then show ?case by simp next case insert with elem show ?case by force qed end locale semilattice_order_neutr_set = binary?: semilattice_neutr_order + semilattice_neutr_set begin lemma bounded_iff: assumes "finite A" shows "x \<^bold>\ F A \ (\a\A. x \<^bold>\ a)" using assms by (induct A) simp_all lemma boundedI: assumes "finite A" assumes "\a. a \ A \ x \<^bold>\ a" shows "x \<^bold>\ F A" using assms by (simp add: bounded_iff) lemma boundedE: assumes "finite A" and "x \<^bold>\ F A" obtains "\a. a \ A \ x \<^bold>\ a" using assms by (simp add: bounded_iff) lemma coboundedI: assumes "finite A" and "a \ A" shows "F A \<^bold>\ a" proof - from assms have "A \ {}" by auto from \finite A\ \A \ {}\ \a \ A\ show ?thesis proof (induct rule: finite_ne_induct) case singleton thus ?case by (simp add: refl) next case (insert x B) from insert have "a = x \ a \ B" by simp then show ?case using insert by (auto intro: coboundedI2) qed qed lemma subset_imp: assumes "A \ B" and "finite B" shows "F B \<^bold>\ F A" proof (cases "A = B") case True then show ?thesis by (simp add: refl) next case False have B: "B = A \ (B - A)" using \A \ B\ by blast then have "F B = F (A \ (B - A))" by simp also have "\ = F A \<^bold>* F (B - A)" using False assms by (subst union) (auto intro: finite_subset) also have "\ \<^bold>\ F A" by simp finally show ?thesis . qed end subsection \Lattice operations on finite sets\ context semilattice_inf begin sublocale Inf_fin: semilattice_order_set inf less_eq less defines Inf_fin ("\\<^sub>f\<^sub>i\<^sub>n _" [900] 900) = Inf_fin.F .. end context semilattice_sup begin sublocale Sup_fin: semilattice_order_set sup greater_eq greater defines Sup_fin ("\\<^sub>f\<^sub>i\<^sub>n _" [900] 900) = Sup_fin.F .. end subsection \Infimum and Supremum over non-empty sets\ context lattice begin lemma Inf_fin_le_Sup_fin [simp]: assumes "finite A" and "A \ {}" shows "\\<^sub>f\<^sub>i\<^sub>nA \ \\<^sub>f\<^sub>i\<^sub>nA" proof - from \A \ {}\ obtain a where "a \ A" by blast with \finite A\ have "\\<^sub>f\<^sub>i\<^sub>nA \ a" by (rule Inf_fin.coboundedI) moreover from \finite A\ \a \ A\ have "a \ \\<^sub>f\<^sub>i\<^sub>nA" by (rule Sup_fin.coboundedI) ultimately show ?thesis by (rule order_trans) qed lemma sup_Inf_absorb [simp]: "finite A \ a \ A \ \\<^sub>f\<^sub>i\<^sub>nA \ a = a" by (rule sup_absorb2) (rule Inf_fin.coboundedI) lemma inf_Sup_absorb [simp]: "finite A \ a \ A \ a \ \\<^sub>f\<^sub>i\<^sub>nA = a" by (rule inf_absorb1) (rule Sup_fin.coboundedI) end context distrib_lattice begin lemma sup_Inf1_distrib: assumes "finite A" and "A \ {}" shows "sup x (\\<^sub>f\<^sub>i\<^sub>nA) = \\<^sub>f\<^sub>i\<^sub>n{sup x a|a. a \ A}" using assms by (simp add: image_def Inf_fin.hom_commute [where h="sup x", OF sup_inf_distrib1]) (rule arg_cong [where f="Inf_fin"], blast) lemma sup_Inf2_distrib: assumes A: "finite A" "A \ {}" and B: "finite B" "B \ {}" shows "sup (\\<^sub>f\<^sub>i\<^sub>nA) (\\<^sub>f\<^sub>i\<^sub>nB) = \\<^sub>f\<^sub>i\<^sub>n{sup a b|a b. a \ A \ b \ B}" using A proof (induct rule: finite_ne_induct) case singleton then show ?case by (simp add: sup_Inf1_distrib [OF B]) next case (insert x A) have finB: "finite {sup x b |b. b \ B}" by (rule finite_surj [where f = "sup x", OF B(1)], auto) have finAB: "finite {sup a b |a b. a \ A \ b \ B}" proof - have "{sup a b |a b. a \ A \ b \ B} = (\a\A. \b\B. {sup a b})" by blast thus ?thesis by(simp add: insert(1) B(1)) qed have ne: "{sup a b |a b. a \ A \ b \ B} \ {}" using insert B by blast have "sup (\\<^sub>f\<^sub>i\<^sub>n(insert x A)) (\\<^sub>f\<^sub>i\<^sub>nB) = sup (inf x (\\<^sub>f\<^sub>i\<^sub>nA)) (\\<^sub>f\<^sub>i\<^sub>nB)" using insert by simp also have "\ = inf (sup x (\\<^sub>f\<^sub>i\<^sub>nB)) (sup (\\<^sub>f\<^sub>i\<^sub>nA) (\\<^sub>f\<^sub>i\<^sub>nB))" by(rule sup_inf_distrib2) also have "\ = inf (\\<^sub>f\<^sub>i\<^sub>n{sup x b|b. b \ B}) (\\<^sub>f\<^sub>i\<^sub>n{sup a b|a b. a \ A \ b \ B})" using insert by(simp add:sup_Inf1_distrib[OF B]) also have "\ = \\<^sub>f\<^sub>i\<^sub>n({sup x b |b. b \ B} \ {sup a b |a b. a \ A \ b \ B})" (is "_ = \\<^sub>f\<^sub>i\<^sub>n?M") using B insert by (simp add: Inf_fin.union [OF finB _ finAB ne]) also have "?M = {sup a b |a b. a \ insert x A \ b \ B}" by blast finally show ?case . qed lemma inf_Sup1_distrib: assumes "finite A" and "A \ {}" shows "inf x (\\<^sub>f\<^sub>i\<^sub>nA) = \\<^sub>f\<^sub>i\<^sub>n{inf x a|a. a \ A}" using assms by (simp add: image_def Sup_fin.hom_commute [where h="inf x", OF inf_sup_distrib1]) (rule arg_cong [where f="Sup_fin"], blast) lemma inf_Sup2_distrib: assumes A: "finite A" "A \ {}" and B: "finite B" "B \ {}" shows "inf (\\<^sub>f\<^sub>i\<^sub>nA) (\\<^sub>f\<^sub>i\<^sub>nB) = \\<^sub>f\<^sub>i\<^sub>n{inf a b|a b. a \ A \ b \ B}" using A proof (induct rule: finite_ne_induct) case singleton thus ?case by(simp add: inf_Sup1_distrib [OF B]) next case (insert x A) have finB: "finite {inf x b |b. b \ B}" by(rule finite_surj[where f = "%b. inf x b", OF B(1)], auto) have finAB: "finite {inf a b |a b. a \ A \ b \ B}" proof - have "{inf a b |a b. a \ A \ b \ B} = (\a\A. \b\B. {inf a b})" by blast thus ?thesis by(simp add: insert(1) B(1)) qed have ne: "{inf a b |a b. a \ A \ b \ B} \ {}" using insert B by blast have "inf (\\<^sub>f\<^sub>i\<^sub>n(insert x A)) (\\<^sub>f\<^sub>i\<^sub>nB) = inf (sup x (\\<^sub>f\<^sub>i\<^sub>nA)) (\\<^sub>f\<^sub>i\<^sub>nB)" using insert by simp also have "\ = sup (inf x (\\<^sub>f\<^sub>i\<^sub>nB)) (inf (\\<^sub>f\<^sub>i\<^sub>nA) (\\<^sub>f\<^sub>i\<^sub>nB))" by(rule inf_sup_distrib2) also have "\ = sup (\\<^sub>f\<^sub>i\<^sub>n{inf x b|b. b \ B}) (\\<^sub>f\<^sub>i\<^sub>n{inf a b|a b. a \ A \ b \ B})" using insert by(simp add:inf_Sup1_distrib[OF B]) also have "\ = \\<^sub>f\<^sub>i\<^sub>n({inf x b |b. b \ B} \ {inf a b |a b. a \ A \ b \ B})" (is "_ = \\<^sub>f\<^sub>i\<^sub>n?M") using B insert by (simp add: Sup_fin.union [OF finB _ finAB ne]) also have "?M = {inf a b |a b. a \ insert x A \ b \ B}" by blast finally show ?case . qed end context complete_lattice begin lemma Inf_fin_Inf: assumes "finite A" and "A \ {}" shows "\\<^sub>f\<^sub>i\<^sub>nA = \A" proof - from assms obtain b B where "A = insert b B" and "finite B" by auto then show ?thesis by (simp add: Inf_fin.eq_fold inf_Inf_fold_inf inf.commute [of b]) qed lemma Sup_fin_Sup: assumes "finite A" and "A \ {}" shows "\\<^sub>f\<^sub>i\<^sub>nA = \A" proof - from assms obtain b B where "A = insert b B" and "finite B" by auto then show ?thesis by (simp add: Sup_fin.eq_fold sup_Sup_fold_sup sup.commute [of b]) qed end subsection \Minimum and Maximum over non-empty sets\ context linorder begin sublocale Min: semilattice_order_set min less_eq less + Max: semilattice_order_set max greater_eq greater defines Min = Min.F and Max = Max.F .. end syntax "_MIN1" :: "pttrns \ 'b \ 'b" ("(3MIN _./ _)" [0, 10] 10) "_MIN" :: "pttrn \ 'a set \ 'b \ 'b" ("(3MIN _\_./ _)" [0, 0, 10] 10) "_MAX1" :: "pttrns \ 'b \ 'b" ("(3MAX _./ _)" [0, 10] 10) "_MAX" :: "pttrn \ 'a set \ 'b \ 'b" ("(3MAX _\_./ _)" [0, 0, 10] 10) translations "MIN x y. f" \ "MIN x. MIN y. f" "MIN x. f" \ "CONST Min (CONST range (\x. f))" "MIN x\A. f" \ "CONST Min ((\x. f) ` A)" "MAX x y. f" \ "MAX x. MAX y. f" "MAX x. f" \ "CONST Max (CONST range (\x. f))" "MAX x\A. f" \ "CONST Max ((\x. f) ` A)" text \An aside: \<^const>\Min\/\<^const>\Max\ on linear orders as special case of \<^const>\Inf_fin\/\<^const>\Sup_fin\\ lemma Inf_fin_Min: "Inf_fin = (Min :: 'a::{semilattice_inf, linorder} set \ 'a)" by (simp add: Inf_fin_def Min_def inf_min) lemma Sup_fin_Max: "Sup_fin = (Max :: 'a::{semilattice_sup, linorder} set \ 'a)" by (simp add: Sup_fin_def Max_def sup_max) context linorder begin lemma dual_min: "ord.min greater_eq = max" by (auto simp add: ord.min_def max_def fun_eq_iff) lemma dual_max: "ord.max greater_eq = min" by (auto simp add: ord.max_def min_def fun_eq_iff) lemma dual_Min: "linorder.Min greater_eq = Max" proof - interpret dual: linorder greater_eq greater by (fact dual_linorder) show ?thesis by (simp add: dual.Min_def dual_min Max_def) qed lemma dual_Max: "linorder.Max greater_eq = Min" proof - interpret dual: linorder greater_eq greater by (fact dual_linorder) show ?thesis by (simp add: dual.Max_def dual_max Min_def) qed lemmas Min_singleton = Min.singleton lemmas Max_singleton = Max.singleton lemmas Min_insert = Min.insert lemmas Max_insert = Max.insert lemmas Min_Un = Min.union lemmas Max_Un = Max.union lemmas hom_Min_commute = Min.hom_commute lemmas hom_Max_commute = Max.hom_commute lemma Min_in [simp]: assumes "finite A" and "A \ {}" shows "Min A \ A" using assms by (auto simp add: min_def Min.closed) lemma Max_in [simp]: assumes "finite A" and "A \ {}" shows "Max A \ A" using assms by (auto simp add: max_def Max.closed) lemma Min_insert2: assumes "finite A" and min: "\b. b \ A \ a \ b" shows "Min (insert a A) = a" proof (cases "A = {}") case True then show ?thesis by simp next case False with \finite A\ have "Min (insert a A) = min a (Min A)" by simp moreover from \finite A\ \A \ {}\ min have "a \ Min A" by simp ultimately show ?thesis by (simp add: min.absorb1) qed lemma Max_insert2: assumes "finite A" and max: "\b. b \ A \ b \ a" shows "Max (insert a A) = a" proof (cases "A = {}") case True then show ?thesis by simp next case False with \finite A\ have "Max (insert a A) = max a (Max A)" by simp moreover from \finite A\ \A \ {}\ max have "Max A \ a" by simp ultimately show ?thesis by (simp add: max.absorb1) qed lemma Max_const[simp]: "\ finite A; A \ {} \ \ Max ((\_. c) ` A) = c" using Max_in image_is_empty by blast lemma Min_const[simp]: "\ finite A; A \ {} \ \ Min ((\_. c) ` A) = c" using Min_in image_is_empty by blast lemma Min_le [simp]: assumes "finite A" and "x \ A" shows "Min A \ x" using assms by (fact Min.coboundedI) lemma Max_ge [simp]: assumes "finite A" and "x \ A" shows "x \ Max A" using assms by (fact Max.coboundedI) lemma Min_eqI: assumes "finite A" assumes "\y. y \ A \ y \ x" and "x \ A" shows "Min A = x" -proof (rule antisym) +proof (rule order.antisym) from \x \ A\ have "A \ {}" by auto with assms show "Min A \ x" by simp next from assms show "x \ Min A" by simp qed lemma Max_eqI: assumes "finite A" assumes "\y. y \ A \ y \ x" and "x \ A" shows "Max A = x" -proof (rule antisym) +proof (rule order.antisym) from \x \ A\ have "A \ {}" by auto with assms show "Max A \ x" by simp next from assms show "x \ Max A" by simp qed lemma eq_Min_iff: "\ finite A; A \ {} \ \ m = Min A \ m \ A \ (\a \ A. m \ a)" -by (meson Min_in Min_le antisym) +by (meson Min_in Min_le order.antisym) lemma Min_eq_iff: "\ finite A; A \ {} \ \ Min A = m \ m \ A \ (\a \ A. m \ a)" -by (meson Min_in Min_le antisym) +by (meson Min_in Min_le order.antisym) lemma eq_Max_iff: "\ finite A; A \ {} \ \ m = Max A \ m \ A \ (\a \ A. a \ m)" -by (meson Max_in Max_ge antisym) +by (meson Max_in Max_ge order.antisym) lemma Max_eq_iff: "\ finite A; A \ {} \ \ Max A = m \ m \ A \ (\a \ A. a \ m)" -by (meson Max_in Max_ge antisym) +by (meson Max_in Max_ge order.antisym) context fixes A :: "'a set" assumes fin_nonempty: "finite A" "A \ {}" begin lemma Min_ge_iff [simp]: "x \ Min A \ (\a\A. x \ a)" using fin_nonempty by (fact Min.bounded_iff) lemma Max_le_iff [simp]: "Max A \ x \ (\a\A. a \ x)" using fin_nonempty by (fact Max.bounded_iff) lemma Min_gr_iff [simp]: "x < Min A \ (\a\A. x < a)" using fin_nonempty by (induct rule: finite_ne_induct) simp_all lemma Max_less_iff [simp]: "Max A < x \ (\a\A. a < x)" using fin_nonempty by (induct rule: finite_ne_induct) simp_all lemma Min_le_iff: "Min A \ x \ (\a\A. a \ x)" using fin_nonempty by (induct rule: finite_ne_induct) (simp_all add: min_le_iff_disj) lemma Max_ge_iff: "x \ Max A \ (\a\A. x \ a)" using fin_nonempty by (induct rule: finite_ne_induct) (simp_all add: le_max_iff_disj) lemma Min_less_iff: "Min A < x \ (\a\A. a < x)" using fin_nonempty by (induct rule: finite_ne_induct) (simp_all add: min_less_iff_disj) lemma Max_gr_iff: "x < Max A \ (\a\A. x < a)" using fin_nonempty by (induct rule: finite_ne_induct) (simp_all add: less_max_iff_disj) end lemma Max_eq_if: assumes "finite A" "finite B" "\a\A. \b\B. a \ b" "\b\B. \a\A. b \ a" shows "Max A = Max B" proof cases assume "A = {}" thus ?thesis using assms by simp next assume "A \ {}" thus ?thesis using assms - by(blast intro: antisym Max_in Max_ge_iff[THEN iffD2]) + by(blast intro: order.antisym Max_in Max_ge_iff[THEN iffD2]) qed lemma Min_antimono: assumes "M \ N" and "M \ {}" and "finite N" shows "Min N \ Min M" using assms by (fact Min.subset_imp) lemma Max_mono: assumes "M \ N" and "M \ {}" and "finite N" shows "Max M \ Max N" using assms by (fact Max.subset_imp) lemma mono_Min_commute: assumes "mono f" assumes "finite A" and "A \ {}" shows "f (Min A) = Min (f ` A)" proof (rule linorder_class.Min_eqI [symmetric]) from \finite A\ show "finite (f ` A)" by simp from assms show "f (Min A) \ f ` A" by simp fix x assume "x \ f ` A" then obtain y where "y \ A" and "x = f y" .. with assms have "Min A \ y" by auto with \mono f\ have "f (Min A) \ f y" by (rule monoE) with \x = f y\ show "f (Min A) \ x" by simp qed lemma mono_Max_commute: assumes "mono f" assumes "finite A" and "A \ {}" shows "f (Max A) = Max (f ` A)" proof (rule linorder_class.Max_eqI [symmetric]) from \finite A\ show "finite (f ` A)" by simp from assms show "f (Max A) \ f ` A" by simp fix x assume "x \ f ` A" then obtain y where "y \ A" and "x = f y" .. with assms have "y \ Max A" by auto with \mono f\ have "f y \ f (Max A)" by (rule monoE) with \x = f y\ show "x \ f (Max A)" by simp qed lemma finite_linorder_max_induct [consumes 1, case_names empty insert]: assumes fin: "finite A" and empty: "P {}" and insert: "\b A. finite A \ \a\A. a < b \ P A \ P (insert b A)" shows "P A" using fin empty insert proof (induct rule: finite_psubset_induct) case (psubset A) have IH: "\B. \B < A; P {}; (\A b. \finite A; \a\A. a \ P (insert b A))\ \ P B" by fact have fin: "finite A" by fact have empty: "P {}" by fact have step: "\b A. \finite A; \a\A. a < b; P A\ \ P (insert b A)" by fact show "P A" proof (cases "A = {}") assume "A = {}" then show "P A" using \P {}\ by simp next let ?B = "A - {Max A}" let ?A = "insert (Max A) ?B" have "finite ?B" using \finite A\ by simp assume "A \ {}" with \finite A\ have "Max A \ A" by auto then have A: "?A = A" using insert_Diff_single insert_absorb by auto then have "P ?B" using \P {}\ step IH [of ?B] by blast moreover have "\a\?B. a < Max A" using Max_ge [OF \finite A\] by fastforce ultimately show "P A" using A insert_Diff_single step [OF \finite ?B\] by fastforce qed qed lemma finite_linorder_min_induct [consumes 1, case_names empty insert]: "\finite A; P {}; \b A. \finite A; \a\A. b < a; P A\ \ P (insert b A)\ \ P A" by (rule linorder.finite_linorder_max_induct [OF dual_linorder]) lemma finite_ranking_induct[consumes 1, case_names empty insert]: fixes f :: "'b \ 'a" assumes "finite S" assumes "P {}" assumes "\x S. finite S \ (\y. y \ S \ f y \ f x) \ P S \ P (insert x S)" shows "P S" using \finite S\ proof (induction rule: finite_psubset_induct) case (psubset A) { assume "A \ {}" hence "f ` A \ {}" and "finite (f ` A)" using psubset finite_image_iff by simp+ then obtain a where "f a = Max (f ` A)" and "a \ A" by (metis Max_in[of "f ` A"] imageE) then have "P (A - {a})" using psubset member_remove by blast moreover have "\y. y \ A \ f y \ f a" using \f a = Max (f ` A)\ \finite (f ` A)\ by simp ultimately have ?case by (metis \a \ A\ DiffD1 insert_Diff assms(3) finite_Diff psubset.hyps) } thus ?case using assms(2) by blast qed lemma Least_Min: assumes "finite {a. P a}" and "\a. P a" shows "(LEAST a. P a) = Min {a. P a}" proof - { fix A :: "'a set" assume A: "finite A" "A \ {}" have "(LEAST a. a \ A) = Min A" using A proof (induct A rule: finite_ne_induct) case singleton show ?case by (rule Least_equality) simp_all next case (insert a A) have "(LEAST b. b = a \ b \ A) = min a (LEAST a. a \ A)" by (auto intro!: Least_equality simp add: min_def not_le Min_le_iff insert.hyps dest!: less_imp_le) with insert show ?case by simp qed } from this [of "{a. P a}"] assms show ?thesis by simp qed lemma infinite_growing: assumes "X \ {}" assumes *: "\x. x \ X \ \y\X. y > x" shows "\ finite X" proof assume "finite X" with \X \ {}\ have "Max X \ X" "\x\X. x \ Max X" by auto with *[of "Max X"] show False by auto qed end lemma sum_le_card_Max: "finite A \ sum f A \ card A * Max (f ` A)" using sum_bounded_above[of A f "Max (f ` A)"] by simp lemma card_Min_le_sum: "finite A \ card A * Min (f ` A) \ sum f A" using sum_bounded_below[of A "Min (f ` A)" f] by simp context linordered_ab_semigroup_add begin lemma Min_add_commute: fixes k assumes "finite S" and "S \ {}" shows "Min ((\x. f x + k) ` S) = Min(f ` S) + k" proof - have m: "\x y. min x y + k = min (x+k) (y+k)" - by(simp add: min_def antisym add_right_mono) + by (simp add: min_def order.antisym add_right_mono) have "(\x. f x + k) ` S = (\y. y + k) ` (f ` S)" by auto also have "Min \ = Min (f ` S) + k" using assms hom_Min_commute [of "\y. y+k" "f ` S", OF m, symmetric] by simp finally show ?thesis by simp qed lemma Max_add_commute: fixes k assumes "finite S" and "S \ {}" shows "Max ((\x. f x + k) ` S) = Max(f ` S) + k" proof - have m: "\x y. max x y + k = max (x+k) (y+k)" - by(simp add: max_def antisym add_right_mono) + by (simp add: max_def order.antisym add_right_mono) have "(\x. f x + k) ` S = (\y. y + k) ` (f ` S)" by auto also have "Max \ = Max (f ` S) + k" using assms hom_Max_commute [of "\y. y+k" "f ` S", OF m, symmetric] by simp finally show ?thesis by simp qed end context linordered_ab_group_add begin lemma minus_Max_eq_Min [simp]: "finite S \ S \ {} \ - Max S = Min (uminus ` S)" by (induct S rule: finite_ne_induct) (simp_all add: minus_max_eq_min) lemma minus_Min_eq_Max [simp]: "finite S \ S \ {} \ - Min S = Max (uminus ` S)" by (induct S rule: finite_ne_induct) (simp_all add: minus_min_eq_max) end context complete_linorder begin lemma Min_Inf: assumes "finite A" and "A \ {}" shows "Min A = Inf A" proof - from assms obtain b B where "A = insert b B" and "finite B" by auto then show ?thesis by (simp add: Min.eq_fold complete_linorder_inf_min [symmetric] inf_Inf_fold_inf inf.commute [of b]) qed lemma Max_Sup: assumes "finite A" and "A \ {}" shows "Max A = Sup A" proof - from assms obtain b B where "A = insert b B" and "finite B" by auto then show ?thesis by (simp add: Max.eq_fold complete_linorder_sup_max [symmetric] sup_Sup_fold_sup sup.commute [of b]) qed end lemma disjnt_ge_max: \<^marker>\contributor \Lars Hupel\\ \disjnt X Y\ if \finite Y\ \\x. x \ X \ x > Max Y\ using that by (auto simp add: disjnt_def) (use Max_less_iff in blast) subsection \Arg Min\ context ord begin definition is_arg_min :: "('b \ 'a) \ ('b \ bool) \ 'b \ bool" where "is_arg_min f P x = (P x \ \(\y. P y \ f y < f x))" definition arg_min :: "('b \ 'a) \ ('b \ bool) \ 'b" where "arg_min f P = (SOME x. is_arg_min f P x)" definition arg_min_on :: "('b \ 'a) \ 'b set \ 'b" where "arg_min_on f S = arg_min f (\x. x \ S)" end syntax "_arg_min" :: "('b \ 'a) \ pttrn \ bool \ 'b" ("(3ARG'_MIN _ _./ _)" [1000, 0, 10] 10) translations "ARG_MIN f x. P" \ "CONST arg_min f (\x. P)" lemma is_arg_min_linorder: fixes f :: "'a \ 'b :: linorder" shows "is_arg_min f P x = (P x \ (\y. P y \ f x \ f y))" by(auto simp add: is_arg_min_def) lemma is_arg_min_antimono: fixes f :: "'a \ ('b::order)" shows "\ is_arg_min f P x; f y \ f x; P y \ \ is_arg_min f P y" by (simp add: order.order_iff_strict is_arg_min_def) lemma arg_minI: "\ P x; \y. P y \ \ f y < f x; \x. \ P x; \y. P y \ \ f y < f x \ \ Q x \ \ Q (arg_min f P)" apply (simp add: arg_min_def is_arg_min_def) apply (rule someI2_ex) apply blast apply blast done lemma arg_min_equality: "\ P k; \x. P x \ f k \ f x \ \ f (arg_min f P) = f k" for f :: "_ \ 'a::order" apply (rule arg_minI) apply assumption apply (simp add: less_le_not_le) by (metis le_less) lemma wf_linord_ex_has_least: "\ wf r; \x y. (x, y) \ r\<^sup>+ \ (y, x) \ r\<^sup>*; P k \ \ \x. P x \ (\y. P y \ (m x, m y) \ r\<^sup>*)" apply (drule wf_trancl [THEN wf_eq_minimal [THEN iffD1]]) apply (drule_tac x = "m ` Collect P" in spec) by force lemma ex_has_least_nat: "P k \ \x. P x \ (\y. P y \ m x \ m y)" for m :: "'a \ nat" apply (simp only: pred_nat_trancl_eq_le [symmetric]) apply (rule wf_pred_nat [THEN wf_linord_ex_has_least]) apply (simp add: less_eq linorder_not_le pred_nat_trancl_eq_le) by assumption lemma arg_min_nat_lemma: "P k \ P(arg_min m P) \ (\y. P y \ m (arg_min m P) \ m y)" for m :: "'a \ nat" apply (simp add: arg_min_def is_arg_min_linorder) apply (rule someI_ex) apply (erule ex_has_least_nat) done lemmas arg_min_natI = arg_min_nat_lemma [THEN conjunct1] lemma is_arg_min_arg_min_nat: fixes m :: "'a \ nat" shows "P x \ is_arg_min m P (arg_min m P)" by (metis arg_min_nat_lemma is_arg_min_linorder) lemma arg_min_nat_le: "P x \ m (arg_min m P) \ m x" for m :: "'a \ nat" by (rule arg_min_nat_lemma [THEN conjunct2, THEN spec, THEN mp]) lemma ex_min_if_finite: "\ finite S; S \ {} \ \ \m\S. \(\x\S. x < (m::'a::order))" by(induction rule: finite.induct) (auto intro: order.strict_trans) lemma ex_is_arg_min_if_finite: fixes f :: "'a \ 'b :: order" shows "\ finite S; S \ {} \ \ \x. is_arg_min f (\x. x \ S) x" unfolding is_arg_min_def using ex_min_if_finite[of "f ` S"] by auto lemma arg_min_SOME_Min: "finite S \ arg_min_on f S = (SOME y. y \ S \ f y = Min(f ` S))" unfolding arg_min_on_def arg_min_def is_arg_min_linorder apply(rule arg_cong[where f = Eps]) apply (auto simp: fun_eq_iff intro: Min_eqI[symmetric]) done lemma arg_min_if_finite: fixes f :: "'a \ 'b :: order" assumes "finite S" "S \ {}" shows "arg_min_on f S \ S" and "\(\x\S. f x < f (arg_min_on f S))" using ex_is_arg_min_if_finite[OF assms, of f] unfolding arg_min_on_def arg_min_def is_arg_min_def by(auto dest!: someI_ex) lemma arg_min_least: fixes f :: "'a \ 'b :: linorder" shows "\ finite S; S \ {}; y \ S \ \ f(arg_min_on f S) \ f y" by(simp add: arg_min_SOME_Min inv_into_def2[symmetric] f_inv_into_f) lemma arg_min_inj_eq: fixes f :: "'a \ 'b :: order" shows "\ inj_on f {x. P x}; P a; \y. P y \ f a \ f y \ \ arg_min f P = a" apply(simp add: arg_min_def is_arg_min_def) apply(rule someI2[of _ a]) apply (simp add: less_le_not_le) by (metis inj_on_eq_iff less_le mem_Collect_eq) subsection \Arg Max\ context ord begin definition is_arg_max :: "('b \ 'a) \ ('b \ bool) \ 'b \ bool" where "is_arg_max f P x = (P x \ \(\y. P y \ f y > f x))" definition arg_max :: "('b \ 'a) \ ('b \ bool) \ 'b" where "arg_max f P = (SOME x. is_arg_max f P x)" definition arg_max_on :: "('b \ 'a) \ 'b set \ 'b" where "arg_max_on f S = arg_max f (\x. x \ S)" end syntax "_arg_max" :: "('b \ 'a) \ pttrn \ bool \ 'a" ("(3ARG'_MAX _ _./ _)" [1000, 0, 10] 10) translations "ARG_MAX f x. P" \ "CONST arg_max f (\x. P)" lemma is_arg_max_linorder: fixes f :: "'a \ 'b :: linorder" shows "is_arg_max f P x = (P x \ (\y. P y \ f x \ f y))" by(auto simp add: is_arg_max_def) lemma arg_maxI: "P x \ (\y. P y \ \ f y > f x) \ (\x. P x \ \y. P y \ \ f y > f x \ Q x) \ Q (arg_max f P)" apply (simp add: arg_max_def is_arg_max_def) apply (rule someI2_ex) apply blast apply blast done lemma arg_max_equality: "\ P k; \x. P x \ f x \ f k \ \ f (arg_max f P) = f k" for f :: "_ \ 'a::order" apply (rule arg_maxI [where f = f]) apply assumption apply (simp add: less_le_not_le) by (metis le_less) lemma ex_has_greatest_nat_lemma: "P k \ \x. P x \ (\y. P y \ \ f y \ f x) \ \y. P y \ \ f y < f k + n" for f :: "'a \ nat" by (induct n) (force simp: le_Suc_eq)+ lemma ex_has_greatest_nat: "P k \ \y. P y \ f y < b \ \x. P x \ (\y. P y \ f y \ f x)" for f :: "'a \ nat" apply (rule ccontr) apply (cut_tac P = P and n = "b - f k" in ex_has_greatest_nat_lemma) apply (subgoal_tac [3] "f k \ b") apply auto done lemma arg_max_nat_lemma: "\ P k; \y. P y \ f y < b \ \ P (arg_max f P) \ (\y. P y \ f y \ f (arg_max f P))" for f :: "'a \ nat" apply (simp add: arg_max_def is_arg_max_linorder) apply (rule someI_ex) apply (erule (1) ex_has_greatest_nat) done lemmas arg_max_natI = arg_max_nat_lemma [THEN conjunct1] lemma arg_max_nat_le: "P x \ \y. P y \ f y < b \ f x \ f (arg_max f P)" for f :: "'a \ nat" by (blast dest: arg_max_nat_lemma [THEN conjunct2, THEN spec, of P]) end diff --git a/src/HOL/Library/Complete_Partial_Order2.thy b/src/HOL/Library/Complete_Partial_Order2.thy --- a/src/HOL/Library/Complete_Partial_Order2.thy +++ b/src/HOL/Library/Complete_Partial_Order2.thy @@ -1,1750 +1,1751 @@ (* Title: HOL/Library/Complete_Partial_Order2.thy Author: Andreas Lochbihler, ETH Zurich *) section \Formalisation of chain-complete partial orders, continuity and admissibility\ theory Complete_Partial_Order2 imports Main Lattice_Syntax begin lemma chain_transfer [transfer_rule]: includes lifting_syntax shows "((A ===> A ===> (=)) ===> rel_set A ===> (=)) Complete_Partial_Order.chain Complete_Partial_Order.chain" unfolding chain_def[abs_def] by transfer_prover lemma linorder_chain [simp, intro!]: fixes Y :: "_ :: linorder set" shows "Complete_Partial_Order.chain (\) Y" by(auto intro: chainI) lemma fun_lub_apply: "\Sup. fun_lub Sup Y x = Sup ((\f. f x) ` Y)" by(simp add: fun_lub_def image_def) lemma fun_lub_empty [simp]: "fun_lub lub {} = (\_. lub {})" by(rule ext)(simp add: fun_lub_apply) lemma chain_fun_ordD: assumes "Complete_Partial_Order.chain (fun_ord le) Y" shows "Complete_Partial_Order.chain le ((\f. f x) ` Y)" by(rule chainI)(auto dest: chainD[OF assms] simp add: fun_ord_def) lemma chain_Diff: "Complete_Partial_Order.chain ord A \ Complete_Partial_Order.chain ord (A - B)" by(erule chain_subset) blast lemma chain_rel_prodD1: "Complete_Partial_Order.chain (rel_prod orda ordb) Y \ Complete_Partial_Order.chain orda (fst ` Y)" by(auto 4 3 simp add: chain_def) lemma chain_rel_prodD2: "Complete_Partial_Order.chain (rel_prod orda ordb) Y \ Complete_Partial_Order.chain ordb (snd ` Y)" by(auto 4 3 simp add: chain_def) context ccpo begin lemma ccpo_fun: "class.ccpo (fun_lub Sup) (fun_ord (\)) (mk_less (fun_ord (\)))" by standard (auto 4 3 simp add: mk_less_def fun_ord_def fun_lub_apply - intro: order.trans antisym chain_imageI ccpo_Sup_upper ccpo_Sup_least) + intro: order.trans order.antisym chain_imageI ccpo_Sup_upper ccpo_Sup_least) lemma ccpo_Sup_below_iff: "Complete_Partial_Order.chain (\) Y \ Sup Y \ x \ (\y\Y. y \ x)" by(fast intro: order_trans[OF ccpo_Sup_upper] ccpo_Sup_least) lemma Sup_minus_bot: assumes chain: "Complete_Partial_Order.chain (\) A" shows "\(A - {\{}}) = \A" (is "?lhs = ?rhs") -proof (rule antisym) +proof (rule order.antisym) show "?lhs \ ?rhs" by (blast intro: ccpo_Sup_least chain_Diff[OF chain] ccpo_Sup_upper[OF chain]) show "?rhs \ ?lhs" proof (rule ccpo_Sup_least [OF chain]) show "x \ A \ x \ ?lhs" for x by (cases "x = \{}") (blast intro: ccpo_Sup_least chain_empty ccpo_Sup_upper[OF chain_Diff[OF chain]])+ qed qed lemma mono_lub: fixes le_b (infix "\" 60) assumes chain: "Complete_Partial_Order.chain (fun_ord (\)) Y" and mono: "\f. f \ Y \ monotone le_b (\) f" shows "monotone (\) (\) (fun_lub Sup Y)" proof(rule monotoneI) fix x y assume "x \ y" have chain'': "\x. Complete_Partial_Order.chain (\) ((\f. f x) ` Y)" using chain by(rule chain_imageI)(simp add: fun_ord_def) then show "fun_lub Sup Y x \ fun_lub Sup Y y" unfolding fun_lub_apply proof(rule ccpo_Sup_least) fix x' assume "x' \ (\f. f x) ` Y" then obtain f where "f \ Y" "x' = f x" by blast note \x' = f x\ also from \f \ Y\ \x \ y\ have "f x \ f y" by(blast dest: mono monotoneD) also have "\ \ \((\f. f y) ` Y)" using chain'' by(rule ccpo_Sup_upper)(simp add: \f \ Y\) finally show "x' \ \((\f. f y) ` Y)" . qed qed context fixes le_b (infix "\" 60) and Y f assumes chain: "Complete_Partial_Order.chain le_b Y" and mono1: "\y. y \ Y \ monotone le_b (\) (\x. f x y)" and mono2: "\x a b. \ x \ Y; a \ b; a \ Y; b \ Y \ \ f x a \ f x b" begin lemma Sup_mono: assumes le: "x \ y" and x: "x \ Y" and y: "y \ Y" shows "\(f x ` Y) \ \(f y ` Y)" (is "_ \ ?rhs") proof(rule ccpo_Sup_least) from chain show chain': "Complete_Partial_Order.chain (\) (f x ` Y)" when "x \ Y" for x by(rule chain_imageI) (insert that, auto dest: mono2) fix x' assume "x' \ f x ` Y" then obtain y' where "y' \ Y" "x' = f x y'" by blast note this(2) also from mono1[OF \y' \ Y\] le have "\ \ f y y'" by(rule monotoneD) also have "\ \ ?rhs" using chain'[OF y] by (auto intro!: ccpo_Sup_upper simp add: \y' \ Y\) finally show "x' \ ?rhs" . qed(rule x) lemma diag_Sup: "\((\x. \(f x ` Y)) ` Y) = \((\x. f x x) ` Y)" (is "?lhs = ?rhs") -proof(rule antisym) +proof(rule order.antisym) have chain1: "Complete_Partial_Order.chain (\) ((\x. \(f x ` Y)) ` Y)" using chain by(rule chain_imageI)(rule Sup_mono) have chain2: "\y'. y' \ Y \ Complete_Partial_Order.chain (\) (f y' ` Y)" using chain by(rule chain_imageI)(auto dest: mono2) have chain3: "Complete_Partial_Order.chain (\) ((\x. f x x) ` Y)" using chain by(rule chain_imageI)(auto intro: monotoneD[OF mono1] mono2 order.trans) show "?lhs \ ?rhs" using chain1 proof(rule ccpo_Sup_least) fix x' assume "x' \ (\x. \(f x ` Y)) ` Y" then obtain y' where "y' \ Y" "x' = \(f y' ` Y)" by blast note this(2) also have "\ \ ?rhs" using chain2[OF \y' \ Y\] proof(rule ccpo_Sup_least) fix x assume "x \ f y' ` Y" then obtain y where "y \ Y" and x: "x = f y' y" by blast define y'' where "y'' = (if y \ y' then y' else y)" from chain \y \ Y\ \y' \ Y\ have "y \ y' \ y' \ y" by(rule chainD) hence "f y' y \ f y'' y''" using \y \ Y\ \y' \ Y\ by(auto simp add: y''_def intro: mono2 monotoneD[OF mono1]) also from \y \ Y\ \y' \ Y\ have "y'' \ Y" by(simp add: y''_def) from chain3 have "f y'' y'' \ ?rhs" by(rule ccpo_Sup_upper)(simp add: \y'' \ Y\) finally show "x \ ?rhs" by(simp add: x) qed finally show "x' \ ?rhs" . qed show "?rhs \ ?lhs" using chain3 proof(rule ccpo_Sup_least) fix y assume "y \ (\x. f x x) ` Y" then obtain x where "x \ Y" and "y = f x x" by blast note this(2) also from chain2[OF \x \ Y\] have "\ \ \(f x ` Y)" by(rule ccpo_Sup_upper)(simp add: \x \ Y\) also have "\ \ ?lhs" by(rule ccpo_Sup_upper[OF chain1])(simp add: \x \ Y\) finally show "y \ ?lhs" . qed qed end lemma Sup_image_mono_le: fixes le_b (infix "\" 60) and Sup_b ("\") assumes ccpo: "class.ccpo Sup_b (\) lt_b" assumes chain: "Complete_Partial_Order.chain (\) Y" and mono: "\x y. \ x \ y; x \ Y \ \ f x \ f y" shows "Sup (f ` Y) \ f (\Y)" proof(rule ccpo_Sup_least) show "Complete_Partial_Order.chain (\) (f ` Y)" using chain by(rule chain_imageI)(rule mono) fix x assume "x \ f ` Y" then obtain y where "y \ Y" and "x = f y" by blast note this(2) also have "y \ \Y" using ccpo chain \y \ Y\ by(rule ccpo.ccpo_Sup_upper) hence "f y \ f (\Y)" using \y \ Y\ by(rule mono) finally show "x \ \" . qed lemma swap_Sup: fixes le_b (infix "\" 60) assumes Y: "Complete_Partial_Order.chain (\) Y" and Z: "Complete_Partial_Order.chain (fun_ord (\)) Z" and mono: "\f. f \ Z \ monotone (\) (\) f" shows "\((\x. \(x ` Y)) ` Z) = \((\x. \((\f. f x) ` Z)) ` Y)" (is "?lhs = ?rhs") proof(cases "Y = {}") case True then show ?thesis by (simp add: image_constant_conv cong del: SUP_cong_simp) next case False have chain1: "\f. f \ Z \ Complete_Partial_Order.chain (\) (f ` Y)" by(rule chain_imageI[OF Y])(rule monotoneD[OF mono]) have chain2: "Complete_Partial_Order.chain (\) ((\x. \(x ` Y)) ` Z)" using Z proof(rule chain_imageI) fix f g assume "f \ Z" "g \ Z" and "fun_ord (\) f g" from chain1[OF \f \ Z\] show "\(f ` Y) \ \(g ` Y)" proof(rule ccpo_Sup_least) fix x assume "x \ f ` Y" then obtain y where "y \ Y" "x = f y" by blast note this(2) also have "\ \ g y" using \fun_ord (\) f g\ by(simp add: fun_ord_def) also have "\ \ \(g ` Y)" using chain1[OF \g \ Z\] by(rule ccpo_Sup_upper)(simp add: \y \ Y\) finally show "x \ \(g ` Y)" . qed qed have chain3: "\x. Complete_Partial_Order.chain (\) ((\f. f x) ` Z)" using Z by(rule chain_imageI)(simp add: fun_ord_def) have chain4: "Complete_Partial_Order.chain (\) ((\x. \((\f. f x) ` Z)) ` Y)" using Y proof(rule chain_imageI) fix f x y assume "x \ y" show "\((\f. f x) ` Z) \ \((\f. f y) ` Z)" (is "_ \ ?rhs") using chain3 proof(rule ccpo_Sup_least) fix x' assume "x' \ (\f. f x) ` Z" then obtain f where "f \ Z" "x' = f x" by blast note this(2) also have "f x \ f y" using \f \ Z\ \x \ y\ by(rule monotoneD[OF mono]) also have "f y \ ?rhs" using chain3 by(rule ccpo_Sup_upper)(simp add: \f \ Z\) finally show "x' \ ?rhs" . qed qed from chain2 have "?lhs \ ?rhs" proof(rule ccpo_Sup_least) fix x assume "x \ (\x. \(x ` Y)) ` Z" then obtain f where "f \ Z" "x = \(f ` Y)" by blast note this(2) also have "\ \ ?rhs" using chain1[OF \f \ Z\] proof(rule ccpo_Sup_least) fix x' assume "x' \ f ` Y" then obtain y where "y \ Y" "x' = f y" by blast note this(2) also have "f y \ \((\f. f y) ` Z)" using chain3 by(rule ccpo_Sup_upper)(simp add: \f \ Z\) also have "\ \ ?rhs" using chain4 by(rule ccpo_Sup_upper)(simp add: \y \ Y\) finally show "x' \ ?rhs" . qed finally show "x \ ?rhs" . qed moreover have "?rhs \ ?lhs" using chain4 proof(rule ccpo_Sup_least) fix x assume "x \ (\x. \((\f. f x) ` Z)) ` Y" then obtain y where "y \ Y" "x = \((\f. f y) ` Z)" by blast note this(2) also have "\ \ ?lhs" using chain3 proof(rule ccpo_Sup_least) fix x' assume "x' \ (\f. f y) ` Z" then obtain f where "f \ Z" "x' = f y" by blast note this(2) also have "f y \ \(f ` Y)" using chain1[OF \f \ Z\] by(rule ccpo_Sup_upper)(simp add: \y \ Y\) also have "\ \ ?lhs" using chain2 by(rule ccpo_Sup_upper)(simp add: \f \ Z\) finally show "x' \ ?lhs" . qed finally show "x \ ?lhs" . qed - ultimately show "?lhs = ?rhs" by(rule antisym) + ultimately show "?lhs = ?rhs" + by (rule order.antisym) qed lemma fixp_mono: assumes fg: "fun_ord (\) f g" and f: "monotone (\) (\) f" and g: "monotone (\) (\) g" shows "ccpo_class.fixp f \ ccpo_class.fixp g" unfolding fixp_def proof(rule ccpo_Sup_least) fix x assume "x \ ccpo_class.iterates f" thus "x \ \ccpo_class.iterates g" proof induction case (step x) from f step.IH have "f x \ f (\ccpo_class.iterates g)" by(rule monotoneD) also have "\ \ g (\ccpo_class.iterates g)" using fg by(simp add: fun_ord_def) also have "\ = \ccpo_class.iterates g" by(fold fixp_def fixp_unfold[OF g]) simp finally show ?case . qed(blast intro: ccpo_Sup_least) qed(rule chain_iterates[OF f]) context fixes ordb :: "'b \ 'b \ bool" (infix "\" 60) begin lemma iterates_mono: assumes f: "f \ ccpo.iterates (fun_lub Sup) (fun_ord (\)) F" and mono: "\f. monotone (\) (\) f \ monotone (\) (\) (F f)" shows "monotone (\) (\) f" using f by(induction rule: ccpo.iterates.induct[OF ccpo_fun, consumes 1, case_names step Sup])(blast intro: mono mono_lub)+ lemma fixp_preserves_mono: assumes mono: "\x. monotone (fun_ord (\)) (\) (\f. F f x)" and mono2: "\f. monotone (\) (\) f \ monotone (\) (\) (F f)" shows "monotone (\) (\) (ccpo.fixp (fun_lub Sup) (fun_ord (\)) F)" (is "monotone _ _ ?fixp") proof(rule monotoneI) have mono: "monotone (fun_ord (\)) (fun_ord (\)) F" by(rule monotoneI)(auto simp add: fun_ord_def intro: monotoneD[OF mono]) let ?iter = "ccpo.iterates (fun_lub Sup) (fun_ord (\)) F" have chain: "\x. Complete_Partial_Order.chain (\) ((\f. f x) ` ?iter)" by(rule chain_imageI[OF ccpo.chain_iterates[OF ccpo_fun mono]])(simp add: fun_ord_def) fix x y assume "x \ y" show "?fixp x \ ?fixp y" apply (simp only: ccpo.fixp_def[OF ccpo_fun] fun_lub_apply) using chain proof(rule ccpo_Sup_least) fix x' assume "x' \ (\f. f x) ` ?iter" then obtain f where "f \ ?iter" "x' = f x" by blast note this(2) also have "f x \ f y" by(rule monotoneD[OF iterates_mono[OF \f \ ?iter\ mono2]])(blast intro: \x \ y\)+ also have "f y \ \((\f. f y) ` ?iter)" using chain by(rule ccpo_Sup_upper)(simp add: \f \ ?iter\) finally show "x' \ \" . qed qed end end lemma monotone2monotone: assumes 2: "\x. monotone ordb ordc (\y. f x y)" and t: "monotone orda ordb (\x. t x)" and 1: "\y. monotone orda ordc (\x. f x y)" and trans: "transp ordc" shows "monotone orda ordc (\x. f x (t x))" by(blast intro: monotoneI transpD[OF trans] monotoneD[OF t] monotoneD[OF 2] monotoneD[OF 1]) subsection \Continuity\ definition cont :: "('a set \ 'a) \ ('a \ 'a \ bool) \ ('b set \ 'b) \ ('b \ 'b \ bool) \ ('a \ 'b) \ bool" where "cont luba orda lubb ordb f \ (\Y. Complete_Partial_Order.chain orda Y \ Y \ {} \ f (luba Y) = lubb (f ` Y))" definition mcont :: "('a set \ 'a) \ ('a \ 'a \ bool) \ ('b set \ 'b) \ ('b \ 'b \ bool) \ ('a \ 'b) \ bool" where "mcont luba orda lubb ordb f \ monotone orda ordb f \ cont luba orda lubb ordb f" subsubsection \Theorem collection \cont_intro\\ named_theorems cont_intro "continuity and admissibility intro rules" ML \ (* apply cont_intro rules as intro and try to solve the remaining of the emerging subgoals with simp *) fun cont_intro_tac ctxt = REPEAT_ALL_NEW (resolve_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\cont_intro\))) THEN_ALL_NEW (SOLVED' (simp_tac ctxt)) fun cont_intro_simproc ctxt ct = let fun mk_stmt t = t |> HOLogic.mk_Trueprop |> Thm.cterm_of ctxt |> Goal.init fun mk_thm t = case SINGLE (cont_intro_tac ctxt 1) (mk_stmt t) of SOME thm => SOME (Goal.finish ctxt thm RS @{thm Eq_TrueI}) | NONE => NONE in case Thm.term_of ct of t as Const (\<^const_name>\ccpo.admissible\, _) $ _ $ _ $ _ => mk_thm t | t as Const (\<^const_name>\mcont\, _) $ _ $ _ $ _ $ _ $ _ => mk_thm t | t as Const (\<^const_name>\monotone\, _) $ _ $ _ $ _ => mk_thm t | _ => NONE end handle THM _ => NONE | TYPE _ => NONE \ simproc_setup "cont_intro" ( "ccpo.admissible lub ord P" | "mcont lub ord lub' ord' f" | "monotone ord ord' f" ) = \K cont_intro_simproc\ lemmas [cont_intro] = call_mono let_mono if_mono option.const_mono tailrec.const_mono bind_mono declare if_mono[simp] lemma monotone_id' [cont_intro]: "monotone ord ord (\x. x)" by(simp add: monotone_def) lemma monotone_applyI: "monotone orda ordb F \ monotone (fun_ord orda) ordb (\f. F (f x))" by(rule monotoneI)(auto simp add: fun_ord_def dest: monotoneD) lemma monotone_if_fun [partial_function_mono]: "\ monotone (fun_ord orda) (fun_ord ordb) F; monotone (fun_ord orda) (fun_ord ordb) G \ \ monotone (fun_ord orda) (fun_ord ordb) (\f n. if c n then F f n else G f n)" by(simp add: monotone_def fun_ord_def) lemma monotone_fun_apply_fun [partial_function_mono]: "monotone (fun_ord (fun_ord ord)) (fun_ord ord) (\f n. f t (g n))" by(rule monotoneI)(simp add: fun_ord_def) lemma monotone_fun_ord_apply: "monotone orda (fun_ord ordb) f \ (\x. monotone orda ordb (\y. f y x))" by(auto simp add: monotone_def fun_ord_def) context preorder begin declare transp_le[cont_intro] lemma monotone_const [simp, cont_intro]: "monotone ord (\) (\_. c)" by(rule monotoneI) simp end lemma transp_le [cont_intro, simp]: "class.preorder ord (mk_less ord) \ transp ord" by(rule preorder.transp_le) context partial_function_definitions begin declare const_mono [cont_intro, simp] lemma transp_le [cont_intro, simp]: "transp leq" by(rule transpI)(rule leq_trans) lemma preorder [cont_intro, simp]: "class.preorder leq (mk_less leq)" by(unfold_locales)(auto simp add: mk_less_def intro: leq_refl leq_trans) declare ccpo[cont_intro, simp] end lemma contI [intro?]: "(\Y. \ Complete_Partial_Order.chain orda Y; Y \ {} \ \ f (luba Y) = lubb (f ` Y)) \ cont luba orda lubb ordb f" unfolding cont_def by blast lemma contD: "\ cont luba orda lubb ordb f; Complete_Partial_Order.chain orda Y; Y \ {} \ \ f (luba Y) = lubb (f ` Y)" unfolding cont_def by blast lemma cont_id [simp, cont_intro]: "\Sup. cont Sup ord Sup ord id" by(rule contI) simp lemma cont_id' [simp, cont_intro]: "\Sup. cont Sup ord Sup ord (\x. x)" using cont_id[unfolded id_def] . lemma cont_applyI [cont_intro]: assumes cont: "cont luba orda lubb ordb g" shows "cont (fun_lub luba) (fun_ord orda) lubb ordb (\f. g (f x))" by(rule contI)(drule chain_fun_ordD[where x=x], simp add: fun_lub_apply image_image contD[OF cont]) lemma call_cont: "cont (fun_lub lub) (fun_ord ord) lub ord (\f. f t)" by(simp add: cont_def fun_lub_apply) lemma cont_if [cont_intro]: "\ cont luba orda lubb ordb f; cont luba orda lubb ordb g \ \ cont luba orda lubb ordb (\x. if c then f x else g x)" by(cases c) simp_all lemma mcontI [intro?]: "\ monotone orda ordb f; cont luba orda lubb ordb f \ \ mcont luba orda lubb ordb f" by(simp add: mcont_def) lemma mcont_mono: "mcont luba orda lubb ordb f \ monotone orda ordb f" by(simp add: mcont_def) lemma mcont_cont [simp]: "mcont luba orda lubb ordb f \ cont luba orda lubb ordb f" by(simp add: mcont_def) lemma mcont_monoD: "\ mcont luba orda lubb ordb f; orda x y \ \ ordb (f x) (f y)" by(auto simp add: mcont_def dest: monotoneD) lemma mcont_contD: "\ mcont luba orda lubb ordb f; Complete_Partial_Order.chain orda Y; Y \ {} \ \ f (luba Y) = lubb (f ` Y)" by(auto simp add: mcont_def dest: contD) lemma mcont_call [cont_intro, simp]: "mcont (fun_lub lub) (fun_ord ord) lub ord (\f. f t)" by(simp add: mcont_def call_mono call_cont) lemma mcont_id' [cont_intro, simp]: "mcont lub ord lub ord (\x. x)" by(simp add: mcont_def monotone_id') lemma mcont_applyI: "mcont luba orda lubb ordb (\x. F x) \ mcont (fun_lub luba) (fun_ord orda) lubb ordb (\f. F (f x))" by(simp add: mcont_def monotone_applyI cont_applyI) lemma mcont_if [cont_intro, simp]: "\ mcont luba orda lubb ordb (\x. f x); mcont luba orda lubb ordb (\x. g x) \ \ mcont luba orda lubb ordb (\x. if c then f x else g x)" by(simp add: mcont_def cont_if) lemma cont_fun_lub_apply: "cont luba orda (fun_lub lubb) (fun_ord ordb) f \ (\x. cont luba orda lubb ordb (\y. f y x))" by(simp add: cont_def fun_lub_def fun_eq_iff)(auto simp add: image_def) lemma mcont_fun_lub_apply: "mcont luba orda (fun_lub lubb) (fun_ord ordb) f \ (\x. mcont luba orda lubb ordb (\y. f y x))" by(auto simp add: monotone_fun_ord_apply cont_fun_lub_apply mcont_def) context ccpo begin lemma cont_const [simp, cont_intro]: "cont luba orda Sup (\) (\x. c)" by (rule contI) (simp add: image_constant_conv cong del: SUP_cong_simp) lemma mcont_const [cont_intro, simp]: "mcont luba orda Sup (\) (\x. c)" by(simp add: mcont_def) lemma cont_apply: assumes 2: "\x. cont lubb ordb Sup (\) (\y. f x y)" and t: "cont luba orda lubb ordb (\x. t x)" and 1: "\y. cont luba orda Sup (\) (\x. f x y)" and mono: "monotone orda ordb (\x. t x)" and mono2: "\x. monotone ordb (\) (\y. f x y)" and mono1: "\y. monotone orda (\) (\x. f x y)" shows "cont luba orda Sup (\) (\x. f x (t x))" proof fix Y assume chain: "Complete_Partial_Order.chain orda Y" and "Y \ {}" moreover from chain have chain': "Complete_Partial_Order.chain ordb (t ` Y)" by(rule chain_imageI)(rule monotoneD[OF mono]) ultimately show "f (luba Y) (t (luba Y)) = \((\x. f x (t x)) ` Y)" by(simp add: contD[OF 1] contD[OF t] contD[OF 2] image_image) (rule diag_Sup[OF chain], auto intro: monotone2monotone[OF mono2 mono monotone_const transpI] monotoneD[OF mono1]) qed lemma mcont2mcont': "\ \x. mcont lub' ord' Sup (\) (\y. f x y); \y. mcont lub ord Sup (\) (\x. f x y); mcont lub ord lub' ord' (\y. t y) \ \ mcont lub ord Sup (\) (\x. f x (t x))" unfolding mcont_def by(blast intro: transp_le monotone2monotone cont_apply) lemma mcont2mcont: "\mcont lub' ord' Sup (\) (\x. f x); mcont lub ord lub' ord' (\x. t x)\ \ mcont lub ord Sup (\) (\x. f (t x))" by(rule mcont2mcont'[OF _ mcont_const]) context fixes ord :: "'b \ 'b \ bool" (infix "\" 60) and lub :: "'b set \ 'b" ("\") begin lemma cont_fun_lub_Sup: assumes chainM: "Complete_Partial_Order.chain (fun_ord (\)) M" and mcont [rule_format]: "\f\M. mcont lub (\) Sup (\) f" shows "cont lub (\) Sup (\) (fun_lub Sup M)" proof(rule contI) fix Y assume chain: "Complete_Partial_Order.chain (\) Y" and Y: "Y \ {}" from swap_Sup[OF chain chainM mcont[THEN mcont_mono]] show "fun_lub Sup M (\Y) = \(fun_lub Sup M ` Y)" by(simp add: mcont_contD[OF mcont chain Y] fun_lub_apply cong: image_cong) qed lemma mcont_fun_lub_Sup: "\ Complete_Partial_Order.chain (fun_ord (\)) M; \f\M. mcont lub ord Sup (\) f \ \ mcont lub (\) Sup (\) (fun_lub Sup M)" by(simp add: mcont_def cont_fun_lub_Sup mono_lub) lemma iterates_mcont: assumes f: "f \ ccpo.iterates (fun_lub Sup) (fun_ord (\)) F" and mono: "\f. mcont lub (\) Sup (\) f \ mcont lub (\) Sup (\) (F f)" shows "mcont lub (\) Sup (\) f" using f by(induction rule: ccpo.iterates.induct[OF ccpo_fun, consumes 1, case_names step Sup])(blast intro: mono mcont_fun_lub_Sup)+ lemma fixp_preserves_mcont: assumes mono: "\x. monotone (fun_ord (\)) (\) (\f. F f x)" and mcont: "\f. mcont lub (\) Sup (\) f \ mcont lub (\) Sup (\) (F f)" shows "mcont lub (\) Sup (\) (ccpo.fixp (fun_lub Sup) (fun_ord (\)) F)" (is "mcont _ _ _ _ ?fixp") unfolding mcont_def proof(intro conjI monotoneI contI) have mono: "monotone (fun_ord (\)) (fun_ord (\)) F" by(rule monotoneI)(auto simp add: fun_ord_def intro: monotoneD[OF mono]) let ?iter = "ccpo.iterates (fun_lub Sup) (fun_ord (\)) F" have chain: "\x. Complete_Partial_Order.chain (\) ((\f. f x) ` ?iter)" by(rule chain_imageI[OF ccpo.chain_iterates[OF ccpo_fun mono]])(simp add: fun_ord_def) { fix x y assume "x \ y" show "?fixp x \ ?fixp y" apply (simp only: ccpo.fixp_def[OF ccpo_fun] fun_lub_apply) using chain proof(rule ccpo_Sup_least) fix x' assume "x' \ (\f. f x) ` ?iter" then obtain f where "f \ ?iter" "x' = f x" by blast note this(2) also from _ \x \ y\ have "f x \ f y" by(rule mcont_monoD[OF iterates_mcont[OF \f \ ?iter\ mcont]]) also have "f y \ \((\f. f y) ` ?iter)" using chain by(rule ccpo_Sup_upper)(simp add: \f \ ?iter\) finally show "x' \ \" . qed next fix Y assume chain: "Complete_Partial_Order.chain (\) Y" and Y: "Y \ {}" { fix f assume "f \ ?iter" hence "f (\Y) = \(f ` Y)" using mcont chain Y by(rule mcont_contD[OF iterates_mcont]) } moreover have "\((\f. \(f ` Y)) ` ?iter) = \((\x. \((\f. f x) ` ?iter)) ` Y)" using chain ccpo.chain_iterates[OF ccpo_fun mono] by(rule swap_Sup)(rule mcont_mono[OF iterates_mcont[OF _ mcont]]) ultimately show "?fixp (\Y) = \(?fixp ` Y)" unfolding ccpo.fixp_def[OF ccpo_fun] by(simp add: fun_lub_apply cong: image_cong) } qed end context fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a" and C :: "('b \ 'a) \ 'c" and f assumes mono: "\x. monotone (fun_ord (\)) (\) (\f. U (F (C f)) x)" and eq: "f \ C (ccpo.fixp (fun_lub Sup) (fun_ord (\)) (\f. U (F (C f))))" and inverse: "\f. U (C f) = f" begin lemma fixp_preserves_mono_uc: assumes mono2: "\f. monotone ord (\) (U f) \ monotone ord (\) (U (F f))" shows "monotone ord (\) (U f)" using fixp_preserves_mono[OF mono mono2] by(subst eq)(simp add: inverse) lemma fixp_preserves_mcont_uc: assumes mcont: "\f. mcont lubb ordb Sup (\) (U f) \ mcont lubb ordb Sup (\) (U (F f))" shows "mcont lubb ordb Sup (\) (U f)" using fixp_preserves_mcont[OF mono mcont] by(subst eq)(simp add: inverse) end lemmas fixp_preserves_mono1 = fixp_preserves_mono_uc[of "\x. x" _ "\x. x", OF _ _ refl] lemmas fixp_preserves_mono2 = fixp_preserves_mono_uc[of "case_prod" _ "curry", unfolded case_prod_curry curry_case_prod, OF _ _ refl] lemmas fixp_preserves_mono3 = fixp_preserves_mono_uc[of "\f. case_prod (case_prod f)" _ "\f. curry (curry f)", unfolded case_prod_curry curry_case_prod, OF _ _ refl] lemmas fixp_preserves_mono4 = fixp_preserves_mono_uc[of "\f. case_prod (case_prod (case_prod f))" _ "\f. curry (curry (curry f))", unfolded case_prod_curry curry_case_prod, OF _ _ refl] lemmas fixp_preserves_mcont1 = fixp_preserves_mcont_uc[of "\x. x" _ "\x. x", OF _ _ refl] lemmas fixp_preserves_mcont2 = fixp_preserves_mcont_uc[of "case_prod" _ "curry", unfolded case_prod_curry curry_case_prod, OF _ _ refl] lemmas fixp_preserves_mcont3 = fixp_preserves_mcont_uc[of "\f. case_prod (case_prod f)" _ "\f. curry (curry f)", unfolded case_prod_curry curry_case_prod, OF _ _ refl] lemmas fixp_preserves_mcont4 = fixp_preserves_mcont_uc[of "\f. case_prod (case_prod (case_prod f))" _ "\f. curry (curry (curry f))", unfolded case_prod_curry curry_case_prod, OF _ _ refl] end lemma (in preorder) monotone_if_bot: fixes bot assumes mono: "\x y. \ x \ y; \ (x \ bound) \ \ ord (f x) (f y)" and bot: "\x. \ x \ bound \ ord bot (f x)" "ord bot bot" shows "monotone (\) ord (\x. if x \ bound then bot else f x)" by(rule monotoneI)(auto intro: bot intro: mono order_trans) lemma (in ccpo) mcont_if_bot: fixes bot and lub ("\") and ord (infix "\" 60) assumes ccpo: "class.ccpo lub (\) lt" and mono: "\x y. \ x \ y; \ x \ bound \ \ f x \ f y" and cont: "\Y. \ Complete_Partial_Order.chain (\) Y; Y \ {}; \x. x \ Y \ \ x \ bound \ \ f (\Y) = \(f ` Y)" and bot: "\x. \ x \ bound \ bot \ f x" shows "mcont Sup (\) lub (\) (\x. if x \ bound then bot else f x)" (is "mcont _ _ _ _ ?g") proof(intro mcontI contI) interpret c: ccpo lub "(\)" lt by(fact ccpo) show "monotone (\) (\) ?g" by(rule monotone_if_bot)(simp_all add: mono bot) fix Y assume chain: "Complete_Partial_Order.chain (\) Y" and Y: "Y \ {}" show "?g (\Y) = \(?g ` Y)" proof(cases "Y \ {x. x \ bound}") case True hence "\Y \ bound" using chain by(auto intro: ccpo_Sup_least) moreover have "Y \ {x. \ x \ bound} = {}" using True by auto ultimately show ?thesis using True Y by (auto simp add: image_constant_conv cong del: c.SUP_cong_simp) next case False let ?Y = "Y \ {x. \ x \ bound}" have chain': "Complete_Partial_Order.chain (\) ?Y" using chain by(rule chain_subset) simp from False obtain y where ybound: "\ y \ bound" and y: "y \ Y" by blast hence "\ \Y \ bound" by (metis ccpo_Sup_upper chain order.trans) hence "?g (\Y) = f (\Y)" by simp also have "\Y \ \?Y" using chain proof(rule ccpo_Sup_least) fix x assume x: "x \ Y" show "x \ \?Y" proof(cases "x \ bound") case True with chainD[OF chain x y] have "x \ y" using ybound by(auto intro: order_trans) thus ?thesis by(rule order_trans)(auto intro: ccpo_Sup_upper[OF chain'] simp add: y ybound) qed(auto intro: ccpo_Sup_upper[OF chain'] simp add: x) qed - hence "\Y = \?Y" by(rule antisym)(blast intro: ccpo_Sup_least[OF chain'] ccpo_Sup_upper[OF chain]) + hence "\Y = \?Y" by(rule order.antisym)(blast intro: ccpo_Sup_least[OF chain'] ccpo_Sup_upper[OF chain]) hence "f (\Y) = f (\?Y)" by simp also have "f (\?Y) = \(f ` ?Y)" using chain' by(rule cont)(insert y ybound, auto) also have "\(f ` ?Y) = \(?g ` Y)" proof(cases "Y \ {x. x \ bound} = {}") case True hence "f ` ?Y = ?g ` Y" by auto thus ?thesis by(rule arg_cong) next case False have chain'': "Complete_Partial_Order.chain (\) (insert bot (f ` ?Y))" using chain by(auto intro!: chainI bot dest: chainD intro: mono) hence chain''': "Complete_Partial_Order.chain (\) (f ` ?Y)" by(rule chain_subset) blast have "bot \ \(f ` ?Y)" using y ybound by(blast intro: c.order_trans[OF bot] c.ccpo_Sup_upper[OF chain''']) hence "\(insert bot (f ` ?Y)) \ \(f ` ?Y)" using chain'' by(auto intro: c.ccpo_Sup_least c.ccpo_Sup_upper[OF chain''']) with _ have "\ = \(insert bot (f ` ?Y))" - by(rule c.antisym)(blast intro: c.ccpo_Sup_least[OF chain'''] c.ccpo_Sup_upper[OF chain'']) + by(rule c.order.antisym)(blast intro: c.ccpo_Sup_least[OF chain'''] c.ccpo_Sup_upper[OF chain'']) also have "insert bot (f ` ?Y) = ?g ` Y" using False by auto finally show ?thesis . qed finally show ?thesis . qed qed context partial_function_definitions begin lemma mcont_const [cont_intro, simp]: "mcont luba orda lub leq (\x. c)" by(rule ccpo.mcont_const)(rule Partial_Function.ccpo[OF partial_function_definitions_axioms]) lemmas [cont_intro, simp] = ccpo.cont_const[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemma mono2mono: assumes "monotone ordb leq (\y. f y)" "monotone orda ordb (\x. t x)" shows "monotone orda leq (\x. f (t x))" using assms by(rule monotone2monotone) simp_all lemmas mcont2mcont' = ccpo.mcont2mcont'[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas mcont2mcont = ccpo.mcont2mcont[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mono1 = ccpo.fixp_preserves_mono1[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mono2 = ccpo.fixp_preserves_mono2[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mono3 = ccpo.fixp_preserves_mono3[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mono4 = ccpo.fixp_preserves_mono4[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mcont1 = ccpo.fixp_preserves_mcont1[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mcont2 = ccpo.fixp_preserves_mcont2[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mcont3 = ccpo.fixp_preserves_mcont3[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemmas fixp_preserves_mcont4 = ccpo.fixp_preserves_mcont4[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] lemma monotone_if_bot: fixes bot assumes g: "\x. g x = (if leq x bound then bot else f x)" and mono: "\x y. \ leq x y; \ leq x bound \ \ ord (f x) (f y)" and bot: "\x. \ leq x bound \ ord bot (f x)" "ord bot bot" shows "monotone leq ord g" unfolding g[abs_def] using preorder mono bot by(rule preorder.monotone_if_bot) lemma mcont_if_bot: fixes bot assumes ccpo: "class.ccpo lub' ord (mk_less ord)" and bot: "\x. \ leq x bound \ ord bot (f x)" and g: "\x. g x = (if leq x bound then bot else f x)" and mono: "\x y. \ leq x y; \ leq x bound \ \ ord (f x) (f y)" and cont: "\Y. \ Complete_Partial_Order.chain leq Y; Y \ {}; \x. x \ Y \ \ leq x bound \ \ f (lub Y) = lub' (f ` Y)" shows "mcont lub leq lub' ord g" unfolding g[abs_def] using ccpo mono cont bot by(rule ccpo.mcont_if_bot[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]]) end subsection \Admissibility\ lemma admissible_subst: assumes adm: "ccpo.admissible luba orda (\x. P x)" and mcont: "mcont lubb ordb luba orda f" shows "ccpo.admissible lubb ordb (\x. P (f x))" apply(rule ccpo.admissibleI) apply(frule (1) mcont_contD[OF mcont]) apply(auto intro: ccpo.admissibleD[OF adm] chain_imageI dest: mcont_monoD[OF mcont]) done lemmas [simp, cont_intro] = admissible_all admissible_ball admissible_const admissible_conj lemma admissible_disj' [simp, cont_intro]: "\ class.ccpo lub ord (mk_less ord); ccpo.admissible lub ord P; ccpo.admissible lub ord Q \ \ ccpo.admissible lub ord (\x. P x \ Q x)" by(rule ccpo.admissible_disj) lemma admissible_imp' [cont_intro]: "\ class.ccpo lub ord (mk_less ord); ccpo.admissible lub ord (\x. \ P x); ccpo.admissible lub ord (\x. Q x) \ \ ccpo.admissible lub ord (\x. P x \ Q x)" unfolding imp_conv_disj by(rule ccpo.admissible_disj) lemma admissible_imp [cont_intro]: "(Q \ ccpo.admissible lub ord (\x. P x)) \ ccpo.admissible lub ord (\x. Q \ P x)" by(rule ccpo.admissibleI)(auto dest: ccpo.admissibleD) lemma admissible_not_mem' [THEN admissible_subst, cont_intro, simp]: shows admissible_not_mem: "ccpo.admissible Union (\) (\A. x \ A)" by(rule ccpo.admissibleI) auto lemma admissible_eqI: assumes f: "cont luba orda lub ord (\x. f x)" and g: "cont luba orda lub ord (\x. g x)" shows "ccpo.admissible luba orda (\x. f x = g x)" apply(rule ccpo.admissibleI) apply(simp_all add: contD[OF f] contD[OF g] cong: image_cong) done corollary admissible_eq_mcontI [cont_intro]: "\ mcont luba orda lub ord (\x. f x); mcont luba orda lub ord (\x. g x) \ \ ccpo.admissible luba orda (\x. f x = g x)" by(rule admissible_eqI)(auto simp add: mcont_def) lemma admissible_iff [cont_intro, simp]: "\ ccpo.admissible lub ord (\x. P x \ Q x); ccpo.admissible lub ord (\x. Q x \ P x) \ \ ccpo.admissible lub ord (\x. P x \ Q x)" by(subst iff_conv_conj_imp)(rule admissible_conj) context ccpo begin lemma admissible_leI: assumes f: "mcont luba orda Sup (\) (\x. f x)" and g: "mcont luba orda Sup (\) (\x. g x)" shows "ccpo.admissible luba orda (\x. f x \ g x)" proof(rule ccpo.admissibleI) fix A assume chain: "Complete_Partial_Order.chain orda A" and le: "\x\A. f x \ g x" and False: "A \ {}" have "f (luba A) = \(f ` A)" by(simp add: mcont_contD[OF f] chain False) also have "\ \ \(g ` A)" proof(rule ccpo_Sup_least) from chain show "Complete_Partial_Order.chain (\) (f ` A)" by(rule chain_imageI)(rule mcont_monoD[OF f]) fix x assume "x \ f ` A" then obtain y where "y \ A" "x = f y" by blast note this(2) also have "f y \ g y" using le \y \ A\ by simp also have "Complete_Partial_Order.chain (\) (g ` A)" using chain by(rule chain_imageI)(rule mcont_monoD[OF g]) hence "g y \ \(g ` A)" by(rule ccpo_Sup_upper)(simp add: \y \ A\) finally show "x \ \" . qed also have "\ = g (luba A)" by(simp add: mcont_contD[OF g] chain False) finally show "f (luba A) \ g (luba A)" . qed end lemma admissible_leI: fixes ord (infix "\" 60) and lub ("\") assumes "class.ccpo lub (\) (mk_less (\))" and "mcont luba orda lub (\) (\x. f x)" and "mcont luba orda lub (\) (\x. g x)" shows "ccpo.admissible luba orda (\x. f x \ g x)" using assms by(rule ccpo.admissible_leI) declare ccpo_class.admissible_leI[cont_intro] context ccpo begin lemma admissible_not_below: "ccpo.admissible Sup (\) (\x. \ (\) x y)" by(rule ccpo.admissibleI)(simp add: ccpo_Sup_below_iff) end lemma (in preorder) preorder [cont_intro, simp]: "class.preorder (\) (mk_less (\))" by(unfold_locales)(auto simp add: mk_less_def intro: order_trans) context partial_function_definitions begin lemmas [cont_intro, simp] = admissible_leI[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] ccpo.admissible_not_below[THEN admissible_subst, OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] end setup \Sign.map_naming (Name_Space.mandatory_path "ccpo")\ inductive compact :: "('a set \ 'a) \ ('a \ 'a \ bool) \ 'a \ bool" for lub ord x where compact: "\ ccpo.admissible lub ord (\y. \ ord x y); ccpo.admissible lub ord (\y. x \ y) \ \ compact lub ord x" setup \Sign.map_naming Name_Space.parent_path\ context ccpo begin lemma compactI: assumes "ccpo.admissible Sup (\) (\y. \ x \ y)" shows "ccpo.compact Sup (\) x" using assms proof(rule ccpo.compact.intros) have neq: "(\y. x \ y) = (\y. \ x \ y \ \ y \ x)" by(auto) show "ccpo.admissible Sup (\) (\y. x \ y)" by(subst neq)(rule admissible_disj admissible_not_below assms)+ qed lemma compact_bot: assumes "x = Sup {}" shows "ccpo.compact Sup (\) x" proof(rule compactI) show "ccpo.admissible Sup (\) (\y. \ x \ y)" using assms by(auto intro!: ccpo.admissibleI intro: ccpo_Sup_least chain_empty) qed end lemma admissible_compact_neq' [THEN admissible_subst, cont_intro, simp]: shows admissible_compact_neq: "ccpo.compact lub ord k \ ccpo.admissible lub ord (\x. k \ x)" by(simp add: ccpo.compact.simps) lemma admissible_neq_compact' [THEN admissible_subst, cont_intro, simp]: shows admissible_neq_compact: "ccpo.compact lub ord k \ ccpo.admissible lub ord (\x. x \ k)" by(subst eq_commute)(rule admissible_compact_neq) context partial_function_definitions begin lemmas [cont_intro, simp] = ccpo.compact_bot[OF Partial_Function.ccpo[OF partial_function_definitions_axioms]] end context ccpo begin lemma fixp_strong_induct: assumes [cont_intro]: "ccpo.admissible Sup (\) P" and mono: "monotone (\) (\) f" and bot: "P (\{})" and step: "\x. \ x \ ccpo_class.fixp f; P x \ \ P (f x)" shows "P (ccpo_class.fixp f)" proof(rule fixp_induct[where P="\x. x \ ccpo_class.fixp f \ P x", THEN conjunct2]) note [cont_intro] = admissible_leI show "ccpo.admissible Sup (\) (\x. x \ ccpo_class.fixp f \ P x)" by simp next show "\{} \ ccpo_class.fixp f \ P (\{})" by(auto simp add: bot intro: ccpo_Sup_least chain_empty) next fix x assume "x \ ccpo_class.fixp f \ P x" thus "f x \ ccpo_class.fixp f \ P (f x)" by(subst fixp_unfold[OF mono])(auto dest: monotoneD[OF mono] intro: step) qed(rule mono) end context partial_function_definitions begin lemma fixp_strong_induct_uc: fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a" and C :: "('b \ 'a) \ 'c" and P :: "('b \ 'a) \ bool" assumes mono: "\x. mono_body (\f. U (F (C f)) x)" and eq: "f \ C (fixp_fun (\f. U (F (C f))))" and inverse: "\f. U (C f) = f" and adm: "ccpo.admissible lub_fun le_fun P" and bot: "P (\_. lub {})" and step: "\f'. \ P (U f'); le_fun (U f') (U f) \ \ P (U (F f'))" shows "P (U f)" unfolding eq inverse apply (rule ccpo.fixp_strong_induct[OF ccpo adm]) apply (insert mono, auto simp: monotone_def fun_ord_def bot fun_lub_def)[2] apply (rule_tac f'5="C x" in step) apply (simp_all add: inverse eq) done end subsection \\<^term>\(=)\ as order\ definition lub_singleton :: "('a set \ 'a) \ bool" where "lub_singleton lub \ (\a. lub {a} = a)" definition the_Sup :: "'a set \ 'a" where "the_Sup A = (THE a. a \ A)" lemma lub_singleton_the_Sup [cont_intro, simp]: "lub_singleton the_Sup" by(simp add: lub_singleton_def the_Sup_def) lemma (in ccpo) lub_singleton: "lub_singleton Sup" by(simp add: lub_singleton_def) lemma (in partial_function_definitions) lub_singleton [cont_intro, simp]: "lub_singleton lub" by(rule ccpo.lub_singleton)(rule Partial_Function.ccpo[OF partial_function_definitions_axioms]) lemma preorder_eq [cont_intro, simp]: "class.preorder (=) (mk_less (=))" by(unfold_locales)(simp_all add: mk_less_def) lemma monotone_eqI [cont_intro]: assumes "class.preorder ord (mk_less ord)" shows "monotone (=) ord f" proof - interpret preorder ord "mk_less ord" by fact show ?thesis by(simp add: monotone_def) qed lemma cont_eqI [cont_intro]: fixes f :: "'a \ 'b" assumes "lub_singleton lub" shows "cont the_Sup (=) lub ord f" proof(rule contI) fix Y :: "'a set" assume "Complete_Partial_Order.chain (=) Y" "Y \ {}" then obtain a where "Y = {a}" by(auto simp add: chain_def) thus "f (the_Sup Y) = lub (f ` Y)" using assms by(simp add: the_Sup_def lub_singleton_def) qed lemma mcont_eqI [cont_intro, simp]: "\ class.preorder ord (mk_less ord); lub_singleton lub \ \ mcont the_Sup (=) lub ord f" by(simp add: mcont_def cont_eqI monotone_eqI) subsection \ccpo for products\ definition prod_lub :: "('a set \ 'a) \ ('b set \ 'b) \ ('a \ 'b) set \ 'a \ 'b" where "prod_lub Sup_a Sup_b Y = (Sup_a (fst ` Y), Sup_b (snd ` Y))" lemma lub_singleton_prod_lub [cont_intro, simp]: "\ lub_singleton luba; lub_singleton lubb \ \ lub_singleton (prod_lub luba lubb)" by(simp add: lub_singleton_def prod_lub_def) lemma prod_lub_empty [simp]: "prod_lub luba lubb {} = (luba {}, lubb {})" by(simp add: prod_lub_def) lemma preorder_rel_prodI [cont_intro, simp]: assumes "class.preorder orda (mk_less orda)" and "class.preorder ordb (mk_less ordb)" shows "class.preorder (rel_prod orda ordb) (mk_less (rel_prod orda ordb))" proof - interpret a: preorder orda "mk_less orda" by fact interpret b: preorder ordb "mk_less ordb" by fact show ?thesis by(unfold_locales)(auto simp add: mk_less_def intro: a.order_trans b.order_trans) qed lemma order_rel_prodI: assumes a: "class.order orda (mk_less orda)" and b: "class.order ordb (mk_less ordb)" shows "class.order (rel_prod orda ordb) (mk_less (rel_prod orda ordb))" (is "class.order ?ord ?ord'") proof(intro class.order.intro class.order_axioms.intro) interpret a: order orda "mk_less orda" by(fact a) interpret b: order ordb "mk_less ordb" by(fact b) show "class.preorder ?ord ?ord'" by(rule preorder_rel_prodI) unfold_locales fix x y assume "?ord x y" "?ord y x" thus "x = y" by(cases x y rule: prod.exhaust[case_product prod.exhaust]) auto qed lemma monotone_rel_prodI: assumes mono2: "\a. monotone ordb ordc (\b. f (a, b))" and mono1: "\b. monotone orda ordc (\a. f (a, b))" and a: "class.preorder orda (mk_less orda)" and b: "class.preorder ordb (mk_less ordb)" and c: "class.preorder ordc (mk_less ordc)" shows "monotone (rel_prod orda ordb) ordc f" proof - interpret a: preorder orda "mk_less orda" by(rule a) interpret b: preorder ordb "mk_less ordb" by(rule b) interpret c: preorder ordc "mk_less ordc" by(rule c) show ?thesis using mono2 mono1 by(auto 7 2 simp add: monotone_def intro: c.order_trans) qed lemma monotone_rel_prodD1: assumes mono: "monotone (rel_prod orda ordb) ordc f" and preorder: "class.preorder ordb (mk_less ordb)" shows "monotone orda ordc (\a. f (a, b))" proof - interpret preorder ordb "mk_less ordb" by(rule preorder) show ?thesis using mono by(simp add: monotone_def) qed lemma monotone_rel_prodD2: assumes mono: "monotone (rel_prod orda ordb) ordc f" and preorder: "class.preorder orda (mk_less orda)" shows "monotone ordb ordc (\b. f (a, b))" proof - interpret preorder orda "mk_less orda" by(rule preorder) show ?thesis using mono by(simp add: monotone_def) qed lemma monotone_case_prodI: "\ \a. monotone ordb ordc (f a); \b. monotone orda ordc (\a. f a b); class.preorder orda (mk_less orda); class.preorder ordb (mk_less ordb); class.preorder ordc (mk_less ordc) \ \ monotone (rel_prod orda ordb) ordc (case_prod f)" by(rule monotone_rel_prodI) simp_all lemma monotone_case_prodD1: assumes mono: "monotone (rel_prod orda ordb) ordc (case_prod f)" and preorder: "class.preorder ordb (mk_less ordb)" shows "monotone orda ordc (\a. f a b)" using monotone_rel_prodD1[OF assms] by simp lemma monotone_case_prodD2: assumes mono: "monotone (rel_prod orda ordb) ordc (case_prod f)" and preorder: "class.preorder orda (mk_less orda)" shows "monotone ordb ordc (f a)" using monotone_rel_prodD2[OF assms] by simp context fixes orda ordb ordc assumes a: "class.preorder orda (mk_less orda)" and b: "class.preorder ordb (mk_less ordb)" and c: "class.preorder ordc (mk_less ordc)" begin lemma monotone_rel_prod_iff: "monotone (rel_prod orda ordb) ordc f \ (\a. monotone ordb ordc (\b. f (a, b))) \ (\b. monotone orda ordc (\a. f (a, b)))" using a b c by(blast intro: monotone_rel_prodI dest: monotone_rel_prodD1 monotone_rel_prodD2) lemma monotone_case_prod_iff [simp]: "monotone (rel_prod orda ordb) ordc (case_prod f) \ (\a. monotone ordb ordc (f a)) \ (\b. monotone orda ordc (\a. f a b))" by(simp add: monotone_rel_prod_iff) end lemma monotone_case_prod_apply_iff: "monotone orda ordb (\x. (case_prod f x) y) \ monotone orda ordb (case_prod (\a b. f a b y))" by(simp add: monotone_def) lemma monotone_case_prod_applyD: "monotone orda ordb (\x. (case_prod f x) y) \ monotone orda ordb (case_prod (\a b. f a b y))" by(simp add: monotone_case_prod_apply_iff) lemma monotone_case_prod_applyI: "monotone orda ordb (case_prod (\a b. f a b y)) \ monotone orda ordb (\x. (case_prod f x) y)" by(simp add: monotone_case_prod_apply_iff) lemma cont_case_prod_apply_iff: "cont luba orda lubb ordb (\x. (case_prod f x) y) \ cont luba orda lubb ordb (case_prod (\a b. f a b y))" by(simp add: cont_def split_def) lemma cont_case_prod_applyI: "cont luba orda lubb ordb (case_prod (\a b. f a b y)) \ cont luba orda lubb ordb (\x. (case_prod f x) y)" by(simp add: cont_case_prod_apply_iff) lemma cont_case_prod_applyD: "cont luba orda lubb ordb (\x. (case_prod f x) y) \ cont luba orda lubb ordb (case_prod (\a b. f a b y))" by(simp add: cont_case_prod_apply_iff) lemma mcont_case_prod_apply_iff [simp]: "mcont luba orda lubb ordb (\x. (case_prod f x) y) \ mcont luba orda lubb ordb (case_prod (\a b. f a b y))" by(simp add: mcont_def monotone_case_prod_apply_iff cont_case_prod_apply_iff) lemma cont_prodD1: assumes cont: "cont (prod_lub luba lubb) (rel_prod orda ordb) lubc ordc f" and "class.preorder orda (mk_less orda)" and luba: "lub_singleton luba" shows "cont lubb ordb lubc ordc (\y. f (x, y))" proof(rule contI) interpret preorder orda "mk_less orda" by fact fix Y :: "'b set" let ?Y = "{x} \ Y" assume "Complete_Partial_Order.chain ordb Y" "Y \ {}" hence "Complete_Partial_Order.chain (rel_prod orda ordb) ?Y" "?Y \ {}" by(simp_all add: chain_def) with cont have "f (prod_lub luba lubb ?Y) = lubc (f ` ?Y)" by(rule contD) moreover have "f ` ?Y = (\y. f (x, y)) ` Y" by auto ultimately show "f (x, lubb Y) = lubc ((\y. f (x, y)) ` Y)" using luba by(simp add: prod_lub_def \Y \ {}\ lub_singleton_def) qed lemma cont_prodD2: assumes cont: "cont (prod_lub luba lubb) (rel_prod orda ordb) lubc ordc f" and "class.preorder ordb (mk_less ordb)" and lubb: "lub_singleton lubb" shows "cont luba orda lubc ordc (\x. f (x, y))" proof(rule contI) interpret preorder ordb "mk_less ordb" by fact fix Y assume Y: "Complete_Partial_Order.chain orda Y" "Y \ {}" let ?Y = "Y \ {y}" have "f (luba Y, y) = f (prod_lub luba lubb ?Y)" using lubb by(simp add: prod_lub_def Y lub_singleton_def) also from Y have "Complete_Partial_Order.chain (rel_prod orda ordb) ?Y" "?Y \ {}" by(simp_all add: chain_def) with cont have "f (prod_lub luba lubb ?Y) = lubc (f ` ?Y)" by(rule contD) also have "f ` ?Y = (\x. f (x, y)) ` Y" by auto finally show "f (luba Y, y) = lubc \" . qed lemma cont_case_prodD1: assumes "cont (prod_lub luba lubb) (rel_prod orda ordb) lubc ordc (case_prod f)" and "class.preorder orda (mk_less orda)" and "lub_singleton luba" shows "cont lubb ordb lubc ordc (f x)" using cont_prodD1[OF assms] by simp lemma cont_case_prodD2: assumes "cont (prod_lub luba lubb) (rel_prod orda ordb) lubc ordc (case_prod f)" and "class.preorder ordb (mk_less ordb)" and "lub_singleton lubb" shows "cont luba orda lubc ordc (\x. f x y)" using cont_prodD2[OF assms] by simp context ccpo begin lemma cont_prodI: assumes mono: "monotone (rel_prod orda ordb) (\) f" and cont1: "\x. cont lubb ordb Sup (\) (\y. f (x, y))" and cont2: "\y. cont luba orda Sup (\) (\x. f (x, y))" and "class.preorder orda (mk_less orda)" and "class.preorder ordb (mk_less ordb)" shows "cont (prod_lub luba lubb) (rel_prod orda ordb) Sup (\) f" proof(rule contI) interpret a: preorder orda "mk_less orda" by fact interpret b: preorder ordb "mk_less ordb" by fact fix Y assume chain: "Complete_Partial_Order.chain (rel_prod orda ordb) Y" and "Y \ {}" have "f (prod_lub luba lubb Y) = f (luba (fst ` Y), lubb (snd ` Y))" by(simp add: prod_lub_def) also from cont2 have "f (luba (fst ` Y), lubb (snd ` Y)) = \((\x. f (x, lubb (snd ` Y))) ` fst ` Y)" by(rule contD)(simp_all add: chain_rel_prodD1[OF chain] \Y \ {}\) also from cont1 have "\x. f (x, lubb (snd ` Y)) = \((\y. f (x, y)) ` snd ` Y)" by(rule contD)(simp_all add: chain_rel_prodD2[OF chain] \Y \ {}\) hence "\((\x. f (x, lubb (snd ` Y))) ` fst ` Y) = \((\x. \ x) ` fst ` Y)" by simp also have "\ = \((\x. f (fst x, snd x)) ` Y)" unfolding image_image split_def using chain apply(rule diag_Sup) using monotoneD[OF mono] by(auto intro: monotoneI) finally show "f (prod_lub luba lubb Y) = \(f ` Y)" by simp qed lemma cont_case_prodI: assumes "monotone (rel_prod orda ordb) (\) (case_prod f)" and "\x. cont lubb ordb Sup (\) (\y. f x y)" and "\y. cont luba orda Sup (\) (\x. f x y)" and "class.preorder orda (mk_less orda)" and "class.preorder ordb (mk_less ordb)" shows "cont (prod_lub luba lubb) (rel_prod orda ordb) Sup (\) (case_prod f)" by(rule cont_prodI)(simp_all add: assms) lemma cont_case_prod_iff: "\ monotone (rel_prod orda ordb) (\) (case_prod f); class.preorder orda (mk_less orda); lub_singleton luba; class.preorder ordb (mk_less ordb); lub_singleton lubb \ \ cont (prod_lub luba lubb) (rel_prod orda ordb) Sup (\) (case_prod f) \ (\x. cont lubb ordb Sup (\) (\y. f x y)) \ (\y. cont luba orda Sup (\) (\x. f x y))" by(blast dest: cont_case_prodD1 cont_case_prodD2 intro: cont_case_prodI) end context partial_function_definitions begin lemma mono2mono2: assumes f: "monotone (rel_prod ordb ordc) leq (\(x, y). f x y)" and t: "monotone orda ordb (\x. t x)" and t': "monotone orda ordc (\x. t' x)" shows "monotone orda leq (\x. f (t x) (t' x))" proof(rule monotoneI) fix x y assume "orda x y" hence "rel_prod ordb ordc (t x, t' x) (t y, t' y)" using t t' by(auto dest: monotoneD) from monotoneD[OF f this] show "leq (f (t x) (t' x)) (f (t y) (t' y))" by simp qed lemma cont_case_prodI [cont_intro]: "\ monotone (rel_prod orda ordb) leq (case_prod f); \x. cont lubb ordb lub leq (\y. f x y); \y. cont luba orda lub leq (\x. f x y); class.preorder orda (mk_less orda); class.preorder ordb (mk_less ordb) \ \ cont (prod_lub luba lubb) (rel_prod orda ordb) lub leq (case_prod f)" by(rule ccpo.cont_case_prodI)(rule Partial_Function.ccpo[OF partial_function_definitions_axioms]) lemma cont_case_prod_iff: "\ monotone (rel_prod orda ordb) leq (case_prod f); class.preorder orda (mk_less orda); lub_singleton luba; class.preorder ordb (mk_less ordb); lub_singleton lubb \ \ cont (prod_lub luba lubb) (rel_prod orda ordb) lub leq (case_prod f) \ (\x. cont lubb ordb lub leq (\y. f x y)) \ (\y. cont luba orda lub leq (\x. f x y))" by(blast dest: cont_case_prodD1 cont_case_prodD2 intro: cont_case_prodI) lemma mcont_case_prod_iff [simp]: "\ class.preorder orda (mk_less orda); lub_singleton luba; class.preorder ordb (mk_less ordb); lub_singleton lubb \ \ mcont (prod_lub luba lubb) (rel_prod orda ordb) lub leq (case_prod f) \ (\x. mcont lubb ordb lub leq (\y. f x y)) \ (\y. mcont luba orda lub leq (\x. f x y))" unfolding mcont_def by(auto simp add: cont_case_prod_iff) end lemma mono2mono_case_prod [cont_intro]: assumes "\x y. monotone orda ordb (\f. pair f x y)" shows "monotone orda ordb (\f. case_prod (pair f) x)" by(rule monotoneI)(auto split: prod.split dest: monotoneD[OF assms]) subsection \Complete lattices as ccpo\ context complete_lattice begin lemma complete_lattice_ccpo: "class.ccpo Sup (\) (<)" by(unfold_locales)(fast intro: Sup_upper Sup_least)+ lemma complete_lattice_ccpo': "class.ccpo Sup (\) (mk_less (\))" by(unfold_locales)(auto simp add: mk_less_def intro: Sup_upper Sup_least) lemma complete_lattice_partial_function_definitions: "partial_function_definitions (\) Sup" by(unfold_locales)(auto intro: Sup_least Sup_upper) lemma complete_lattice_partial_function_definitions_dual: "partial_function_definitions (\) Inf" by(unfold_locales)(auto intro: Inf_lower Inf_greatest) lemmas [cont_intro, simp] = Partial_Function.ccpo[OF complete_lattice_partial_function_definitions] Partial_Function.ccpo[OF complete_lattice_partial_function_definitions_dual] lemma mono2mono_inf: assumes f: "monotone ord (\) (\x. f x)" and g: "monotone ord (\) (\x. g x)" shows "monotone ord (\) (\x. f x \ g x)" by(auto 4 3 dest: monotoneD[OF f] monotoneD[OF g] intro: le_infI1 le_infI2 intro!: monotoneI) lemma mcont_const [simp]: "mcont lub ord Sup (\) (\_. c)" by(rule ccpo.mcont_const[OF complete_lattice_ccpo]) lemma mono2mono_sup: assumes f: "monotone ord (\) (\x. f x)" and g: "monotone ord (\) (\x. g x)" shows "monotone ord (\) (\x. f x \ g x)" by(auto 4 3 intro!: monotoneI intro: sup.coboundedI1 sup.coboundedI2 dest: monotoneD[OF f] monotoneD[OF g]) lemma Sup_image_sup: assumes "Y \ {}" shows "\((\) x ` Y) = x \ \Y" proof(rule Sup_eqI) fix y assume "y \ (\) x ` Y" then obtain z where "y = x \ z" and "z \ Y" by blast from \z \ Y\ have "z \ \Y" by(rule Sup_upper) with _ show "y \ x \ \Y" unfolding \y = x \ z\ by(rule sup_mono) simp next fix y assume upper: "\z. z \ (\) x ` Y \ z \ y" show "x \ \Y \ y" unfolding Sup_insert[symmetric] proof(rule Sup_least) fix z assume "z \ insert x Y" from assms obtain z' where "z' \ Y" by blast let ?z = "if z \ Y then x \ z else x \ z'" have "z \ x \ ?z" using \z' \ Y\ \z \ insert x Y\ by auto also have "\ \ y" by(rule upper)(auto split: if_split_asm intro: \z' \ Y\) finally show "z \ y" . qed qed lemma mcont_sup1: "mcont Sup (\) Sup (\) (\y. x \ y)" by(auto 4 3 simp add: mcont_def sup.coboundedI1 sup.coboundedI2 intro!: monotoneI contI intro: Sup_image_sup[symmetric]) lemma mcont_sup2: "mcont Sup (\) Sup (\) (\x. x \ y)" by(subst sup_commute)(rule mcont_sup1) lemma mcont2mcont_sup [cont_intro, simp]: "\ mcont lub ord Sup (\) (\x. f x); mcont lub ord Sup (\) (\x. g x) \ \ mcont lub ord Sup (\) (\x. f x \ g x)" by(best intro: ccpo.mcont2mcont'[OF complete_lattice_ccpo] mcont_sup1 mcont_sup2 ccpo.mcont_const[OF complete_lattice_ccpo]) end lemmas [cont_intro] = admissible_leI[OF complete_lattice_ccpo'] context complete_distrib_lattice begin lemma mcont_inf1: "mcont Sup (\) Sup (\) (\y. x \ y)" by(auto intro: monotoneI contI simp add: le_infI2 inf_Sup mcont_def) lemma mcont_inf2: "mcont Sup (\) Sup (\) (\x. x \ y)" by(auto intro: monotoneI contI simp add: le_infI1 Sup_inf mcont_def) lemma mcont2mcont_inf [cont_intro, simp]: "\ mcont lub ord Sup (\) (\x. f x); mcont lub ord Sup (\) (\x. g x) \ \ mcont lub ord Sup (\) (\x. f x \ g x)" by(best intro: ccpo.mcont2mcont'[OF complete_lattice_ccpo] mcont_inf1 mcont_inf2 ccpo.mcont_const[OF complete_lattice_ccpo]) end interpretation lfp: partial_function_definitions "(\) :: _ :: complete_lattice \ _" Sup by(rule complete_lattice_partial_function_definitions) declaration \Partial_Function.init "lfp" \<^term>\lfp.fixp_fun\ \<^term>\lfp.mono_body\ @{thm lfp.fixp_rule_uc} @{thm lfp.fixp_induct_uc} NONE\ interpretation gfp: partial_function_definitions "(\) :: _ :: complete_lattice \ _" Inf by(rule complete_lattice_partial_function_definitions_dual) declaration \Partial_Function.init "gfp" \<^term>\gfp.fixp_fun\ \<^term>\gfp.mono_body\ @{thm gfp.fixp_rule_uc} @{thm gfp.fixp_induct_uc} NONE\ lemma insert_mono [partial_function_mono]: "monotone (fun_ord (\)) (\) A \ monotone (fun_ord (\)) (\) (\y. insert x (A y))" by(rule monotoneI)(auto simp add: fun_ord_def dest: monotoneD) lemma mono2mono_insert [THEN lfp.mono2mono, cont_intro, simp]: shows monotone_insert: "monotone (\) (\) (insert x)" by(rule monotoneI) blast lemma mcont2mcont_insert[THEN lfp.mcont2mcont, cont_intro, simp]: shows mcont_insert: "mcont Union (\) Union (\) (insert x)" by(blast intro: mcontI contI monotone_insert) lemma mono2mono_image [THEN lfp.mono2mono, cont_intro, simp]: shows monotone_image: "monotone (\) (\) ((`) f)" by(rule monotoneI) blast lemma cont_image: "cont Union (\) Union (\) ((`) f)" by(rule contI)(auto) lemma mcont2mcont_image [THEN lfp.mcont2mcont, cont_intro, simp]: shows mcont_image: "mcont Union (\) Union (\) ((`) f)" by(blast intro: mcontI monotone_image cont_image) context complete_lattice begin lemma monotone_Sup [cont_intro, simp]: "monotone ord (\) f \ monotone ord (\) (\x. \f x)" by(blast intro: monotoneI Sup_least Sup_upper dest: monotoneD) lemma cont_Sup: assumes "cont lub ord Union (\) f" shows "cont lub ord Sup (\) (\x. \f x)" apply(rule contI) apply(simp add: contD[OF assms]) -apply(blast intro: Sup_least Sup_upper order_trans antisym) +apply(blast intro: Sup_least Sup_upper order_trans order.antisym) done lemma mcont_Sup: "mcont lub ord Union (\) f \ mcont lub ord Sup (\) (\x. \f x)" unfolding mcont_def by(blast intro: monotone_Sup cont_Sup) lemma monotone_SUP: "\ monotone ord (\) f; \y. monotone ord (\) (\x. g x y) \ \ monotone ord (\) (\x. \y\f x. g x y)" by(rule monotoneI)(blast dest: monotoneD intro: Sup_upper order_trans intro!: Sup_least) lemma monotone_SUP2: "(\y. y \ A \ monotone ord (\) (\x. g x y)) \ monotone ord (\) (\x. \y\A. g x y)" by(rule monotoneI)(blast intro: Sup_upper order_trans dest: monotoneD intro!: Sup_least) lemma cont_SUP: assumes f: "mcont lub ord Union (\) f" and g: "\y. mcont lub ord Sup (\) (\x. g x y)" shows "cont lub ord Sup (\) (\x. \y\f x. g x y)" proof(rule contI) fix Y assume chain: "Complete_Partial_Order.chain ord Y" and Y: "Y \ {}" show "\(g (lub Y) ` f (lub Y)) = \((\x. \(g x ` f x)) ` Y)" (is "?lhs = ?rhs") - proof(rule antisym) + proof(rule order.antisym) show "?lhs \ ?rhs" proof(rule Sup_least) fix x assume "x \ g (lub Y) ` f (lub Y)" with mcont_contD[OF f chain Y] mcont_contD[OF g chain Y] obtain y z where "y \ Y" "z \ f y" and x: "x = \((\x. g x z) ` Y)" by auto show "x \ ?rhs" unfolding x proof(rule Sup_least) fix u assume "u \ (\x. g x z) ` Y" then obtain y' where "u = g y' z" "y' \ Y" by auto from chain \y \ Y\ \y' \ Y\ have "ord y y' \ ord y' y" by(rule chainD) thus "u \ ?rhs" proof note \u = g y' z\ also assume "ord y y'" with f have "f y \ f y'" by(rule mcont_monoD) with \z \ f y\ have "g y' z \ \(g y' ` f y')" by(auto intro: Sup_upper) also have "\ \ ?rhs" using \y' \ Y\ by(auto intro: Sup_upper) finally show ?thesis . next note \u = g y' z\ also assume "ord y' y" with g have "g y' z \ g y z" by(rule mcont_monoD) also have "\ \ \(g y ` f y)" using \z \ f y\ by(auto intro: Sup_upper) also have "\ \ ?rhs" using \y \ Y\ by(auto intro: Sup_upper) finally show ?thesis . qed qed qed next show "?rhs \ ?lhs" proof(rule Sup_least) fix x assume "x \ (\x. \(g x ` f x)) ` Y" then obtain y where x: "x = \(g y ` f y)" and "y \ Y" by auto show "x \ ?lhs" unfolding x proof(rule Sup_least) fix u assume "u \ g y ` f y" then obtain z where "u = g y z" "z \ f y" by auto note \u = g y z\ also have "g y z \ \((\x. g x z) ` Y)" using \y \ Y\ by(auto intro: Sup_upper) also have "\ = g (lub Y) z" by(simp add: mcont_contD[OF g chain Y]) also have "\ \ ?lhs" using \z \ f y\ \y \ Y\ by(auto intro: Sup_upper simp add: mcont_contD[OF f chain Y]) finally show "u \ ?lhs" . qed qed qed qed lemma mcont_SUP [cont_intro, simp]: "\ mcont lub ord Union (\) f; \y. mcont lub ord Sup (\) (\x. g x y) \ \ mcont lub ord Sup (\) (\x. \y\f x. g x y)" by(blast intro: mcontI cont_SUP monotone_SUP mcont_mono) end lemma admissible_Ball [cont_intro, simp]: "\ \x. ccpo.admissible lub ord (\A. P A x); mcont lub ord Union (\) f; class.ccpo lub ord (mk_less ord) \ \ ccpo.admissible lub ord (\A. \x\f A. P A x)" unfolding Ball_def by simp lemma admissible_Bex'[THEN admissible_subst, cont_intro, simp]: shows admissible_Bex: "ccpo.admissible Union (\) (\A. \x\A. P x)" by(rule ccpo.admissibleI)(auto) subsection \Parallel fixpoint induction\ context fixes luba :: "'a set \ 'a" and orda :: "'a \ 'a \ bool" and lubb :: "'b set \ 'b" and ordb :: "'b \ 'b \ bool" assumes a: "class.ccpo luba orda (mk_less orda)" and b: "class.ccpo lubb ordb (mk_less ordb)" begin interpretation a: ccpo luba orda "mk_less orda" by(rule a) interpretation b: ccpo lubb ordb "mk_less ordb" by(rule b) lemma ccpo_rel_prodI: "class.ccpo (prod_lub luba lubb) (rel_prod orda ordb) (mk_less (rel_prod orda ordb))" (is "class.ccpo ?lub ?ord ?ord'") proof(intro class.ccpo.intro class.ccpo_axioms.intro) show "class.order ?ord ?ord'" by(rule order_rel_prodI) intro_locales qed(auto 4 4 simp add: prod_lub_def intro: a.ccpo_Sup_upper b.ccpo_Sup_upper a.ccpo_Sup_least b.ccpo_Sup_least rev_image_eqI dest: chain_rel_prodD1 chain_rel_prodD2) interpretation ab: ccpo "prod_lub luba lubb" "rel_prod orda ordb" "mk_less (rel_prod orda ordb)" by(rule ccpo_rel_prodI) lemma monotone_map_prod [simp]: "monotone (rel_prod orda ordb) (rel_prod ordc ordd) (map_prod f g) \ monotone orda ordc f \ monotone ordb ordd g" by(auto simp add: monotone_def) lemma parallel_fixp_induct: assumes adm: "ccpo.admissible (prod_lub luba lubb) (rel_prod orda ordb) (\x. P (fst x) (snd x))" and f: "monotone orda orda f" and g: "monotone ordb ordb g" and bot: "P (luba {}) (lubb {})" and step: "\x y. P x y \ P (f x) (g y)" shows "P (ccpo.fixp luba orda f) (ccpo.fixp lubb ordb g)" proof - let ?lub = "prod_lub luba lubb" and ?ord = "rel_prod orda ordb" and ?P = "\(x, y). P x y" from adm have adm': "ccpo.admissible ?lub ?ord ?P" by(simp add: split_def) hence "?P (ccpo.fixp (prod_lub luba lubb) (rel_prod orda ordb) (map_prod f g))" by(rule ab.fixp_induct)(auto simp add: f g step bot) also have "ccpo.fixp (prod_lub luba lubb) (rel_prod orda ordb) (map_prod f g) = (ccpo.fixp luba orda f, ccpo.fixp lubb ordb g)" (is "?lhs = (?rhs1, ?rhs2)") - proof(rule ab.antisym) + proof(rule ab.order.antisym) have "ccpo.admissible ?lub ?ord (\xy. ?ord xy (?rhs1, ?rhs2))" by(rule admissible_leI[OF ccpo_rel_prodI])(auto simp add: prod_lub_def chain_empty intro: a.ccpo_Sup_least b.ccpo_Sup_least) thus "?ord ?lhs (?rhs1, ?rhs2)" by(rule ab.fixp_induct)(auto 4 3 dest: monotoneD[OF f] monotoneD[OF g] simp add: b.fixp_unfold[OF g, symmetric] a.fixp_unfold[OF f, symmetric] f g intro: a.ccpo_Sup_least b.ccpo_Sup_least chain_empty) next have "ccpo.admissible luba orda (\x. orda x (fst ?lhs))" by(rule admissible_leI[OF a])(auto intro: a.ccpo_Sup_least simp add: chain_empty) hence "orda ?rhs1 (fst ?lhs)" using f proof(rule a.fixp_induct) fix x assume "orda x (fst ?lhs)" thus "orda (f x) (fst ?lhs)" by(subst ab.fixp_unfold)(auto simp add: f g dest: monotoneD[OF f]) qed(auto intro: a.ccpo_Sup_least chain_empty) moreover have "ccpo.admissible lubb ordb (\y. ordb y (snd ?lhs))" by(rule admissible_leI[OF b])(auto intro: b.ccpo_Sup_least simp add: chain_empty) hence "ordb ?rhs2 (snd ?lhs)" using g proof(rule b.fixp_induct) fix y assume "ordb y (snd ?lhs)" thus "ordb (g y) (snd ?lhs)" by(subst ab.fixp_unfold)(auto simp add: f g dest: monotoneD[OF g]) qed(auto intro: b.ccpo_Sup_least chain_empty) ultimately show "?ord (?rhs1, ?rhs2) ?lhs" by(simp add: rel_prod_conv split_beta) qed finally show ?thesis by simp qed end lemma parallel_fixp_induct_uc: assumes a: "partial_function_definitions orda luba" and b: "partial_function_definitions ordb lubb" and F: "\x. monotone (fun_ord orda) orda (\f. U1 (F (C1 f)) x)" and G: "\y. monotone (fun_ord ordb) ordb (\g. U2 (G (C2 g)) y)" and eq1: "f \ C1 (ccpo.fixp (fun_lub luba) (fun_ord orda) (\f. U1 (F (C1 f))))" and eq2: "g \ C2 (ccpo.fixp (fun_lub lubb) (fun_ord ordb) (\g. U2 (G (C2 g))))" and inverse: "\f. U1 (C1 f) = f" and inverse2: "\g. U2 (C2 g) = g" and adm: "ccpo.admissible (prod_lub (fun_lub luba) (fun_lub lubb)) (rel_prod (fun_ord orda) (fun_ord ordb)) (\x. P (fst x) (snd x))" and bot: "P (\_. luba {}) (\_. lubb {})" and step: "\f g. P (U1 f) (U2 g) \ P (U1 (F f)) (U2 (G g))" shows "P (U1 f) (U2 g)" apply(unfold eq1 eq2 inverse inverse2) apply(rule parallel_fixp_induct[OF partial_function_definitions.ccpo[OF a] partial_function_definitions.ccpo[OF b] adm]) using F apply(simp add: monotone_def fun_ord_def) using G apply(simp add: monotone_def fun_ord_def) apply(simp add: fun_lub_def bot) apply(rule step, simp add: inverse inverse2) done lemmas parallel_fixp_induct_1_1 = parallel_fixp_induct_uc[ of _ _ _ _ "\x. x" _ "\x. x" "\x. x" _ "\x. x", OF _ _ _ _ _ _ refl refl] lemmas parallel_fixp_induct_2_2 = parallel_fixp_induct_uc[ of _ _ _ _ "case_prod" _ "curry" "case_prod" _ "curry", where P="\f g. P (curry f) (curry g)", unfolded case_prod_curry curry_case_prod curry_K, OF _ _ _ _ _ _ refl refl] for P lemma monotone_fst: "monotone (rel_prod orda ordb) orda fst" by(auto intro: monotoneI) lemma mcont_fst: "mcont (prod_lub luba lubb) (rel_prod orda ordb) luba orda fst" by(auto intro!: mcontI monotoneI contI simp add: prod_lub_def) lemma mcont2mcont_fst [cont_intro, simp]: "mcont lub ord (prod_lub luba lubb) (rel_prod orda ordb) t \ mcont lub ord luba orda (\x. fst (t x))" by(auto intro!: mcontI monotoneI contI dest: mcont_monoD mcont_contD simp add: rel_prod_sel split_beta prod_lub_def image_image) lemma monotone_snd: "monotone (rel_prod orda ordb) ordb snd" by(auto intro: monotoneI) lemma mcont_snd: "mcont (prod_lub luba lubb) (rel_prod orda ordb) lubb ordb snd" by(auto intro!: mcontI monotoneI contI simp add: prod_lub_def) lemma mcont2mcont_snd [cont_intro, simp]: "mcont lub ord (prod_lub luba lubb) (rel_prod orda ordb) t \ mcont lub ord lubb ordb (\x. snd (t x))" by(auto intro!: mcontI monotoneI contI dest: mcont_monoD mcont_contD simp add: rel_prod_sel split_beta prod_lub_def image_image) lemma monotone_Pair: "\ monotone ord orda f; monotone ord ordb g \ \ monotone ord (rel_prod orda ordb) (\x. (f x, g x))" by(simp add: monotone_def) lemma cont_Pair: "\ cont lub ord luba orda f; cont lub ord lubb ordb g \ \ cont lub ord (prod_lub luba lubb) (rel_prod orda ordb) (\x. (f x, g x))" by(rule contI)(auto simp add: prod_lub_def image_image dest!: contD) lemma mcont_Pair: "\ mcont lub ord luba orda f; mcont lub ord lubb ordb g \ \ mcont lub ord (prod_lub luba lubb) (rel_prod orda ordb) (\x. (f x, g x))" by(rule mcontI)(simp_all add: monotone_Pair mcont_mono cont_Pair) context partial_function_definitions begin text \Specialised versions of @{thm [source] mcont_call} for admissibility proofs for parallel fixpoint inductions\ lemmas mcont_call_fst [cont_intro] = mcont_call[THEN mcont2mcont, OF mcont_fst] lemmas mcont_call_snd [cont_intro] = mcont_call[THEN mcont2mcont, OF mcont_snd] end lemma map_option_mono [partial_function_mono]: "mono_option B \ mono_option (\f. map_option g (B f))" unfolding map_conv_bind_option by(rule bind_mono) simp_all lemma compact_flat_lub [cont_intro]: "ccpo.compact (flat_lub x) (flat_ord x) y" using flat_interpretation[THEN ccpo] proof(rule ccpo.compactI[OF _ ccpo.admissibleI]) fix A assume chain: "Complete_Partial_Order.chain (flat_ord x) A" and A: "A \ {}" and *: "\z\A. \ flat_ord x y z" from A obtain z where "z \ A" by blast with * have z: "\ flat_ord x y z" .. hence y: "x \ y" "y \ z" by(auto simp add: flat_ord_def) { assume "\ A \ {x}" then obtain z' where "z' \ A" "z' \ x" by auto then have "(THE z. z \ A - {x}) = z'" by(intro the_equality)(auto dest: chainD[OF chain] simp add: flat_ord_def) moreover have "z' \ y" using \z' \ A\ * by(auto simp add: flat_ord_def) ultimately have "y \ (THE z. z \ A - {x})" by simp } with z show "\ flat_ord x y (flat_lub x A)" by(simp add: flat_ord_def flat_lub_def) qed end diff --git a/src/HOL/Library/Countable_Complete_Lattices.thy b/src/HOL/Library/Countable_Complete_Lattices.thy --- a/src/HOL/Library/Countable_Complete_Lattices.thy +++ b/src/HOL/Library/Countable_Complete_Lattices.thy @@ -1,277 +1,277 @@ (* Title: HOL/Library/Countable_Complete_Lattices.thy Author: Johannes Hölzl *) section \Countable Complete Lattices\ theory Countable_Complete_Lattices imports Main Countable_Set begin lemma UNIV_nat_eq: "UNIV = insert 0 (range Suc)" by (metis UNIV_eq_I nat.nchotomy insertCI rangeI) class countable_complete_lattice = lattice + Inf + Sup + bot + top + assumes ccInf_lower: "countable A \ x \ A \ Inf A \ x" assumes ccInf_greatest: "countable A \ (\x. x \ A \ z \ x) \ z \ Inf A" assumes ccSup_upper: "countable A \ x \ A \ x \ Sup A" assumes ccSup_least: "countable A \ (\x. x \ A \ x \ z) \ Sup A \ z" assumes ccInf_empty [simp]: "Inf {} = top" assumes ccSup_empty [simp]: "Sup {} = bot" begin subclass bounded_lattice proof fix a show "bot \ a" by (auto intro: ccSup_least simp only: ccSup_empty [symmetric]) show "a \ top" by (auto intro: ccInf_greatest simp only: ccInf_empty [symmetric]) qed lemma ccINF_lower: "countable A \ i \ A \ (INF i \ A. f i) \ f i" using ccInf_lower [of "f ` A"] by simp lemma ccINF_greatest: "countable A \ (\i. i \ A \ u \ f i) \ u \ (INF i \ A. f i)" using ccInf_greatest [of "f ` A"] by auto lemma ccSUP_upper: "countable A \ i \ A \ f i \ (SUP i \ A. f i)" using ccSup_upper [of "f ` A"] by simp lemma ccSUP_least: "countable A \ (\i. i \ A \ f i \ u) \ (SUP i \ A. f i) \ u" using ccSup_least [of "f ` A"] by auto lemma ccInf_lower2: "countable A \ u \ A \ u \ v \ Inf A \ v" using ccInf_lower [of A u] by auto lemma ccINF_lower2: "countable A \ i \ A \ f i \ u \ (INF i \ A. f i) \ u" using ccINF_lower [of A i f] by auto lemma ccSup_upper2: "countable A \ u \ A \ v \ u \ v \ Sup A" using ccSup_upper [of A u] by auto lemma ccSUP_upper2: "countable A \ i \ A \ u \ f i \ u \ (SUP i \ A. f i)" using ccSUP_upper [of A i f] by auto lemma le_ccInf_iff: "countable A \ b \ Inf A \ (\a\A. b \ a)" by (auto intro: ccInf_greatest dest: ccInf_lower) lemma le_ccINF_iff: "countable A \ u \ (INF i \ A. f i) \ (\i\A. u \ f i)" using le_ccInf_iff [of "f ` A"] by simp lemma ccSup_le_iff: "countable A \ Sup A \ b \ (\a\A. a \ b)" by (auto intro: ccSup_least dest: ccSup_upper) lemma ccSUP_le_iff: "countable A \ (SUP i \ A. f i) \ u \ (\i\A. f i \ u)" using ccSup_le_iff [of "f ` A"] by simp lemma ccInf_insert [simp]: "countable A \ Inf (insert a A) = inf a (Inf A)" - by (force intro: le_infI le_infI1 le_infI2 antisym ccInf_greatest ccInf_lower) + by (force intro: le_infI le_infI1 le_infI2 order.antisym ccInf_greatest ccInf_lower) lemma ccINF_insert [simp]: "countable A \ (INF x\insert a A. f x) = inf (f a) (Inf (f ` A))" unfolding image_insert by simp lemma ccSup_insert [simp]: "countable A \ Sup (insert a A) = sup a (Sup A)" - by (force intro: le_supI le_supI1 le_supI2 antisym ccSup_least ccSup_upper) + by (force intro: le_supI le_supI1 le_supI2 order.antisym ccSup_least ccSup_upper) lemma ccSUP_insert [simp]: "countable A \ (SUP x\insert a A. f x) = sup (f a) (Sup (f ` A))" unfolding image_insert by simp lemma ccINF_empty [simp]: "(INF x\{}. f x) = top" unfolding image_empty by simp lemma ccSUP_empty [simp]: "(SUP x\{}. f x) = bot" unfolding image_empty by simp lemma ccInf_superset_mono: "countable A \ B \ A \ Inf A \ Inf B" by (auto intro: ccInf_greatest ccInf_lower countable_subset) lemma ccSup_subset_mono: "countable B \ A \ B \ Sup A \ Sup B" by (auto intro: ccSup_least ccSup_upper countable_subset) lemma ccInf_mono: assumes [intro]: "countable B" "countable A" assumes "\b. b \ B \ \a\A. a \ b" shows "Inf A \ Inf B" proof (rule ccInf_greatest) fix b assume "b \ B" with assms obtain a where "a \ A" and "a \ b" by blast from \a \ A\ have "Inf A \ a" by (rule ccInf_lower[rotated]) auto with \a \ b\ show "Inf A \ b" by auto qed auto lemma ccINF_mono: "countable A \ countable B \ (\m. m \ B \ \n\A. f n \ g m) \ (INF n\A. f n) \ (INF n\B. g n)" using ccInf_mono [of "g ` B" "f ` A"] by auto lemma ccSup_mono: assumes [intro]: "countable B" "countable A" assumes "\a. a \ A \ \b\B. a \ b" shows "Sup A \ Sup B" proof (rule ccSup_least) fix a assume "a \ A" with assms obtain b where "b \ B" and "a \ b" by blast from \b \ B\ have "b \ Sup B" by (rule ccSup_upper[rotated]) auto with \a \ b\ show "a \ Sup B" by auto qed auto lemma ccSUP_mono: "countable A \ countable B \ (\n. n \ A \ \m\B. f n \ g m) \ (SUP n\A. f n) \ (SUP n\B. g n)" using ccSup_mono [of "g ` B" "f ` A"] by auto lemma ccINF_superset_mono: "countable A \ B \ A \ (\x. x \ B \ f x \ g x) \ (INF x\A. f x) \ (INF x\B. g x)" by (blast intro: ccINF_mono countable_subset dest: subsetD) lemma ccSUP_subset_mono: "countable B \ A \ B \ (\x. x \ A \ f x \ g x) \ (SUP x\A. f x) \ (SUP x\B. g x)" by (blast intro: ccSUP_mono countable_subset dest: subsetD) lemma less_eq_ccInf_inter: "countable A \ countable B \ sup (Inf A) (Inf B) \ Inf (A \ B)" by (auto intro: ccInf_greatest ccInf_lower) lemma ccSup_inter_less_eq: "countable A \ countable B \ Sup (A \ B) \ inf (Sup A) (Sup B)" by (auto intro: ccSup_least ccSup_upper) lemma ccInf_union_distrib: "countable A \ countable B \ Inf (A \ B) = inf (Inf A) (Inf B)" - by (rule antisym) (auto intro: ccInf_greatest ccInf_lower le_infI1 le_infI2) + by (rule order.antisym) (auto intro: ccInf_greatest ccInf_lower le_infI1 le_infI2) lemma ccINF_union: "countable A \ countable B \ (INF i\A \ B. M i) = inf (INF i\A. M i) (INF i\B. M i)" - by (auto intro!: antisym ccINF_mono intro: le_infI1 le_infI2 ccINF_greatest ccINF_lower) + by (auto intro!: order.antisym ccINF_mono intro: le_infI1 le_infI2 ccINF_greatest ccINF_lower) lemma ccSup_union_distrib: "countable A \ countable B \ Sup (A \ B) = sup (Sup A) (Sup B)" - by (rule antisym) (auto intro: ccSup_least ccSup_upper le_supI1 le_supI2) + by (rule order.antisym) (auto intro: ccSup_least ccSup_upper le_supI1 le_supI2) lemma ccSUP_union: "countable A \ countable B \ (SUP i\A \ B. M i) = sup (SUP i\A. M i) (SUP i\B. M i)" - by (auto intro!: antisym ccSUP_mono intro: le_supI1 le_supI2 ccSUP_least ccSUP_upper) + by (auto intro!: order.antisym ccSUP_mono intro: le_supI1 le_supI2 ccSUP_least ccSUP_upper) lemma ccINF_inf_distrib: "countable A \ inf (INF a\A. f a) (INF a\A. g a) = (INF a\A. inf (f a) (g a))" - by (rule antisym) (rule ccINF_greatest, auto intro: le_infI1 le_infI2 ccINF_lower ccINF_mono) + by (rule order.antisym) (rule ccINF_greatest, auto intro: le_infI1 le_infI2 ccINF_lower ccINF_mono) lemma ccSUP_sup_distrib: "countable A \ sup (SUP a\A. f a) (SUP a\A. g a) = (SUP a\A. sup (f a) (g a))" - by (rule antisym[rotated]) (rule ccSUP_least, auto intro: le_supI1 le_supI2 ccSUP_upper ccSUP_mono) + by (rule order.antisym[rotated]) (rule ccSUP_least, auto intro: le_supI1 le_supI2 ccSUP_upper ccSUP_mono) lemma ccINF_const [simp]: "A \ {} \ (INF i \ A. f) = f" unfolding image_constant_conv by auto lemma ccSUP_const [simp]: "A \ {} \ (SUP i \ A. f) = f" unfolding image_constant_conv by auto lemma ccINF_top [simp]: "(INF x\A. top) = top" by (cases "A = {}") simp_all lemma ccSUP_bot [simp]: "(SUP x\A. bot) = bot" by (cases "A = {}") simp_all lemma ccINF_commute: "countable A \ countable B \ (INF i\A. INF j\B. f i j) = (INF j\B. INF i\A. f i j)" - by (iprover intro: ccINF_lower ccINF_greatest order_trans antisym) + by (iprover intro: ccINF_lower ccINF_greatest order_trans order.antisym) lemma ccSUP_commute: "countable A \ countable B \ (SUP i\A. SUP j\B. f i j) = (SUP j\B. SUP i\A. f i j)" - by (iprover intro: ccSUP_upper ccSUP_least order_trans antisym) + by (iprover intro: ccSUP_upper ccSUP_least order_trans order.antisym) end context fixes a :: "'a::{countable_complete_lattice, linorder}" begin lemma less_ccSup_iff: "countable S \ a < Sup S \ (\x\S. a < x)" unfolding not_le [symmetric] by (subst ccSup_le_iff) auto lemma less_ccSUP_iff: "countable A \ a < (SUP i\A. f i) \ (\x\A. a < f x)" using less_ccSup_iff [of "f ` A"] by simp lemma ccInf_less_iff: "countable S \ Inf S < a \ (\x\S. x < a)" unfolding not_le [symmetric] by (subst le_ccInf_iff) auto lemma ccINF_less_iff: "countable A \ (INF i\A. f i) < a \ (\x\A. f x < a)" using ccInf_less_iff [of "f ` A"] by simp end class countable_complete_distrib_lattice = countable_complete_lattice + assumes sup_ccInf: "countable B \ sup a (Inf B) = (INF b\B. sup a b)" assumes inf_ccSup: "countable B \ inf a (Sup B) = (SUP b\B. inf a b)" begin lemma sup_ccINF: "countable B \ sup a (INF b\B. f b) = (INF b\B. sup a (f b))" by (simp only: sup_ccInf image_image countable_image) lemma inf_ccSUP: "countable B \ inf a (SUP b\B. f b) = (SUP b\B. inf a (f b))" by (simp only: inf_ccSup image_image countable_image) subclass distrib_lattice proof fix a b c from sup_ccInf[of "{b, c}" a] have "sup a (Inf {b, c}) = (INF d\{b, c}. sup a d)" by simp then show "sup a (inf b c) = inf (sup a b) (sup a c)" by simp qed lemma ccInf_sup: "countable B \ sup (Inf B) a = (INF b\B. sup b a)" by (simp add: sup_ccInf sup_commute) lemma ccSup_inf: "countable B \ inf (Sup B) a = (SUP b\B. inf b a)" by (simp add: inf_ccSup inf_commute) lemma ccINF_sup: "countable B \ sup (INF b\B. f b) a = (INF b\B. sup (f b) a)" by (simp add: sup_ccINF sup_commute) lemma ccSUP_inf: "countable B \ inf (SUP b\B. f b) a = (SUP b\B. inf (f b) a)" by (simp add: inf_ccSUP inf_commute) lemma ccINF_sup_distrib2: "countable A \ countable B \ sup (INF a\A. f a) (INF b\B. g b) = (INF a\A. INF b\B. sup (f a) (g b))" by (subst ccINF_commute) (simp_all add: sup_ccINF ccINF_sup) lemma ccSUP_inf_distrib2: "countable A \ countable B \ inf (SUP a\A. f a) (SUP b\B. g b) = (SUP a\A. SUP b\B. inf (f a) (g b))" by (subst ccSUP_commute) (simp_all add: inf_ccSUP ccSUP_inf) context fixes f :: "'a \ 'b::countable_complete_lattice" assumes "mono f" begin lemma mono_ccInf: "countable A \ f (Inf A) \ (INF x\A. f x)" using \mono f\ by (auto intro!: countable_complete_lattice_class.ccINF_greatest intro: ccInf_lower dest: monoD) lemma mono_ccSup: "countable A \ (SUP x\A. f x) \ f (Sup A)" using \mono f\ by (auto intro: countable_complete_lattice_class.ccSUP_least ccSup_upper dest: monoD) lemma mono_ccINF: "countable I \ f (INF i \ I. A i) \ (INF x \ I. f (A x))" by (intro countable_complete_lattice_class.ccINF_greatest monoD[OF \mono f\] ccINF_lower) lemma mono_ccSUP: "countable I \ (SUP x \ I. f (A x)) \ f (SUP i \ I. A i)" by (intro countable_complete_lattice_class.ccSUP_least monoD[OF \mono f\] ccSUP_upper) end end subsubsection \Instances of countable complete lattices\ instance "fun" :: (type, countable_complete_lattice) countable_complete_lattice by standard (auto simp: le_fun_def intro!: ccSUP_upper ccSUP_least ccINF_lower ccINF_greatest) subclass (in complete_lattice) countable_complete_lattice by standard (auto intro: Sup_upper Sup_least Inf_lower Inf_greatest) subclass (in complete_distrib_lattice) countable_complete_distrib_lattice by standard (auto intro: sup_Inf inf_Sup) end diff --git a/src/HOL/Library/DAList_Multiset.thy b/src/HOL/Library/DAList_Multiset.thy --- a/src/HOL/Library/DAList_Multiset.thy +++ b/src/HOL/Library/DAList_Multiset.thy @@ -1,442 +1,442 @@ (* Title: HOL/Library/DAList_Multiset.thy Author: Lukas Bulwahn, TU Muenchen *) section \Multisets partially implemented by association lists\ theory DAList_Multiset imports Multiset DAList begin text \Delete prexisting code equations\ declare [[code drop: "{#}" Multiset.is_empty add_mset "plus :: 'a multiset \ _" "minus :: 'a multiset \ _" inter_mset union_mset image_mset filter_mset count "size :: _ multiset \ nat" sum_mset prod_mset set_mset sorted_list_of_multiset subset_mset subseteq_mset equal_multiset_inst.equal_multiset]] text \Raw operations on lists\ definition join_raw :: "('key \ 'val \ 'val \ 'val) \ ('key \ 'val) list \ ('key \ 'val) list \ ('key \ 'val) list" where "join_raw f xs ys = foldr (\(k, v). map_default k v (\v'. f k (v', v))) ys xs" lemma join_raw_Nil [simp]: "join_raw f xs [] = xs" by (simp add: join_raw_def) lemma join_raw_Cons [simp]: "join_raw f xs ((k, v) # ys) = map_default k v (\v'. f k (v', v)) (join_raw f xs ys)" by (simp add: join_raw_def) lemma map_of_join_raw: assumes "distinct (map fst ys)" shows "map_of (join_raw f xs ys) x = (case map_of xs x of None \ map_of ys x | Some v \ (case map_of ys x of None \ Some v | Some v' \ Some (f x (v, v'))))" using assms apply (induct ys) apply (auto simp add: map_of_map_default split: option.split) apply (metis map_of_eq_None_iff option.simps(2) weak_map_of_SomeI) apply (metis Some_eq_map_of_iff map_of_eq_None_iff option.simps(2)) done lemma distinct_join_raw: assumes "distinct (map fst xs)" shows "distinct (map fst (join_raw f xs ys))" using assms proof (induct ys) case Nil then show ?case by simp next case (Cons y ys) then show ?case by (cases y) (simp add: distinct_map_default) qed definition "subtract_entries_raw xs ys = foldr (\(k, v). AList.map_entry k (\v'. v' - v)) ys xs" lemma map_of_subtract_entries_raw: assumes "distinct (map fst ys)" shows "map_of (subtract_entries_raw xs ys) x = (case map_of xs x of None \ None | Some v \ (case map_of ys x of None \ Some v | Some v' \ Some (v - v')))" using assms unfolding subtract_entries_raw_def apply (induct ys) apply auto apply (simp split: option.split) apply (simp add: map_of_map_entry) apply (auto split: option.split) apply (metis map_of_eq_None_iff option.simps(3) option.simps(4)) apply (metis map_of_eq_None_iff option.simps(4) option.simps(5)) done lemma distinct_subtract_entries_raw: assumes "distinct (map fst xs)" shows "distinct (map fst (subtract_entries_raw xs ys))" using assms unfolding subtract_entries_raw_def by (induct ys) (auto simp add: distinct_map_entry) text \Operations on alists with distinct keys\ lift_definition join :: "('a \ 'b \ 'b \ 'b) \ ('a, 'b) alist \ ('a, 'b) alist \ ('a, 'b) alist" is join_raw by (simp add: distinct_join_raw) lift_definition subtract_entries :: "('a, ('b :: minus)) alist \ ('a, 'b) alist \ ('a, 'b) alist" is subtract_entries_raw by (simp add: distinct_subtract_entries_raw) text \Implementing multisets by means of association lists\ definition count_of :: "('a \ nat) list \ 'a \ nat" where "count_of xs x = (case map_of xs x of None \ 0 | Some n \ n)" lemma count_of_multiset: "finite {x. 0 < count_of xs x}" proof - let ?A = "{x::'a. 0 < (case map_of xs x of None \ 0::nat | Some n \ n)}" have "?A \ dom (map_of xs)" proof fix x assume "x \ ?A" then have "0 < (case map_of xs x of None \ 0::nat | Some n \ n)" by simp then have "map_of xs x \ None" by (cases "map_of xs x") auto then show "x \ dom (map_of xs)" by auto qed with finite_dom_map_of [of xs] have "finite ?A" by (auto intro: finite_subset) then show ?thesis by (simp add: count_of_def fun_eq_iff) qed lemma count_simps [simp]: "count_of [] = (\_. 0)" "count_of ((x, n) # xs) = (\y. if x = y then n else count_of xs y)" by (simp_all add: count_of_def fun_eq_iff) lemma count_of_empty: "x \ fst ` set xs \ count_of xs x = 0" by (induct xs) (simp_all add: count_of_def) lemma count_of_filter: "count_of (List.filter (P \ fst) xs) x = (if P x then count_of xs x else 0)" by (induct xs) auto lemma count_of_map_default [simp]: "count_of (map_default x b (\x. x + b) xs) y = (if x = y then count_of xs x + b else count_of xs y)" unfolding count_of_def by (simp add: map_of_map_default split: option.split) lemma count_of_join_raw: "distinct (map fst ys) \ count_of xs x + count_of ys x = count_of (join_raw (\x (x, y). x + y) xs ys) x" unfolding count_of_def by (simp add: map_of_join_raw split: option.split) lemma count_of_subtract_entries_raw: "distinct (map fst ys) \ count_of xs x - count_of ys x = count_of (subtract_entries_raw xs ys) x" unfolding count_of_def by (simp add: map_of_subtract_entries_raw split: option.split) text \Code equations for multiset operations\ definition Bag :: "('a, nat) alist \ 'a multiset" where "Bag xs = Abs_multiset (count_of (DAList.impl_of xs))" code_datatype Bag lemma count_Bag [simp, code]: "count (Bag xs) = count_of (DAList.impl_of xs)" by (simp add: Bag_def count_of_multiset) lemma Mempty_Bag [code]: "{#} = Bag (DAList.empty)" by (simp add: multiset_eq_iff alist.Alist_inverse DAList.empty_def) lift_definition is_empty_Bag_impl :: "('a, nat) alist \ bool" is "\xs. list_all (\x. snd x = 0) xs" . lemma is_empty_Bag [code]: "Multiset.is_empty (Bag xs) \ is_empty_Bag_impl xs" proof - have "Multiset.is_empty (Bag xs) \ (\x. count (Bag xs) x = 0)" unfolding Multiset.is_empty_def multiset_eq_iff by simp also have "\ \ (\x\fst ` set (alist.impl_of xs). count (Bag xs) x = 0)" proof (intro iffI allI ballI) fix x assume A: "\x\fst ` set (alist.impl_of xs). count (Bag xs) x = 0" thus "count (Bag xs) x = 0" proof (cases "x \ fst ` set (alist.impl_of xs)") case False thus ?thesis by (force simp: count_of_def split: option.splits) qed (insert A, auto) qed simp_all also have "\ \ list_all (\x. snd x = 0) (alist.impl_of xs)" by (auto simp: count_of_def list_all_def) finally show ?thesis by (simp add: is_empty_Bag_impl.rep_eq) qed lemma union_Bag [code]: "Bag xs + Bag ys = Bag (join (\x (n1, n2). n1 + n2) xs ys)" by (rule multiset_eqI) (simp add: count_of_join_raw alist.Alist_inverse distinct_join_raw join_def) lemma add_mset_Bag [code]: "add_mset x (Bag xs) = Bag (join (\x (n1, n2). n1 + n2) (DAList.update x 1 DAList.empty) xs)" unfolding add_mset_add_single[of x "Bag xs"] union_Bag[symmetric] by (simp add: multiset_eq_iff update.rep_eq empty.rep_eq) lemma minus_Bag [code]: "Bag xs - Bag ys = Bag (subtract_entries xs ys)" by (rule multiset_eqI) (simp add: count_of_subtract_entries_raw alist.Alist_inverse distinct_subtract_entries_raw subtract_entries_def) lemma filter_Bag [code]: "filter_mset P (Bag xs) = Bag (DAList.filter (P \ fst) xs)" by (rule multiset_eqI) (simp add: count_of_filter DAList.filter.rep_eq) lemma mset_eq [code]: "HOL.equal (m1::'a::equal multiset) m2 \ m1 \# m2 \ m2 \# m1" - by (metis equal_multiset_def subset_mset.eq_iff) + by (metis equal_multiset_def subset_mset.order_eq_iff) text \By default the code for \<\ is \<^prop>\xs < ys \ xs \ ys \ \ xs = ys\. With equality implemented by \\\, this leads to three calls of \\\. Here is a more efficient version:\ lemma mset_less[code]: "xs \# (ys :: 'a multiset) \ xs \# ys \ \ ys \# xs" by (rule subset_mset.less_le_not_le) lemma mset_less_eq_Bag0: "Bag xs \# A \ (\(x, n) \ set (DAList.impl_of xs). count_of (DAList.impl_of xs) x \ count A x)" (is "?lhs \ ?rhs") proof assume ?lhs then show ?rhs by (auto simp add: subseteq_mset_def) next assume ?rhs show ?lhs proof (rule mset_subset_eqI) fix x from \?rhs\ have "count_of (DAList.impl_of xs) x \ count A x" by (cases "x \ fst ` set (DAList.impl_of xs)") (auto simp add: count_of_empty) then show "count (Bag xs) x \ count A x" by (simp add: subset_mset_def) qed qed lemma mset_less_eq_Bag [code]: "Bag xs \# (A :: 'a multiset) \ (\(x, n) \ set (DAList.impl_of xs). n \ count A x)" proof - { fix x n assume "(x,n) \ set (DAList.impl_of xs)" then have "count_of (DAList.impl_of xs) x = n" proof transfer fix x n fix xs :: "('a \ nat) list" show "(distinct \ map fst) xs \ (x, n) \ set xs \ count_of xs x = n" proof (induct xs) case Nil then show ?case by simp next case (Cons ym ys) obtain y m where ym: "ym = (y,m)" by force note Cons = Cons[unfolded ym] show ?case proof (cases "x = y") case False with Cons show ?thesis unfolding ym by auto next case True with Cons(2-3) have "m = n" by force with True show ?thesis unfolding ym by auto qed qed qed } then show ?thesis unfolding mset_less_eq_Bag0 by auto qed declare inter_mset_def [code] declare union_mset_def [code] declare mset.simps [code] fun fold_impl :: "('a \ nat \ 'b \ 'b) \ 'b \ ('a \ nat) list \ 'b" where "fold_impl fn e ((a,n) # ms) = (fold_impl fn ((fn a n) e) ms)" | "fold_impl fn e [] = e" context begin qualified definition fold :: "('a \ nat \ 'b \ 'b) \ 'b \ ('a, nat) alist \ 'b" where "fold f e al = fold_impl f e (DAList.impl_of al)" end context comp_fun_commute begin lemma DAList_Multiset_fold: assumes fn: "\a n x. fn a n x = (f a ^^ n) x" shows "fold_mset f e (Bag al) = DAList_Multiset.fold fn e al" unfolding DAList_Multiset.fold_def proof (induct al) fix ys let ?inv = "{xs :: ('a \ nat) list. (distinct \ map fst) xs}" note cs[simp del] = count_simps have count[simp]: "\x. count (Abs_multiset (count_of x)) = count_of x" by (rule Abs_multiset_inverse) (simp add: count_of_multiset) assume ys: "ys \ ?inv" then show "fold_mset f e (Bag (Alist ys)) = fold_impl fn e (DAList.impl_of (Alist ys))" unfolding Bag_def unfolding Alist_inverse[OF ys] proof (induct ys arbitrary: e rule: list.induct) case Nil show ?case by (rule trans[OF arg_cong[of _ "{#}" "fold_mset f e", OF multiset_eqI]]) (auto, simp add: cs) next case (Cons pair ys e) obtain a n where pair: "pair = (a,n)" by force from fn[of a n] have [simp]: "fn a n = (f a ^^ n)" by auto have inv: "ys \ ?inv" using Cons(2) by auto note IH = Cons(1)[OF inv] define Ys where "Ys = Abs_multiset (count_of ys)" have id: "Abs_multiset (count_of ((a, n) # ys)) = (((+) {# a #}) ^^ n) Ys" unfolding Ys_def proof (rule multiset_eqI, unfold count) fix c show "count_of ((a, n) # ys) c = count (((+) {#a#} ^^ n) (Abs_multiset (count_of ys))) c" (is "?l = ?r") proof (cases "c = a") case False then show ?thesis unfolding cs by (induct n) auto next case True then have "?l = n" by (simp add: cs) also have "n = ?r" unfolding True proof (induct n) case 0 from Cons(2)[unfolded pair] have "a \ fst ` set ys" by auto then show ?case by (induct ys) (simp, auto simp: cs) next case Suc then show ?case by simp qed finally show ?thesis . qed qed show ?case unfolding pair apply (simp add: IH[symmetric]) unfolding id Ys_def[symmetric] apply (induct n) apply (auto simp: fold_mset_fun_left_comm[symmetric]) done qed qed end context begin private lift_definition single_alist_entry :: "'a \ 'b \ ('a, 'b) alist" is "\a b. [(a, b)]" by auto lemma image_mset_Bag [code]: "image_mset f (Bag ms) = DAList_Multiset.fold (\a n m. Bag (single_alist_entry (f a) n) + m) {#} ms" unfolding image_mset_def proof (rule comp_fun_commute.DAList_Multiset_fold, unfold_locales, (auto simp: ac_simps)[1]) fix a n m show "Bag (single_alist_entry (f a) n) + m = ((add_mset \ f) a ^^ n) m" (is "?l = ?r") proof (rule multiset_eqI) fix x have "count ?r x = (if x = f a then n + count m x else count m x)" by (induct n) auto also have "\ = count ?l x" by (simp add: single_alist_entry.rep_eq) finally show "count ?l x = count ?r x" .. qed qed end \ \we cannot use \\a n. (+) (a * n)\ for folding, since \(*)\ is not defined in \comm_monoid_add\\ lemma sum_mset_Bag[code]: "sum_mset (Bag ms) = DAList_Multiset.fold (\a n. (((+) a) ^^ n)) 0 ms" unfolding sum_mset.eq_fold apply (rule comp_fun_commute.DAList_Multiset_fold) apply unfold_locales apply (auto simp: ac_simps) done \ \we cannot use \\a n. (*) (a ^ n)\ for folding, since \(^)\ is not defined in \comm_monoid_mult\\ lemma prod_mset_Bag[code]: "prod_mset (Bag ms) = DAList_Multiset.fold (\a n. (((*) a) ^^ n)) 1 ms" unfolding prod_mset.eq_fold apply (rule comp_fun_commute.DAList_Multiset_fold) apply unfold_locales apply (auto simp: ac_simps) done lemma size_fold: "size A = fold_mset (\_. Suc) 0 A" (is "_ = fold_mset ?f _ _") proof - interpret comp_fun_commute ?f by standard auto show ?thesis by (induct A) auto qed lemma size_Bag[code]: "size (Bag ms) = DAList_Multiset.fold (\a n. (+) n) 0 ms" unfolding size_fold proof (rule comp_fun_commute.DAList_Multiset_fold, unfold_locales, simp) fix a n x show "n + x = (Suc ^^ n) x" by (induct n) auto qed lemma set_mset_fold: "set_mset A = fold_mset insert {} A" (is "_ = fold_mset ?f _ _") proof - interpret comp_fun_commute ?f by standard auto show ?thesis by (induct A) auto qed lemma set_mset_Bag[code]: "set_mset (Bag ms) = DAList_Multiset.fold (\a n. (if n = 0 then (\m. m) else insert a)) {} ms" unfolding set_mset_fold proof (rule comp_fun_commute.DAList_Multiset_fold, unfold_locales, (auto simp: ac_simps)[1]) fix a n x show "(if n = 0 then \m. m else insert a) x = (insert a ^^ n) x" (is "?l n = ?r n") proof (cases n) case 0 then show ?thesis by simp next case (Suc m) then have "?l n = insert a x" by simp moreover have "?r n = insert a x" unfolding Suc by (induct m) auto ultimately show ?thesis by auto qed qed instantiation multiset :: (exhaustive) exhaustive begin definition exhaustive_multiset :: "('a multiset \ (bool \ term list) option) \ natural \ (bool \ term list) option" where "exhaustive_multiset f i = Quickcheck_Exhaustive.exhaustive (\xs. f (Bag xs)) i" instance .. end end diff --git a/src/HOL/Library/Lattice_Algebras.thy b/src/HOL/Library/Lattice_Algebras.thy --- a/src/HOL/Library/Lattice_Algebras.thy +++ b/src/HOL/Library/Lattice_Algebras.thy @@ -1,577 +1,577 @@ (* Author: Steven Obua, TU Muenchen *) section \Various algebraic structures combined with a lattice\ theory Lattice_Algebras imports Complex_Main begin class semilattice_inf_ab_group_add = ordered_ab_group_add + semilattice_inf begin lemma add_inf_distrib_left: "a + inf b c = inf (a + b) (a + c)" - apply (rule antisym) + apply (rule order.antisym) apply (simp_all add: le_infI) apply (rule add_le_imp_le_left [of "uminus a"]) apply (simp only: add.assoc [symmetric], simp add: diff_le_eq add.commute) done lemma add_inf_distrib_right: "inf a b + c = inf (a + c) (b + c)" proof - have "c + inf a b = inf (c + a) (c + b)" by (simp add: add_inf_distrib_left) then show ?thesis by (simp add: add.commute) qed end class semilattice_sup_ab_group_add = ordered_ab_group_add + semilattice_sup begin lemma add_sup_distrib_left: "a + sup b c = sup (a + b) (a + c)" - apply (rule antisym) + apply (rule order.antisym) apply (rule add_le_imp_le_left [of "uminus a"]) apply (simp only: add.assoc [symmetric], simp) apply (simp add: le_diff_eq add.commute) apply (rule le_supI) apply (rule add_le_imp_le_left [of "a"], simp only: add.assoc[symmetric], simp)+ done lemma add_sup_distrib_right: "sup a b + c = sup (a + c) (b + c)" proof - have "c + sup a b = sup (c+a) (c+b)" by (simp add: add_sup_distrib_left) then show ?thesis by (simp add: add.commute) qed end class lattice_ab_group_add = ordered_ab_group_add + lattice begin subclass semilattice_inf_ab_group_add .. subclass semilattice_sup_ab_group_add .. lemmas add_sup_inf_distribs = add_inf_distrib_right add_inf_distrib_left add_sup_distrib_right add_sup_distrib_left lemma inf_eq_neg_sup: "inf a b = - sup (- a) (- b)" proof (rule inf_unique) fix a b c :: 'a show "- sup (- a) (- b) \ a" by (rule add_le_imp_le_right [of _ "sup (uminus a) (uminus b)"]) (simp, simp add: add_sup_distrib_left) show "- sup (-a) (-b) \ b" by (rule add_le_imp_le_right [of _ "sup (uminus a) (uminus b)"]) (simp, simp add: add_sup_distrib_left) assume "a \ b" "a \ c" then show "a \ - sup (-b) (-c)" by (subst neg_le_iff_le [symmetric]) (simp add: le_supI) qed lemma sup_eq_neg_inf: "sup a b = - inf (- a) (- b)" proof (rule sup_unique) fix a b c :: 'a show "a \ - inf (- a) (- b)" by (rule add_le_imp_le_right [of _ "inf (uminus a) (uminus b)"]) (simp, simp add: add_inf_distrib_left) show "b \ - inf (- a) (- b)" by (rule add_le_imp_le_right [of _ "inf (uminus a) (uminus b)"]) (simp, simp add: add_inf_distrib_left) show "- inf (- a) (- b) \ c" if "a \ c" "b \ c" using that by (subst neg_le_iff_le [symmetric]) (simp add: le_infI) qed lemma neg_inf_eq_sup: "- inf a b = sup (- a) (- b)" by (simp add: inf_eq_neg_sup) lemma diff_inf_eq_sup: "a - inf b c = a + sup (- b) (- c)" using neg_inf_eq_sup [of b c, symmetric] by simp lemma neg_sup_eq_inf: "- sup a b = inf (- a) (- b)" by (simp add: sup_eq_neg_inf) lemma diff_sup_eq_inf: "a - sup b c = a + inf (- b) (- c)" using neg_sup_eq_inf [of b c, symmetric] by simp lemma add_eq_inf_sup: "a + b = sup a b + inf a b" proof - have "0 = - inf 0 (a - b) + inf (a - b) 0" by (simp add: inf_commute) then have "0 = sup 0 (b - a) + inf (a - b) 0" by (simp add: inf_eq_neg_sup) then have "0 = (- a + sup a b) + (inf a b + (- b))" by (simp only: add_sup_distrib_left add_inf_distrib_right) simp then show ?thesis by (simp add: algebra_simps) qed subsection \Positive Part, Negative Part, Absolute Value\ definition nprt :: "'a \ 'a" where "nprt x = inf x 0" definition pprt :: "'a \ 'a" where "pprt x = sup x 0" lemma pprt_neg: "pprt (- x) = - nprt x" proof - have "sup (- x) 0 = sup (- x) (- 0)" by (simp only: minus_zero) also have "\ = - inf x 0" by (simp only: neg_inf_eq_sup) finally have "sup (- x) 0 = - inf x 0" . then show ?thesis by (simp only: pprt_def nprt_def) qed lemma nprt_neg: "nprt (- x) = - pprt x" proof - from pprt_neg have "pprt (- (- x)) = - nprt (- x)" . then have "pprt x = - nprt (- x)" by simp then show ?thesis by simp qed lemma prts: "a = pprt a + nprt a" by (simp add: pprt_def nprt_def flip: add_eq_inf_sup) lemma zero_le_pprt[simp]: "0 \ pprt a" by (simp add: pprt_def) lemma nprt_le_zero[simp]: "nprt a \ 0" by (simp add: nprt_def) lemma le_eq_neg: "a \ - b \ a + b \ 0" (is "?lhs = ?rhs") proof assume ?lhs show ?rhs by (rule add_le_imp_le_right[of _ "uminus b" _]) (simp add: add.assoc \?lhs\) next assume ?rhs show ?lhs by (rule add_le_imp_le_right[of _ "b" _]) (simp add: \?rhs\) qed lemma pprt_0[simp]: "pprt 0 = 0" by (simp add: pprt_def) lemma nprt_0[simp]: "nprt 0 = 0" by (simp add: nprt_def) lemma pprt_eq_id [simp, no_atp]: "0 \ x \ pprt x = x" by (simp add: pprt_def sup_absorb1) lemma nprt_eq_id [simp, no_atp]: "x \ 0 \ nprt x = x" by (simp add: nprt_def inf_absorb1) lemma pprt_eq_0 [simp, no_atp]: "x \ 0 \ pprt x = 0" by (simp add: pprt_def sup_absorb2) lemma nprt_eq_0 [simp, no_atp]: "0 \ x \ nprt x = 0" by (simp add: nprt_def inf_absorb2) lemma sup_0_imp_0: assumes "sup a (- a) = 0" shows "a = 0" proof - have pos: "0 \ a" if "sup a (- a) = 0" for a :: 'a proof - from that have "sup a (- a) + a = a" by simp then have "sup (a + a) 0 = a" by (simp add: add_sup_distrib_right) then have "sup (a + a) 0 \ a" by simp then show ?thesis by (blast intro: order_trans inf_sup_ord) qed from assms have **: "sup (-a) (-(-a)) = 0" by (simp add: sup_commute) from pos[OF assms] pos[OF **] show "a = 0" by simp qed lemma inf_0_imp_0: "inf a (- a) = 0 \ a = 0" apply (simp add: inf_eq_neg_sup) apply (simp add: sup_commute) apply (erule sup_0_imp_0) done lemma inf_0_eq_0 [simp, no_atp]: "inf a (- a) = 0 \ a = 0" apply (rule iffI) apply (erule inf_0_imp_0) apply simp done lemma sup_0_eq_0 [simp, no_atp]: "sup a (- a) = 0 \ a = 0" apply (rule iffI) apply (erule sup_0_imp_0) apply simp done lemma zero_le_double_add_iff_zero_le_single_add [simp]: "0 \ a + a \ 0 \ a" (is "?lhs \ ?rhs") proof show ?rhs if ?lhs proof - from that have a: "inf (a + a) 0 = 0" by (simp add: inf_commute inf_absorb1) have "inf a 0 + inf a 0 = inf (inf (a + a) 0) a" (is "?l = _") by (simp add: add_sup_inf_distribs inf_aci) then have "?l = 0 + inf a 0" by (simp add: a, simp add: inf_commute) then have "inf a 0 = 0" by (simp only: add_right_cancel) then show ?thesis unfolding le_iff_inf by (simp add: inf_commute) qed show ?lhs if ?rhs by (simp add: add_mono[OF that that, simplified]) qed lemma double_zero [simp]: "a + a = 0 \ a = 0" - using add_nonneg_eq_0_iff eq_iff by auto + using add_nonneg_eq_0_iff order.eq_iff by auto lemma zero_less_double_add_iff_zero_less_single_add [simp]: "0 < a + a \ 0 < a" by (meson le_less_trans less_add_same_cancel2 less_le_not_le zero_le_double_add_iff_zero_le_single_add) lemma double_add_le_zero_iff_single_add_le_zero [simp]: "a + a \ 0 \ a \ 0" proof - have "a + a \ 0 \ 0 \ - (a + a)" by (subst le_minus_iff) simp moreover have "\ \ a \ 0" by (simp only: minus_add_distrib zero_le_double_add_iff_zero_le_single_add) simp ultimately show ?thesis by blast qed lemma double_add_less_zero_iff_single_less_zero [simp]: "a + a < 0 \ a < 0" proof - have "a + a < 0 \ 0 < - (a + a)" by (subst less_minus_iff) simp moreover have "\ \ a < 0" by (simp only: minus_add_distrib zero_less_double_add_iff_zero_less_single_add) simp ultimately show ?thesis by blast qed declare neg_inf_eq_sup [simp] and neg_sup_eq_inf [simp] and diff_inf_eq_sup [simp] and diff_sup_eq_inf [simp] lemma le_minus_self_iff: "a \ - a \ a \ 0" proof - from add_le_cancel_left [of "uminus a" "plus a a" zero] have "a \ - a \ a + a \ 0" by (simp flip: add.assoc) then show ?thesis by simp qed lemma minus_le_self_iff: "- a \ a \ 0 \ a" proof - have "- a \ a \ 0 \ a + a" using add_le_cancel_left [of "uminus a" zero "plus a a"] by (simp flip: add.assoc) then show ?thesis by simp qed lemma zero_le_iff_zero_nprt: "0 \ a \ nprt a = 0" unfolding le_iff_inf by (simp add: nprt_def inf_commute) lemma le_zero_iff_zero_pprt: "a \ 0 \ pprt a = 0" unfolding le_iff_sup by (simp add: pprt_def sup_commute) lemma le_zero_iff_pprt_id: "0 \ a \ pprt a = a" unfolding le_iff_sup by (simp add: pprt_def sup_commute) lemma zero_le_iff_nprt_id: "a \ 0 \ nprt a = a" unfolding le_iff_inf by (simp add: nprt_def inf_commute) lemma pprt_mono [simp, no_atp]: "a \ b \ pprt a \ pprt b" unfolding le_iff_sup by (simp add: pprt_def sup_aci sup_assoc [symmetric, of a]) lemma nprt_mono [simp, no_atp]: "a \ b \ nprt a \ nprt b" unfolding le_iff_inf by (simp add: nprt_def inf_aci inf_assoc [symmetric, of a]) end lemmas add_sup_inf_distribs = add_inf_distrib_right add_inf_distrib_left add_sup_distrib_right add_sup_distrib_left class lattice_ab_group_add_abs = lattice_ab_group_add + abs + assumes abs_lattice: "\a\ = sup a (- a)" begin lemma abs_prts: "\a\ = pprt a - nprt a" proof - have "0 \ \a\" proof - have a: "a \ \a\" and b: "- a \ \a\" by (auto simp add: abs_lattice) show ?thesis by (rule add_mono [OF a b, simplified]) qed then have "0 \ sup a (- a)" unfolding abs_lattice . then have "sup (sup a (- a)) 0 = sup a (- a)" by (rule sup_absorb1) then show ?thesis by (simp add: add_sup_inf_distribs ac_simps pprt_def nprt_def abs_lattice) qed subclass ordered_ab_group_add_abs proof have abs_ge_zero [simp]: "0 \ \a\" for a proof - have a: "a \ \a\" and b: "- a \ \a\" by (auto simp add: abs_lattice) show "0 \ \a\" by (rule add_mono [OF a b, simplified]) qed have abs_leI: "a \ b \ - a \ b \ \a\ \ b" for a b by (simp add: abs_lattice le_supI) fix a b show "0 \ \a\" by simp show "a \ \a\" by (auto simp add: abs_lattice) show "\-a\ = \a\" by (simp add: abs_lattice sup_commute) show "- a \ b \ \a\ \ b" if "a \ b" using that by (rule abs_leI) show "\a + b\ \ \a\ + \b\" proof - have g: "\a\ + \b\ = sup (a + b) (sup (- a - b) (sup (- a + b) (a + (- b))))" (is "_ = sup ?m ?n") by (simp add: abs_lattice add_sup_inf_distribs ac_simps) have a: "a + b \ sup ?m ?n" by simp have b: "- a - b \ ?n" by simp have c: "?n \ sup ?m ?n" by simp from b c have d: "- a - b \ sup ?m ?n" by (rule order_trans) have e: "- a - b = - (a + b)" by simp from a d e have "\a + b\ \ sup ?m ?n" apply - apply (drule abs_leI) apply (simp_all only: algebra_simps minus_add) apply (metis add_uminus_conv_diff d sup_commute uminus_add_conv_diff) done with g[symmetric] show ?thesis by simp qed qed end lemma sup_eq_if: fixes a :: "'a::{lattice_ab_group_add,linorder}" shows "sup a (- a) = (if a < 0 then - a else a)" using add_le_cancel_right [of a a "- a", symmetric, simplified] and add_le_cancel_right [of "-a" a a, symmetric, simplified] by (auto simp: sup_max max.absorb1 max.absorb2) lemma abs_if_lattice: fixes a :: "'a::{lattice_ab_group_add_abs,linorder}" shows "\a\ = (if a < 0 then - a else a)" by auto lemma estimate_by_abs: fixes a b c :: "'a::lattice_ab_group_add_abs" assumes "a + b \ c" shows "a \ c + \b\" proof - from assms have "a \ c + (- b)" by (simp add: algebra_simps) have "- b \ \b\" by (rule abs_ge_minus_self) then have "c + (- b) \ c + \b\" by (rule add_left_mono) with \a \ c + (- b)\ show ?thesis by (rule order_trans) qed class lattice_ring = ordered_ring + lattice_ab_group_add_abs begin subclass semilattice_inf_ab_group_add .. subclass semilattice_sup_ab_group_add .. end lemma abs_le_mult: fixes a b :: "'a::lattice_ring" shows "\a * b\ \ \a\ * \b\" proof - let ?x = "pprt a * pprt b - pprt a * nprt b - nprt a * pprt b + nprt a * nprt b" let ?y = "pprt a * pprt b + pprt a * nprt b + nprt a * pprt b + nprt a * nprt b" have a: "\a\ * \b\ = ?x" by (simp only: abs_prts[of a] abs_prts[of b] algebra_simps) have bh: "u = a \ v = b \ u * v = pprt a * pprt b + pprt a * nprt b + nprt a * pprt b + nprt a * nprt b" for u v :: 'a apply (subst prts[of u], subst prts[of v]) apply (simp add: algebra_simps) done note b = this[OF refl[of a] refl[of b]] have xy: "- ?x \ ?y" apply simp apply (metis (full_types) add_increasing add_uminus_conv_diff lattice_ab_group_add_class.minus_le_self_iff minus_add_distrib mult_nonneg_nonneg mult_nonpos_nonpos nprt_le_zero zero_le_pprt) done have yx: "?y \ ?x" apply simp apply (metis (full_types) add_nonpos_nonpos add_uminus_conv_diff lattice_ab_group_add_class.le_minus_self_iff minus_add_distrib mult_nonneg_nonpos mult_nonpos_nonneg nprt_le_zero zero_le_pprt) done have i1: "a * b \ \a\ * \b\" by (simp only: a b yx) have i2: "- (\a\ * \b\) \ a * b" by (simp only: a b xy) show ?thesis apply (rule abs_leI) apply (simp add: i1) apply (simp add: i2[simplified minus_le_iff]) done qed instance lattice_ring \ ordered_ring_abs proof fix a b :: "'a::lattice_ring" assume a: "(0 \ a \ a \ 0) \ (0 \ b \ b \ 0)" show "\a * b\ = \a\ * \b\" proof - have s: "(0 \ a * b) \ (a * b \ 0)" apply auto apply (rule_tac split_mult_pos_le) apply (rule_tac contrapos_np[of "a * b \ 0"]) apply simp apply (rule_tac split_mult_neg_le) using a apply blast done have mulprts: "a * b = (pprt a + nprt a) * (pprt b + nprt b)" by (simp flip: prts) show ?thesis proof (cases "0 \ a * b") case True then show ?thesis apply (simp_all add: mulprts abs_prts) using a apply (auto simp add: algebra_simps iffD1[OF zero_le_iff_zero_nprt] iffD1[OF le_zero_iff_zero_pprt] iffD1[OF le_zero_iff_pprt_id] iffD1[OF zero_le_iff_nprt_id]) apply(drule (1) mult_nonneg_nonpos[of a b], simp) apply(drule (1) mult_nonneg_nonpos2[of b a], simp) done next case False with s have "a * b \ 0" by simp then show ?thesis apply (simp_all add: mulprts abs_prts) apply (insert a) apply (auto simp add: algebra_simps) apply(drule (1) mult_nonneg_nonneg[of a b],simp) apply(drule (1) mult_nonpos_nonpos[of a b],simp) done qed qed qed lemma mult_le_prts: fixes a b :: "'a::lattice_ring" assumes "a1 \ a" and "a \ a2" and "b1 \ b" and "b \ b2" shows "a * b \ pprt a2 * pprt b2 + pprt a1 * nprt b2 + nprt a2 * pprt b1 + nprt a1 * nprt b1" proof - have "a * b = (pprt a + nprt a) * (pprt b + nprt b)" by (subst prts[symmetric])+ simp then have "a * b = pprt a * pprt b + pprt a * nprt b + nprt a * pprt b + nprt a * nprt b" by (simp add: algebra_simps) moreover have "pprt a * pprt b \ pprt a2 * pprt b2" by (simp_all add: assms mult_mono) moreover have "pprt a * nprt b \ pprt a1 * nprt b2" proof - have "pprt a * nprt b \ pprt a * nprt b2" by (simp add: mult_left_mono assms) moreover have "pprt a * nprt b2 \ pprt a1 * nprt b2" by (simp add: mult_right_mono_neg assms) ultimately show ?thesis by simp qed moreover have "nprt a * pprt b \ nprt a2 * pprt b1" proof - have "nprt a * pprt b \ nprt a2 * pprt b" by (simp add: mult_right_mono assms) moreover have "nprt a2 * pprt b \ nprt a2 * pprt b1" by (simp add: mult_left_mono_neg assms) ultimately show ?thesis by simp qed moreover have "nprt a * nprt b \ nprt a1 * nprt b1" proof - have "nprt a * nprt b \ nprt a * nprt b1" by (simp add: mult_left_mono_neg assms) moreover have "nprt a * nprt b1 \ nprt a1 * nprt b1" by (simp add: mult_right_mono_neg assms) ultimately show ?thesis by simp qed ultimately show ?thesis by - (rule add_mono | simp)+ qed lemma mult_ge_prts: fixes a b :: "'a::lattice_ring" assumes "a1 \ a" and "a \ a2" and "b1 \ b" and "b \ b2" shows "a * b \ nprt a1 * pprt b2 + nprt a2 * nprt b2 + pprt a1 * pprt b1 + pprt a2 * nprt b1" proof - from assms have a1: "- a2 \ -a" by auto from assms have a2: "- a \ -a1" by auto from mult_le_prts[of "- a2" "- a" "- a1" "b1" b "b2", OF a1 a2 assms(3) assms(4), simplified nprt_neg pprt_neg] have le: "- (a * b) \ - nprt a1 * pprt b2 + - nprt a2 * nprt b2 + - pprt a1 * pprt b1 + - pprt a2 * nprt b1" by simp then have "- (- nprt a1 * pprt b2 + - nprt a2 * nprt b2 + - pprt a1 * pprt b1 + - pprt a2 * nprt b1) \ a * b" by (simp only: minus_le_iff) then show ?thesis by (simp add: algebra_simps) qed instance int :: lattice_ring proof show "\k\ = sup k (- k)" for k :: int by (auto simp add: sup_int_def) qed instance real :: lattice_ring proof show "\a\ = sup a (- a)" for a :: real by (auto simp add: sup_real_def) qed end diff --git a/src/HOL/Library/Multiset.thy b/src/HOL/Library/Multiset.thy --- a/src/HOL/Library/Multiset.thy +++ b/src/HOL/Library/Multiset.thy @@ -1,3950 +1,3954 @@ (* Title: HOL/Library/Multiset.thy Author: Tobias Nipkow, Markus Wenzel, Lawrence C Paulson, Norbert Voelker Author: Andrei Popescu, TU Muenchen Author: Jasmin Blanchette, Inria, LORIA, MPII Author: Dmitriy Traytel, TU Muenchen Author: Mathias Fleury, MPII *) section \(Finite) Multisets\ theory Multiset imports Cancellation begin subsection \The type of multisets\ typedef 'a multiset = \{f :: 'a \ nat. finite {x. f x > 0}}\ morphisms count Abs_multiset proof show \(\x. 0::nat) \ {f. finite {x. f x > 0}}\ by simp qed setup_lifting type_definition_multiset lemma count_Abs_multiset: \count (Abs_multiset f) = f\ if \finite {x. f x > 0}\ by (rule Abs_multiset_inverse) (simp add: that) lemma multiset_eq_iff: "M = N \ (\a. count M a = count N a)" by (simp only: count_inject [symmetric] fun_eq_iff) lemma multiset_eqI: "(\x. count A x = count B x) \ A = B" using multiset_eq_iff by auto text \Preservation of the representing set \<^term>\multiset\.\ lemma diff_preserves_multiset: \finite {x. 0 < M x - N x}\ if \finite {x. 0 < M x}\ for M N :: \'a \ nat\ using that by (rule rev_finite_subset) auto lemma filter_preserves_multiset: \finite {x. 0 < (if P x then M x else 0)}\ if \finite {x. 0 < M x}\ for M N :: \'a \ nat\ using that by (rule rev_finite_subset) auto lemmas in_multiset = diff_preserves_multiset filter_preserves_multiset subsection \Representing multisets\ text \Multiset enumeration\ instantiation multiset :: (type) cancel_comm_monoid_add begin lift_definition zero_multiset :: \'a multiset\ is \\a. 0\ by simp abbreviation empty_mset :: \'a multiset\ (\{#}\) where \empty_mset \ 0\ lift_definition plus_multiset :: \'a multiset \ 'a multiset \ 'a multiset\ is \\M N a. M a + N a\ by simp lift_definition minus_multiset :: \'a multiset \ 'a multiset \ 'a multiset\ is \\M N a. M a - N a\ by (rule diff_preserves_multiset) instance by (standard; transfer) (simp_all add: fun_eq_iff) end context begin qualified definition is_empty :: "'a multiset \ bool" where [code_abbrev]: "is_empty A \ A = {#}" end lemma add_mset_in_multiset: \finite {x. 0 < (if x = a then Suc (M x) else M x)}\ if \finite {x. 0 < M x}\ using that by (simp add: flip: insert_Collect) lift_definition add_mset :: "'a \ 'a multiset \ 'a multiset" is "\a M b. if b = a then Suc (M b) else M b" by (rule add_mset_in_multiset) syntax "_multiset" :: "args \ 'a multiset" ("{#(_)#}") translations "{#x, xs#}" == "CONST add_mset x {#xs#}" "{#x#}" == "CONST add_mset x {#}" lemma count_empty [simp]: "count {#} a = 0" by (simp add: zero_multiset.rep_eq) lemma count_add_mset [simp]: "count (add_mset b A) a = (if b = a then Suc (count A a) else count A a)" by (simp add: add_mset.rep_eq) lemma count_single: "count {#b#} a = (if b = a then 1 else 0)" by simp lemma add_mset_not_empty [simp]: \add_mset a A \ {#}\ and empty_not_add_mset [simp]: "{#} \ add_mset a A" by (auto simp: multiset_eq_iff) lemma add_mset_add_mset_same_iff [simp]: "add_mset a A = add_mset a B \ A = B" by (auto simp: multiset_eq_iff) lemma add_mset_commute: "add_mset x (add_mset y M) = add_mset y (add_mset x M)" by (auto simp: multiset_eq_iff) subsection \Basic operations\ subsubsection \Conversion to set and membership\ definition set_mset :: \'a multiset \ 'a set\ where \set_mset M = {x. count M x > 0}\ abbreviation member_mset :: \'a \ 'a multiset \ bool\ where \member_mset a M \ a \ set_mset M\ notation member_mset (\'(\#')\) and member_mset (\(_/ \# _)\ [50, 51] 50) notation (ASCII) member_mset (\'(:#')\) and member_mset (\(_/ :# _)\ [50, 51] 50) abbreviation not_member_mset :: \'a \ 'a multiset \ bool\ where \not_member_mset a M \ a \ set_mset M\ notation not_member_mset (\'(\#')\) and not_member_mset (\(_/ \# _)\ [50, 51] 50) notation (ASCII) not_member_mset (\'(~:#')\) and not_member_mset (\(_/ ~:# _)\ [50, 51] 50) context begin qualified abbreviation Ball :: "'a multiset \ ('a \ bool) \ bool" where "Ball M \ Set.Ball (set_mset M)" qualified abbreviation Bex :: "'a multiset \ ('a \ bool) \ bool" where "Bex M \ Set.Bex (set_mset M)" end syntax "_MBall" :: "pttrn \ 'a set \ bool \ bool" ("(3\_\#_./ _)" [0, 0, 10] 10) "_MBex" :: "pttrn \ 'a set \ bool \ bool" ("(3\_\#_./ _)" [0, 0, 10] 10) syntax (ASCII) "_MBall" :: "pttrn \ 'a set \ bool \ bool" ("(3\_:#_./ _)" [0, 0, 10] 10) "_MBex" :: "pttrn \ 'a set \ bool \ bool" ("(3\_:#_./ _)" [0, 0, 10] 10) translations "\x\#A. P" \ "CONST Multiset.Ball A (\x. P)" "\x\#A. P" \ "CONST Multiset.Bex A (\x. P)" print_translation \ [Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\Multiset.Ball\ \<^syntax_const>\_MBall\, Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\Multiset.Bex\ \<^syntax_const>\_MBex\] \ \ \to avoid eta-contraction of body\ lemma count_eq_zero_iff: "count M x = 0 \ x \# M" by (auto simp add: set_mset_def) lemma not_in_iff: "x \# M \ count M x = 0" by (auto simp add: count_eq_zero_iff) lemma count_greater_zero_iff [simp]: "count M x > 0 \ x \# M" by (auto simp add: set_mset_def) lemma count_inI: assumes "count M x = 0 \ False" shows "x \# M" proof (rule ccontr) assume "x \# M" with assms show False by (simp add: not_in_iff) qed lemma in_countE: assumes "x \# M" obtains n where "count M x = Suc n" proof - from assms have "count M x > 0" by simp then obtain n where "count M x = Suc n" using gr0_conv_Suc by blast with that show thesis . qed lemma count_greater_eq_Suc_zero_iff [simp]: "count M x \ Suc 0 \ x \# M" by (simp add: Suc_le_eq) lemma count_greater_eq_one_iff [simp]: "count M x \ 1 \ x \# M" by simp lemma set_mset_empty [simp]: "set_mset {#} = {}" by (simp add: set_mset_def) lemma set_mset_single: "set_mset {#b#} = {b}" by (simp add: set_mset_def) lemma set_mset_eq_empty_iff [simp]: "set_mset M = {} \ M = {#}" by (auto simp add: multiset_eq_iff count_eq_zero_iff) lemma finite_set_mset [iff]: "finite (set_mset M)" using count [of M] by simp lemma set_mset_add_mset_insert [simp]: \set_mset (add_mset a A) = insert a (set_mset A)\ by (auto simp flip: count_greater_eq_Suc_zero_iff split: if_splits) lemma multiset_nonemptyE [elim]: assumes "A \ {#}" obtains x where "x \# A" proof - have "\x. x \# A" by (rule ccontr) (insert assms, auto) with that show ?thesis by blast qed subsubsection \Union\ lemma count_union [simp]: "count (M + N) a = count M a + count N a" by (simp add: plus_multiset.rep_eq) lemma set_mset_union [simp]: "set_mset (M + N) = set_mset M \ set_mset N" by (simp only: set_eq_iff count_greater_zero_iff [symmetric] count_union) simp lemma union_mset_add_mset_left [simp]: "add_mset a A + B = add_mset a (A + B)" by (auto simp: multiset_eq_iff) lemma union_mset_add_mset_right [simp]: "A + add_mset a B = add_mset a (A + B)" by (auto simp: multiset_eq_iff) lemma add_mset_add_single: \add_mset a A = A + {#a#}\ by (subst union_mset_add_mset_right, subst add.comm_neutral) standard subsubsection \Difference\ instance multiset :: (type) comm_monoid_diff by standard (transfer; simp add: fun_eq_iff) lemma count_diff [simp]: "count (M - N) a = count M a - count N a" by (simp add: minus_multiset.rep_eq) lemma add_mset_diff_bothsides: \add_mset a M - add_mset a A = M - A\ by (auto simp: multiset_eq_iff) lemma in_diff_count: "a \# M - N \ count N a < count M a" by (simp add: set_mset_def) lemma count_in_diffI: assumes "\n. count N x = n + count M x \ False" shows "x \# M - N" proof (rule ccontr) assume "x \# M - N" then have "count N x = (count N x - count M x) + count M x" by (simp add: in_diff_count not_less) with assms show False by auto qed lemma in_diff_countE: assumes "x \# M - N" obtains n where "count M x = Suc n + count N x" proof - from assms have "count M x - count N x > 0" by (simp add: in_diff_count) then have "count M x > count N x" by simp then obtain n where "count M x = Suc n + count N x" using less_iff_Suc_add by auto with that show thesis . qed lemma in_diffD: assumes "a \# M - N" shows "a \# M" proof - have "0 \ count N a" by simp also from assms have "count N a < count M a" by (simp add: in_diff_count) finally show ?thesis by simp qed lemma set_mset_diff: "set_mset (M - N) = {a. count N a < count M a}" by (simp add: set_mset_def) lemma diff_empty [simp]: "M - {#} = M \ {#} - M = {#}" by rule (fact Groups.diff_zero, fact Groups.zero_diff) lemma diff_cancel: "A - A = {#}" by (fact Groups.diff_cancel) lemma diff_union_cancelR: "M + N - N = (M::'a multiset)" by (fact add_diff_cancel_right') lemma diff_union_cancelL: "N + M - N = (M::'a multiset)" by (fact add_diff_cancel_left') lemma diff_right_commute: fixes M N Q :: "'a multiset" shows "M - N - Q = M - Q - N" by (fact diff_right_commute) lemma diff_add: fixes M N Q :: "'a multiset" shows "M - (N + Q) = M - N - Q" by (rule sym) (fact diff_diff_add) lemma insert_DiffM [simp]: "x \# M \ add_mset x (M - {#x#}) = M" by (clarsimp simp: multiset_eq_iff) lemma insert_DiffM2: "x \# M \ (M - {#x#}) + {#x#} = M" by simp lemma diff_union_swap: "a \ b \ add_mset b (M - {#a#}) = add_mset b M - {#a#}" by (auto simp add: multiset_eq_iff) lemma diff_add_mset_swap [simp]: "b \# A \ add_mset b M - A = add_mset b (M - A)" by (auto simp add: multiset_eq_iff simp: not_in_iff) lemma diff_union_swap2 [simp]: "y \# M \ add_mset x M - {#y#} = add_mset x (M - {#y#})" by (metis add_mset_diff_bothsides diff_union_swap diff_zero insert_DiffM) lemma diff_diff_add_mset [simp]: "(M::'a multiset) - N - P = M - (N + P)" by (rule diff_diff_add) lemma diff_union_single_conv: "a \# J \ I + J - {#a#} = I + (J - {#a#})" by (simp add: multiset_eq_iff Suc_le_eq) lemma mset_add [elim?]: assumes "a \# A" obtains B where "A = add_mset a B" proof - from assms have "A = add_mset a (A - {#a#})" by simp with that show thesis . qed lemma union_iff: "a \# A + B \ a \# A \ a \# B" by auto subsubsection \Min and Max\ abbreviation Min_mset :: "'a::linorder multiset \ 'a" where "Min_mset m \ Min (set_mset m)" abbreviation Max_mset :: "'a::linorder multiset \ 'a" where "Max_mset m \ Max (set_mset m)" subsubsection \Equality of multisets\ lemma single_eq_single [simp]: "{#a#} = {#b#} \ a = b" by (auto simp add: multiset_eq_iff) lemma union_eq_empty [iff]: "M + N = {#} \ M = {#} \ N = {#}" by (auto simp add: multiset_eq_iff) lemma empty_eq_union [iff]: "{#} = M + N \ M = {#} \ N = {#}" by (auto simp add: multiset_eq_iff) lemma multi_self_add_other_not_self [simp]: "M = add_mset x M \ False" by (auto simp add: multiset_eq_iff) lemma add_mset_remove_trivial [simp]: \add_mset x M - {#x#} = M\ by (auto simp: multiset_eq_iff) lemma diff_single_trivial: "\ x \# M \ M - {#x#} = M" by (auto simp add: multiset_eq_iff not_in_iff) lemma diff_single_eq_union: "x \# M \ M - {#x#} = N \ M = add_mset x N" by auto lemma union_single_eq_diff: "add_mset x M = N \ M = N - {#x#}" unfolding add_mset_add_single[of _ M] by (fact add_implies_diff) lemma union_single_eq_member: "add_mset x M = N \ x \# N" by auto lemma add_mset_remove_trivial_If: "add_mset a (N - {#a#}) = (if a \# N then N else add_mset a N)" by (simp add: diff_single_trivial) lemma add_mset_remove_trivial_eq: \N = add_mset a (N - {#a#}) \ a \# N\ by (auto simp: add_mset_remove_trivial_If) lemma union_is_single: "M + N = {#a#} \ M = {#a#} \ N = {#} \ M = {#} \ N = {#a#}" (is "?lhs = ?rhs") proof show ?lhs if ?rhs using that by auto show ?rhs if ?lhs by (metis Multiset.diff_cancel add.commute add_diff_cancel_left' diff_add_zero diff_single_trivial insert_DiffM that) qed lemma single_is_union: "{#a#} = M + N \ {#a#} = M \ N = {#} \ M = {#} \ {#a#} = N" by (auto simp add: eq_commute [of "{#a#}" "M + N"] union_is_single) lemma add_eq_conv_diff: "add_mset a M = add_mset b N \ M = N \ a = b \ M = add_mset b (N - {#a#}) \ N = add_mset a (M - {#b#})" (is "?lhs \ ?rhs") (* shorter: by (simp add: multiset_eq_iff) fastforce *) proof show ?lhs if ?rhs using that by (auto simp add: add_mset_commute[of a b]) show ?rhs if ?lhs proof (cases "a = b") case True with \?lhs\ show ?thesis by simp next case False from \?lhs\ have "a \# add_mset b N" by (rule union_single_eq_member) with False have "a \# N" by auto moreover from \?lhs\ have "M = add_mset b N - {#a#}" by (rule union_single_eq_diff) moreover note False ultimately show ?thesis by (auto simp add: diff_right_commute [of _ "{#a#}"]) qed qed lemma add_mset_eq_single [iff]: "add_mset b M = {#a#} \ b = a \ M = {#}" by (auto simp: add_eq_conv_diff) lemma single_eq_add_mset [iff]: "{#a#} = add_mset b M \ b = a \ M = {#}" by (auto simp: add_eq_conv_diff) lemma insert_noteq_member: assumes BC: "add_mset b B = add_mset c C" and bnotc: "b \ c" shows "c \# B" proof - have "c \# add_mset c C" by simp have nc: "\ c \# {#b#}" using bnotc by simp then have "c \# add_mset b B" using BC by simp then show "c \# B" using nc by simp qed lemma add_eq_conv_ex: "(add_mset a M = add_mset b N) = (M = N \ a = b \ (\K. M = add_mset b K \ N = add_mset a K))" by (auto simp add: add_eq_conv_diff) lemma multi_member_split: "x \# M \ \A. M = add_mset x A" by (rule exI [where x = "M - {#x#}"]) simp lemma multiset_add_sub_el_shuffle: assumes "c \# B" and "b \ c" shows "add_mset b (B - {#c#}) = add_mset b B - {#c#}" proof - from \c \# B\ obtain A where B: "B = add_mset c A" by (blast dest: multi_member_split) have "add_mset b A = add_mset c (add_mset b A) - {#c#}" by simp then have "add_mset b A = add_mset b (add_mset c A) - {#c#}" by (simp add: \b \ c\) then show ?thesis using B by simp qed lemma add_mset_eq_singleton_iff[iff]: "add_mset x M = {#y#} \ M = {#} \ x = y" by auto subsubsection \Pointwise ordering induced by count\ definition subseteq_mset :: "'a multiset \ 'a multiset \ bool" (infix "\#" 50) where "A \# B \ (\a. count A a \ count B a)" definition subset_mset :: "'a multiset \ 'a multiset \ bool" (infix "\#" 50) where "A \# B \ A \# B \ A \ B" abbreviation (input) supseteq_mset :: "'a multiset \ 'a multiset \ bool" (infix "\#" 50) where "supseteq_mset A B \ B \# A" abbreviation (input) supset_mset :: "'a multiset \ 'a multiset \ bool" (infix "\#" 50) where "supset_mset A B \ B \# A" notation (input) subseteq_mset (infix "\#" 50) and supseteq_mset (infix "\#" 50) notation (ASCII) subseteq_mset (infix "<=#" 50) and subset_mset (infix "<#" 50) and supseteq_mset (infix ">=#" 50) and supset_mset (infix ">#" 50) +global_interpretation subset_mset: ordering \(\#)\ \(\#)\ + by standard (auto simp add: subset_mset_def subseteq_mset_def multiset_eq_iff intro: order.trans order.antisym) + interpretation subset_mset: ordered_ab_semigroup_add_imp_le "(+)" "(-)" "(\#)" "(\#)" by standard (auto simp add: subset_mset_def subseteq_mset_def multiset_eq_iff intro: order_trans antisym) \ \FIXME: avoid junk stemming from type class interpretation\ interpretation subset_mset: ordered_ab_semigroup_monoid_add_imp_le "(+)" 0 "(-)" "(\#)" "(\#)" by standard \ \FIXME: avoid junk stemming from type class interpretation\ lemma mset_subset_eqI: "(\a. count A a \ count B a) \ A \# B" by (simp add: subseteq_mset_def) lemma mset_subset_eq_count: "A \# B \ count A a \ count B a" by (simp add: subseteq_mset_def) lemma mset_subset_eq_exists_conv: "(A::'a multiset) \# B \ (\C. B = A + C)" unfolding subseteq_mset_def apply (rule iffI) apply (rule exI [where x = "B - A"]) apply (auto intro: multiset_eq_iff [THEN iffD2]) done interpretation subset_mset: ordered_cancel_comm_monoid_diff "(+)" 0 "(\#)" "(\#)" "(-)" by standard (simp, fact mset_subset_eq_exists_conv) \ \FIXME: avoid junk stemming from type class interpretation\ declare subset_mset.add_diff_assoc[simp] subset_mset.add_diff_assoc2[simp] lemma mset_subset_eq_mono_add_right_cancel: "(A::'a multiset) + C \# B + C \ A \# B" by (fact subset_mset.add_le_cancel_right) lemma mset_subset_eq_mono_add_left_cancel: "C + (A::'a multiset) \# C + B \ A \# B" by (fact subset_mset.add_le_cancel_left) lemma mset_subset_eq_mono_add: "(A::'a multiset) \# B \ C \# D \ A + C \# B + D" by (fact subset_mset.add_mono) lemma mset_subset_eq_add_left: "(A::'a multiset) \# A + B" by simp lemma mset_subset_eq_add_right: "B \# (A::'a multiset) + B" by simp lemma single_subset_iff [simp]: "{#a#} \# M \ a \# M" by (auto simp add: subseteq_mset_def Suc_le_eq) lemma mset_subset_eq_single: "a \# B \ {#a#} \# B" by simp lemma mset_subset_eq_add_mset_cancel: \add_mset a A \# add_mset a B \ A \# B\ unfolding add_mset_add_single[of _ A] add_mset_add_single[of _ B] by (rule mset_subset_eq_mono_add_right_cancel) lemma multiset_diff_union_assoc: fixes A B C D :: "'a multiset" shows "C \# B \ A + B - C = A + (B - C)" by (fact subset_mset.diff_add_assoc) lemma mset_subset_eq_multiset_union_diff_commute: fixes A B C D :: "'a multiset" shows "B \# A \ A - B + C = A + C - B" by (fact subset_mset.add_diff_assoc2) lemma diff_subset_eq_self[simp]: "(M::'a multiset) - N \# M" by (simp add: subseteq_mset_def) lemma mset_subset_eqD: assumes "A \# B" and "x \# A" shows "x \# B" proof - from \x \# A\ have "count A x > 0" by simp also from \A \# B\ have "count A x \ count B x" by (simp add: subseteq_mset_def) finally show ?thesis by simp qed lemma mset_subsetD: "A \# B \ x \# A \ x \# B" by (auto intro: mset_subset_eqD [of A]) lemma set_mset_mono: "A \# B \ set_mset A \ set_mset B" by (metis mset_subset_eqD subsetI) lemma mset_subset_eq_insertD: "add_mset x A \# B \ x \# B \ A \# B" apply (rule conjI) apply (simp add: mset_subset_eqD) apply (clarsimp simp: subset_mset_def subseteq_mset_def) apply safe apply (erule_tac x = a in allE) apply (auto split: if_split_asm) done lemma mset_subset_insertD: "add_mset x A \# B \ x \# B \ A \# B" by (rule mset_subset_eq_insertD) simp lemma mset_subset_of_empty[simp]: "A \# {#} \ False" by (simp only: subset_mset.not_less_zero) lemma empty_subset_add_mset[simp]: "{#} \# add_mset x M" by (auto intro: subset_mset.gr_zeroI) lemma empty_le: "{#} \# A" by (fact subset_mset.zero_le) lemma insert_subset_eq_iff: "add_mset a A \# B \ a \# B \ A \# B - {#a#}" using le_diff_conv2 [of "Suc 0" "count B a" "count A a"] apply (auto simp add: subseteq_mset_def not_in_iff Suc_le_eq) apply (rule ccontr) apply (auto simp add: not_in_iff) done lemma insert_union_subset_iff: "add_mset a A \# B \ a \# B \ A \# B - {#a#}" by (auto simp add: insert_subset_eq_iff subset_mset_def) lemma subset_eq_diff_conv: "A - C \# B \ A \# B + C" by (simp add: subseteq_mset_def le_diff_conv) lemma multi_psub_of_add_self [simp]: "A \# add_mset x A" by (auto simp: subset_mset_def subseteq_mset_def) lemma multi_psub_self: "A \# A = False" by simp lemma mset_subset_add_mset [simp]: "add_mset x N \# add_mset x M \ N \# M" unfolding add_mset_add_single[of _ N] add_mset_add_single[of _ M] by (fact subset_mset.add_less_cancel_right) lemma mset_subset_diff_self: "c \# B \ B - {#c#} \# B" by (auto simp: subset_mset_def elim: mset_add) lemma Diff_eq_empty_iff_mset: "A - B = {#} \ A \# B" by (auto simp: multiset_eq_iff subseteq_mset_def) lemma add_mset_subseteq_single_iff[iff]: "add_mset a M \# {#b#} \ M = {#} \ a = b" proof assume A: "add_mset a M \# {#b#}" then have \a = b\ by (auto dest: mset_subset_eq_insertD) then show "M={#} \ a=b" using A by (simp add: mset_subset_eq_add_mset_cancel) qed simp subsubsection \Intersection and bounded union\ definition inter_mset :: \'a multiset \ 'a multiset \ 'a multiset\ (infixl \\#\ 70) where \A \# B = A - (A - B)\ interpretation subset_mset: semilattice_inf \(\#)\ \(\#)\ \(\#)\ proof - have [simp]: "m \ n \ m \ q \ m \ n - (n - q)" for m n q :: nat by arith show "class.semilattice_inf (\#) (\#) (\#)" by standard (auto simp add: inter_mset_def subseteq_mset_def) qed \ \FIXME: avoid junk stemming from type class interpretation\ definition union_mset :: \'a multiset \ 'a multiset \ 'a multiset\ (infixl \\#\ 70) where \A \# B = A + (B - A)\ interpretation subset_mset: semilattice_sup \(\#)\ \(\#)\ \(\#)\ proof - have [simp]: "m \ n \ q \ n \ m + (q - m) \ n" for m n q :: nat by arith show "class.semilattice_sup (\#) (\#) (\#)" by standard (auto simp add: union_mset_def subseteq_mset_def) qed \ \FIXME: avoid junk stemming from type class interpretation\ interpretation subset_mset: bounded_lattice_bot "(\#)" "(\#)" "(\#)" "(\#)" "{#}" by standard auto \ \FIXME: avoid junk stemming from type class interpretation\ subsubsection \Additional intersection facts\ lemma count_inter_mset [simp]: \count (A \# B) x = min (count A x) (count B x)\ by (simp add: inter_mset_def) lemma set_mset_inter [simp]: "set_mset (A \# B) = set_mset A \ set_mset B" by (simp only: set_mset_def) auto lemma diff_intersect_left_idem [simp]: "M - M \# N = M - N" by (simp add: multiset_eq_iff min_def) lemma diff_intersect_right_idem [simp]: "M - N \# M = M - N" by (simp add: multiset_eq_iff min_def) lemma multiset_inter_single[simp]: "a \ b \ {#a#} \# {#b#} = {#}" by (rule multiset_eqI) auto lemma multiset_union_diff_commute: assumes "B \# C = {#}" shows "A + B - C = A - C + B" proof (rule multiset_eqI) fix x from assms have "min (count B x) (count C x) = 0" by (auto simp add: multiset_eq_iff) then have "count B x = 0 \ count C x = 0" unfolding min_def by (auto split: if_splits) then show "count (A + B - C) x = count (A - C + B) x" by auto qed lemma disjunct_not_in: "A \# B = {#} \ (\a. a \# A \ a \# B)" (is "?P \ ?Q") proof assume ?P show ?Q proof fix a from \?P\ have "min (count A a) (count B a) = 0" by (simp add: multiset_eq_iff) then have "count A a = 0 \ count B a = 0" by (cases "count A a \ count B a") (simp_all add: min_def) then show "a \# A \ a \# B" by (simp add: not_in_iff) qed next assume ?Q show ?P proof (rule multiset_eqI) fix a from \?Q\ have "count A a = 0 \ count B a = 0" by (auto simp add: not_in_iff) then show "count (A \# B) a = count {#} a" by auto qed qed lemma inter_mset_empty_distrib_right: "A \# (B + C) = {#} \ A \# B = {#} \ A \# C = {#}" by (meson disjunct_not_in union_iff) lemma inter_mset_empty_distrib_left: "(A + B) \# C = {#} \ A \# C = {#} \ B \# C = {#}" by (meson disjunct_not_in union_iff) lemma add_mset_inter_add_mset [simp]: "add_mset a A \# add_mset a B = add_mset a (A \# B)" by (rule multiset_eqI) simp lemma add_mset_disjoint [simp]: "add_mset a A \# B = {#} \ a \# B \ A \# B = {#}" "{#} = add_mset a A \# B \ a \# B \ {#} = A \# B" by (auto simp: disjunct_not_in) lemma disjoint_add_mset [simp]: "B \# add_mset a A = {#} \ a \# B \ B \# A = {#}" "{#} = A \# add_mset b B \ b \# A \ {#} = A \# B" by (auto simp: disjunct_not_in) lemma inter_add_left1: "\ x \# N \ (add_mset x M) \# N = M \# N" by (simp add: multiset_eq_iff not_in_iff) lemma inter_add_left2: "x \# N \ (add_mset x M) \# N = add_mset x (M \# (N - {#x#}))" by (auto simp add: multiset_eq_iff elim: mset_add) lemma inter_add_right1: "\ x \# N \ N \# (add_mset x M) = N \# M" by (simp add: multiset_eq_iff not_in_iff) lemma inter_add_right2: "x \# N \ N \# (add_mset x M) = add_mset x ((N - {#x#}) \# M)" by (auto simp add: multiset_eq_iff elim: mset_add) lemma disjunct_set_mset_diff: assumes "M \# N = {#}" shows "set_mset (M - N) = set_mset M" proof (rule set_eqI) fix a from assms have "a \# M \ a \# N" by (simp add: disjunct_not_in) then show "a \# M - N \ a \# M" by (auto dest: in_diffD) (simp add: in_diff_count not_in_iff) qed lemma at_most_one_mset_mset_diff: assumes "a \# M - {#a#}" shows "set_mset (M - {#a#}) = set_mset M - {a}" using assms by (auto simp add: not_in_iff in_diff_count set_eq_iff) lemma more_than_one_mset_mset_diff: assumes "a \# M - {#a#}" shows "set_mset (M - {#a#}) = set_mset M" proof (rule set_eqI) fix b have "Suc 0 < count M b \ count M b > 0" by arith then show "b \# M - {#a#} \ b \# M" using assms by (auto simp add: in_diff_count) qed lemma inter_iff: "a \# A \# B \ a \# A \ a \# B" by simp lemma inter_union_distrib_left: "A \# B + C = (A + C) \# (B + C)" by (simp add: multiset_eq_iff min_add_distrib_left) lemma inter_union_distrib_right: "C + A \# B = (C + A) \# (C + B)" using inter_union_distrib_left [of A B C] by (simp add: ac_simps) lemma inter_subset_eq_union: "A \# B \# A + B" by (auto simp add: subseteq_mset_def) subsubsection \Additional bounded union facts\ lemma count_union_mset [simp]: \count (A \# B) x = max (count A x) (count B x)\ by (simp add: union_mset_def) lemma set_mset_sup [simp]: \set_mset (A \# B) = set_mset A \ set_mset B\ by (simp only: set_mset_def) (auto simp add: less_max_iff_disj) lemma sup_union_left1 [simp]: "\ x \# N \ (add_mset x M) \# N = add_mset x (M \# N)" by (simp add: multiset_eq_iff not_in_iff) lemma sup_union_left2: "x \# N \ (add_mset x M) \# N = add_mset x (M \# (N - {#x#}))" by (simp add: multiset_eq_iff) lemma sup_union_right1 [simp]: "\ x \# N \ N \# (add_mset x M) = add_mset x (N \# M)" by (simp add: multiset_eq_iff not_in_iff) lemma sup_union_right2: "x \# N \ N \# (add_mset x M) = add_mset x ((N - {#x#}) \# M)" by (simp add: multiset_eq_iff) lemma sup_union_distrib_left: "A \# B + C = (A + C) \# (B + C)" by (simp add: multiset_eq_iff max_add_distrib_left) lemma union_sup_distrib_right: "C + A \# B = (C + A) \# (C + B)" using sup_union_distrib_left [of A B C] by (simp add: ac_simps) lemma union_diff_inter_eq_sup: "A + B - A \# B = A \# B" by (auto simp add: multiset_eq_iff) lemma union_diff_sup_eq_inter: "A + B - A \# B = A \# B" by (auto simp add: multiset_eq_iff) lemma add_mset_union: \add_mset a A \# add_mset a B = add_mset a (A \# B)\ by (auto simp: multiset_eq_iff max_def) subsection \Replicate and repeat operations\ definition replicate_mset :: "nat \ 'a \ 'a multiset" where "replicate_mset n x = (add_mset x ^^ n) {#}" lemma replicate_mset_0[simp]: "replicate_mset 0 x = {#}" unfolding replicate_mset_def by simp lemma replicate_mset_Suc [simp]: "replicate_mset (Suc n) x = add_mset x (replicate_mset n x)" unfolding replicate_mset_def by (induct n) (auto intro: add.commute) lemma count_replicate_mset[simp]: "count (replicate_mset n x) y = (if y = x then n else 0)" unfolding replicate_mset_def by (induct n) auto lift_definition repeat_mset :: \nat \ 'a multiset \ 'a multiset\ is \\n M a. n * M a\ by simp lemma count_repeat_mset [simp]: "count (repeat_mset i A) a = i * count A a" by transfer rule lemma repeat_mset_0 [simp]: \repeat_mset 0 M = {#}\ by transfer simp lemma repeat_mset_Suc [simp]: \repeat_mset (Suc n) M = M + repeat_mset n M\ by transfer simp lemma repeat_mset_right [simp]: "repeat_mset a (repeat_mset b A) = repeat_mset (a * b) A" by (auto simp: multiset_eq_iff left_diff_distrib') lemma left_diff_repeat_mset_distrib': \repeat_mset (i - j) u = repeat_mset i u - repeat_mset j u\ by (auto simp: multiset_eq_iff left_diff_distrib') lemma left_add_mult_distrib_mset: "repeat_mset i u + (repeat_mset j u + k) = repeat_mset (i+j) u + k" by (auto simp: multiset_eq_iff add_mult_distrib) lemma repeat_mset_distrib: "repeat_mset (m + n) A = repeat_mset m A + repeat_mset n A" by (auto simp: multiset_eq_iff Nat.add_mult_distrib) lemma repeat_mset_distrib2[simp]: "repeat_mset n (A + B) = repeat_mset n A + repeat_mset n B" by (auto simp: multiset_eq_iff add_mult_distrib2) lemma repeat_mset_replicate_mset[simp]: "repeat_mset n {#a#} = replicate_mset n a" by (auto simp: multiset_eq_iff) lemma repeat_mset_distrib_add_mset[simp]: "repeat_mset n (add_mset a A) = replicate_mset n a + repeat_mset n A" by (auto simp: multiset_eq_iff) lemma repeat_mset_empty[simp]: "repeat_mset n {#} = {#}" by transfer simp subsubsection \Simprocs\ lemma repeat_mset_iterate_add: \repeat_mset n M = iterate_add n M\ unfolding iterate_add_def by (induction n) auto lemma mset_subseteq_add_iff1: "j \ (i::nat) \ (repeat_mset i u + m \# repeat_mset j u + n) = (repeat_mset (i-j) u + m \# n)" by (auto simp add: subseteq_mset_def nat_le_add_iff1) lemma mset_subseteq_add_iff2: "i \ (j::nat) \ (repeat_mset i u + m \# repeat_mset j u + n) = (m \# repeat_mset (j-i) u + n)" by (auto simp add: subseteq_mset_def nat_le_add_iff2) lemma mset_subset_add_iff1: "j \ (i::nat) \ (repeat_mset i u + m \# repeat_mset j u + n) = (repeat_mset (i-j) u + m \# n)" unfolding subset_mset_def repeat_mset_iterate_add by (simp add: iterate_add_eq_add_iff1 mset_subseteq_add_iff1[unfolded repeat_mset_iterate_add]) lemma mset_subset_add_iff2: "i \ (j::nat) \ (repeat_mset i u + m \# repeat_mset j u + n) = (m \# repeat_mset (j-i) u + n)" unfolding subset_mset_def repeat_mset_iterate_add by (simp add: iterate_add_eq_add_iff2 mset_subseteq_add_iff2[unfolded repeat_mset_iterate_add]) ML_file \multiset_simprocs.ML\ lemma add_mset_replicate_mset_safe[cancelation_simproc_pre]: \NO_MATCH {#} M \ add_mset a M = {#a#} + M\ by simp declare repeat_mset_iterate_add[cancelation_simproc_pre] declare iterate_add_distrib[cancelation_simproc_pre] declare repeat_mset_iterate_add[symmetric, cancelation_simproc_post] declare add_mset_not_empty[cancelation_simproc_eq_elim] empty_not_add_mset[cancelation_simproc_eq_elim] subset_mset.le_zero_eq[cancelation_simproc_eq_elim] empty_not_add_mset[cancelation_simproc_eq_elim] add_mset_not_empty[cancelation_simproc_eq_elim] subset_mset.le_zero_eq[cancelation_simproc_eq_elim] le_zero_eq[cancelation_simproc_eq_elim] simproc_setup mseteq_cancel ("(l::'a multiset) + m = n" | "(l::'a multiset) = m + n" | "add_mset a m = n" | "m = add_mset a n" | "replicate_mset p a = n" | "m = replicate_mset p a" | "repeat_mset p m = n" | "m = repeat_mset p m") = \fn phi => Cancel_Simprocs.eq_cancel\ simproc_setup msetsubset_cancel ("(l::'a multiset) + m \# n" | "(l::'a multiset) \# m + n" | "add_mset a m \# n" | "m \# add_mset a n" | "replicate_mset p r \# n" | "m \# replicate_mset p r" | "repeat_mset p m \# n" | "m \# repeat_mset p m") = \fn phi => Multiset_Simprocs.subset_cancel_msets\ simproc_setup msetsubset_eq_cancel ("(l::'a multiset) + m \# n" | "(l::'a multiset) \# m + n" | "add_mset a m \# n" | "m \# add_mset a n" | "replicate_mset p r \# n" | "m \# replicate_mset p r" | "repeat_mset p m \# n" | "m \# repeat_mset p m") = \fn phi => Multiset_Simprocs.subseteq_cancel_msets\ simproc_setup msetdiff_cancel ("((l::'a multiset) + m) - n" | "(l::'a multiset) - (m + n)" | "add_mset a m - n" | "m - add_mset a n" | "replicate_mset p r - n" | "m - replicate_mset p r" | "repeat_mset p m - n" | "m - repeat_mset p m") = \fn phi => Cancel_Simprocs.diff_cancel\ subsubsection \Conditionally complete lattice\ instantiation multiset :: (type) Inf begin lift_definition Inf_multiset :: "'a multiset set \ 'a multiset" is "\A i. if A = {} then 0 else Inf ((\f. f i) ` A)" proof - fix A :: "('a \ nat) set" assume *: "\f. f \ A \ finite {x. 0 < f x}" show \finite {i. 0 < (if A = {} then 0 else INF f\A. f i)}\ proof (cases "A = {}") case False then obtain f where "f \ A" by blast hence "{i. Inf ((\f. f i) ` A) > 0} \ {i. f i > 0}" by (auto intro: less_le_trans[OF _ cInf_lower]) moreover from \f \ A\ * have "finite \" by simp ultimately have "finite {i. Inf ((\f. f i) ` A) > 0}" by (rule finite_subset) with False show ?thesis by simp qed simp_all qed instance .. end lemma Inf_multiset_empty: "Inf {} = {#}" by transfer simp_all lemma count_Inf_multiset_nonempty: "A \ {} \ count (Inf A) x = Inf ((\X. count X x) ` A)" by transfer simp_all instantiation multiset :: (type) Sup begin definition Sup_multiset :: "'a multiset set \ 'a multiset" where "Sup_multiset A = (if A \ {} \ subset_mset.bdd_above A then Abs_multiset (\i. Sup ((\X. count X i) ` A)) else {#})" lemma Sup_multiset_empty: "Sup {} = {#}" by (simp add: Sup_multiset_def) lemma Sup_multiset_unbounded: "\subset_mset.bdd_above A \ Sup A = {#}" by (simp add: Sup_multiset_def) instance .. end lemma bdd_above_multiset_imp_bdd_above_count: assumes "subset_mset.bdd_above (A :: 'a multiset set)" shows "bdd_above ((\X. count X x) ` A)" proof - from assms obtain Y where Y: "\X\A. X \# Y" by (auto simp: subset_mset.bdd_above_def) hence "count X x \ count Y x" if "X \ A" for X using that by (auto intro: mset_subset_eq_count) thus ?thesis by (intro bdd_aboveI[of _ "count Y x"]) auto qed lemma bdd_above_multiset_imp_finite_support: assumes "A \ {}" "subset_mset.bdd_above (A :: 'a multiset set)" shows "finite (\X\A. {x. count X x > 0})" proof - from assms obtain Y where Y: "\X\A. X \# Y" by (auto simp: subset_mset.bdd_above_def) hence "count X x \ count Y x" if "X \ A" for X x using that by (auto intro: mset_subset_eq_count) hence "(\X\A. {x. count X x > 0}) \ {x. count Y x > 0}" by safe (erule less_le_trans) moreover have "finite \" by simp ultimately show ?thesis by (rule finite_subset) qed lemma Sup_multiset_in_multiset: \finite {i. 0 < (SUP M\A. count M i)}\ if \A \ {}\ \subset_mset.bdd_above A\ proof - have "{i. Sup ((\X. count X i) ` A) > 0} \ (\X\A. {i. 0 < count X i})" proof safe fix i assume pos: "(SUP X\A. count X i) > 0" show "i \ (\X\A. {i. 0 < count X i})" proof (rule ccontr) assume "i \ (\X\A. {i. 0 < count X i})" hence "\X\A. count X i \ 0" by (auto simp: count_eq_zero_iff) with that have "(SUP X\A. count X i) \ 0" by (intro cSup_least bdd_above_multiset_imp_bdd_above_count) auto with pos show False by simp qed qed moreover from that have "finite \" by (rule bdd_above_multiset_imp_finite_support) ultimately show "finite {i. Sup ((\X. count X i) ` A) > 0}" by (rule finite_subset) qed lemma count_Sup_multiset_nonempty: \count (Sup A) x = (SUP X\A. count X x)\ if \A \ {}\ \subset_mset.bdd_above A\ using that by (simp add: Sup_multiset_def Sup_multiset_in_multiset count_Abs_multiset) interpretation subset_mset: conditionally_complete_lattice Inf Sup "(\#)" "(\#)" "(\#)" "(\#)" proof fix X :: "'a multiset" and A assume "X \ A" show "Inf A \# X" proof (rule mset_subset_eqI) fix x from \X \ A\ have "A \ {}" by auto hence "count (Inf A) x = (INF X\A. count X x)" by (simp add: count_Inf_multiset_nonempty) also from \X \ A\ have "\ \ count X x" by (intro cInf_lower) simp_all finally show "count (Inf A) x \ count X x" . qed next fix X :: "'a multiset" and A assume nonempty: "A \ {}" and le: "\Y. Y \ A \ X \# Y" show "X \# Inf A" proof (rule mset_subset_eqI) fix x from nonempty have "count X x \ (INF X\A. count X x)" by (intro cInf_greatest) (auto intro: mset_subset_eq_count le) also from nonempty have "\ = count (Inf A) x" by (simp add: count_Inf_multiset_nonempty) finally show "count X x \ count (Inf A) x" . qed next fix X :: "'a multiset" and A assume X: "X \ A" and bdd: "subset_mset.bdd_above A" show "X \# Sup A" proof (rule mset_subset_eqI) fix x from X have "A \ {}" by auto have "count X x \ (SUP X\A. count X x)" by (intro cSUP_upper X bdd_above_multiset_imp_bdd_above_count bdd) also from count_Sup_multiset_nonempty[OF \A \ {}\ bdd] have "(SUP X\A. count X x) = count (Sup A) x" by simp finally show "count X x \ count (Sup A) x" . qed next fix X :: "'a multiset" and A assume nonempty: "A \ {}" and ge: "\Y. Y \ A \ Y \# X" from ge have bdd: "subset_mset.bdd_above A" by (rule subset_mset.bdd_aboveI[of _ X]) show "Sup A \# X" proof (rule mset_subset_eqI) fix x from count_Sup_multiset_nonempty[OF \A \ {}\ bdd] have "count (Sup A) x = (SUP X\A. count X x)" . also from nonempty have "\ \ count X x" by (intro cSup_least) (auto intro: mset_subset_eq_count ge) finally show "count (Sup A) x \ count X x" . qed qed \ \FIXME: avoid junk stemming from type class interpretation\ lemma set_mset_Inf: assumes "A \ {}" shows "set_mset (Inf A) = (\X\A. set_mset X)" proof safe fix x X assume "x \# Inf A" "X \ A" hence nonempty: "A \ {}" by (auto simp: Inf_multiset_empty) from \x \# Inf A\ have "{#x#} \# Inf A" by auto also from \X \ A\ have "\ \# X" by (rule subset_mset.cInf_lower) simp_all finally show "x \# X" by simp next fix x assume x: "x \ (\X\A. set_mset X)" hence "{#x#} \# X" if "X \ A" for X using that by auto from assms and this have "{#x#} \# Inf A" by (rule subset_mset.cInf_greatest) thus "x \# Inf A" by simp qed lemma in_Inf_multiset_iff: assumes "A \ {}" shows "x \# Inf A \ (\X\A. x \# X)" proof - from assms have "set_mset (Inf A) = (\X\A. set_mset X)" by (rule set_mset_Inf) also have "x \ \ \ (\X\A. x \# X)" by simp finally show ?thesis . qed lemma in_Inf_multisetD: "x \# Inf A \ X \ A \ x \# X" by (subst (asm) in_Inf_multiset_iff) auto lemma set_mset_Sup: assumes "subset_mset.bdd_above A" shows "set_mset (Sup A) = (\X\A. set_mset X)" proof safe fix x assume "x \# Sup A" hence nonempty: "A \ {}" by (auto simp: Sup_multiset_empty) show "x \ (\X\A. set_mset X)" proof (rule ccontr) assume x: "x \ (\X\A. set_mset X)" have "count X x \ count (Sup A) x" if "X \ A" for X x using that by (intro mset_subset_eq_count subset_mset.cSup_upper assms) with x have "X \# Sup A - {#x#}" if "X \ A" for X using that by (auto simp: subseteq_mset_def algebra_simps not_in_iff) hence "Sup A \# Sup A - {#x#}" by (intro subset_mset.cSup_least nonempty) with \x \# Sup A\ show False by (auto simp: subseteq_mset_def simp flip: count_greater_zero_iff dest!: spec[of _ x]) qed next fix x X assume "x \ set_mset X" "X \ A" hence "{#x#} \# X" by auto also have "X \# Sup A" by (intro subset_mset.cSup_upper \X \ A\ assms) finally show "x \ set_mset (Sup A)" by simp qed lemma in_Sup_multiset_iff: assumes "subset_mset.bdd_above A" shows "x \# Sup A \ (\X\A. x \# X)" proof - from assms have "set_mset (Sup A) = (\X\A. set_mset X)" by (rule set_mset_Sup) also have "x \ \ \ (\X\A. x \# X)" by simp finally show ?thesis . qed lemma in_Sup_multisetD: assumes "x \# Sup A" shows "\X\A. x \# X" proof - have "subset_mset.bdd_above A" by (rule ccontr) (insert assms, simp_all add: Sup_multiset_unbounded) with assms show ?thesis by (simp add: in_Sup_multiset_iff) qed interpretation subset_mset: distrib_lattice "(\#)" "(\#)" "(\#)" "(\#)" proof fix A B C :: "'a multiset" show "A \# (B \# C) = A \# B \# (A \# C)" by (intro multiset_eqI) simp_all qed \ \FIXME: avoid junk stemming from type class interpretation\ subsubsection \Filter (with comprehension syntax)\ text \Multiset comprehension\ lift_definition filter_mset :: "('a \ bool) \ 'a multiset \ 'a multiset" is "\P M. \x. if P x then M x else 0" by (rule filter_preserves_multiset) syntax (ASCII) "_MCollect" :: "pttrn \ 'a multiset \ bool \ 'a multiset" ("(1{#_ :# _./ _#})") syntax "_MCollect" :: "pttrn \ 'a multiset \ bool \ 'a multiset" ("(1{#_ \# _./ _#})") translations "{#x \# M. P#}" == "CONST filter_mset (\x. P) M" lemma count_filter_mset [simp]: "count (filter_mset P M) a = (if P a then count M a else 0)" by (simp add: filter_mset.rep_eq) lemma set_mset_filter [simp]: "set_mset (filter_mset P M) = {a \ set_mset M. P a}" by (simp only: set_eq_iff count_greater_zero_iff [symmetric] count_filter_mset) simp lemma filter_empty_mset [simp]: "filter_mset P {#} = {#}" by (rule multiset_eqI) simp lemma filter_single_mset: "filter_mset P {#x#} = (if P x then {#x#} else {#})" by (rule multiset_eqI) simp lemma filter_union_mset [simp]: "filter_mset P (M + N) = filter_mset P M + filter_mset P N" by (rule multiset_eqI) simp lemma filter_diff_mset [simp]: "filter_mset P (M - N) = filter_mset P M - filter_mset P N" by (rule multiset_eqI) simp lemma filter_inter_mset [simp]: "filter_mset P (M \# N) = filter_mset P M \# filter_mset P N" by (rule multiset_eqI) simp lemma filter_sup_mset[simp]: "filter_mset P (A \# B) = filter_mset P A \# filter_mset P B" by (rule multiset_eqI) simp lemma filter_mset_add_mset [simp]: "filter_mset P (add_mset x A) = (if P x then add_mset x (filter_mset P A) else filter_mset P A)" by (auto simp: multiset_eq_iff) lemma multiset_filter_subset[simp]: "filter_mset f M \# M" by (simp add: mset_subset_eqI) lemma multiset_filter_mono: assumes "A \# B" shows "filter_mset f A \# filter_mset f B" proof - from assms[unfolded mset_subset_eq_exists_conv] obtain C where B: "B = A + C" by auto show ?thesis unfolding B by auto qed lemma filter_mset_eq_conv: "filter_mset P M = N \ N \# M \ (\b\#N. P b) \ (\a\#M - N. \ P a)" (is "?P \ ?Q") proof assume ?P then show ?Q by auto (simp add: multiset_eq_iff in_diff_count) next assume ?Q then obtain Q where M: "M = N + Q" by (auto simp add: mset_subset_eq_exists_conv) then have MN: "M - N = Q" by simp show ?P proof (rule multiset_eqI) fix a from \?Q\ MN have *: "\ P a \ a \# N" "P a \ a \# Q" by auto show "count (filter_mset P M) a = count N a" proof (cases "a \# M") case True with * show ?thesis by (simp add: not_in_iff M) next case False then have "count M a = 0" by (simp add: not_in_iff) with M show ?thesis by simp qed qed qed lemma filter_filter_mset: "filter_mset P (filter_mset Q M) = {#x \# M. Q x \ P x#}" by (auto simp: multiset_eq_iff) lemma filter_mset_True[simp]: "{#y \# M. True#} = M" and filter_mset_False[simp]: "{#y \# M. False#} = {#}" by (auto simp: multiset_eq_iff) subsubsection \Size\ definition wcount where "wcount f M = (\x. count M x * Suc (f x))" lemma wcount_union: "wcount f (M + N) a = wcount f M a + wcount f N a" by (auto simp: wcount_def add_mult_distrib) lemma wcount_add_mset: "wcount f (add_mset x M) a = (if x = a then Suc (f a) else 0) + wcount f M a" unfolding add_mset_add_single[of _ M] wcount_union by (auto simp: wcount_def) definition size_multiset :: "('a \ nat) \ 'a multiset \ nat" where "size_multiset f M = sum (wcount f M) (set_mset M)" lemmas size_multiset_eq = size_multiset_def[unfolded wcount_def] instantiation multiset :: (type) size begin definition size_multiset where size_multiset_overloaded_def: "size_multiset = Multiset.size_multiset (\_. 0)" instance .. end lemmas size_multiset_overloaded_eq = size_multiset_overloaded_def[THEN fun_cong, unfolded size_multiset_eq, simplified] lemma size_multiset_empty [simp]: "size_multiset f {#} = 0" by (simp add: size_multiset_def) lemma size_empty [simp]: "size {#} = 0" by (simp add: size_multiset_overloaded_def) lemma size_multiset_single : "size_multiset f {#b#} = Suc (f b)" by (simp add: size_multiset_eq) lemma size_single: "size {#b#} = 1" by (simp add: size_multiset_overloaded_def size_multiset_single) lemma sum_wcount_Int: "finite A \ sum (wcount f N) (A \ set_mset N) = sum (wcount f N) A" by (induct rule: finite_induct) (simp_all add: Int_insert_left wcount_def count_eq_zero_iff) lemma size_multiset_union [simp]: "size_multiset f (M + N::'a multiset) = size_multiset f M + size_multiset f N" apply (simp add: size_multiset_def sum_Un_nat sum.distrib sum_wcount_Int wcount_union) apply (subst Int_commute) apply (simp add: sum_wcount_Int) done lemma size_multiset_add_mset [simp]: "size_multiset f (add_mset a M) = Suc (f a) + size_multiset f M" unfolding add_mset_add_single[of _ M] size_multiset_union by (auto simp: size_multiset_single) lemma size_add_mset [simp]: "size (add_mset a A) = Suc (size A)" by (simp add: size_multiset_overloaded_def wcount_add_mset) lemma size_union [simp]: "size (M + N::'a multiset) = size M + size N" by (auto simp add: size_multiset_overloaded_def) lemma size_multiset_eq_0_iff_empty [iff]: "size_multiset f M = 0 \ M = {#}" by (auto simp add: size_multiset_eq count_eq_zero_iff) lemma size_eq_0_iff_empty [iff]: "(size M = 0) = (M = {#})" by (auto simp add: size_multiset_overloaded_def) lemma nonempty_has_size: "(S \ {#}) = (0 < size S)" by (metis gr0I gr_implies_not0 size_empty size_eq_0_iff_empty) lemma size_eq_Suc_imp_elem: "size M = Suc n \ \a. a \# M" apply (unfold size_multiset_overloaded_eq) apply (drule sum_SucD) apply auto done lemma size_eq_Suc_imp_eq_union: assumes "size M = Suc n" shows "\a N. M = add_mset a N" proof - from assms obtain a where "a \# M" by (erule size_eq_Suc_imp_elem [THEN exE]) then have "M = add_mset a (M - {#a#})" by simp then show ?thesis by blast qed lemma size_mset_mono: fixes A B :: "'a multiset" assumes "A \# B" shows "size A \ size B" proof - from assms[unfolded mset_subset_eq_exists_conv] obtain C where B: "B = A + C" by auto show ?thesis unfolding B by (induct C) auto qed lemma size_filter_mset_lesseq[simp]: "size (filter_mset f M) \ size M" by (rule size_mset_mono[OF multiset_filter_subset]) lemma size_Diff_submset: "M \# M' \ size (M' - M) = size M' - size(M::'a multiset)" by (metis add_diff_cancel_left' size_union mset_subset_eq_exists_conv) subsection \Induction and case splits\ theorem multiset_induct [case_names empty add, induct type: multiset]: assumes empty: "P {#}" assumes add: "\x M. P M \ P (add_mset x M)" shows "P M" proof (induct "size M" arbitrary: M) case 0 thus "P M" by (simp add: empty) next case (Suc k) obtain N x where "M = add_mset x N" using \Suc k = size M\ [symmetric] using size_eq_Suc_imp_eq_union by fast with Suc add show "P M" by simp qed lemma multiset_induct_min[case_names empty add]: fixes M :: "'a::linorder multiset" assumes empty: "P {#}" and add: "\x M. P M \ (\y \# M. y \ x) \ P (add_mset x M)" shows "P M" proof (induct "size M" arbitrary: M) case (Suc k) note ih = this(1) and Sk_eq_sz_M = this(2) let ?y = "Min_mset M" let ?N = "M - {#?y#}" have M: "M = add_mset ?y ?N" by (metis Min_in Sk_eq_sz_M finite_set_mset insert_DiffM lessI not_less_zero set_mset_eq_empty_iff size_empty) show ?case by (subst M, rule add, rule ih, metis M Sk_eq_sz_M nat.inject size_add_mset, meson Min_le finite_set_mset in_diffD) qed (simp add: empty) lemma multiset_induct_max[case_names empty add]: fixes M :: "'a::linorder multiset" assumes empty: "P {#}" and add: "\x M. P M \ (\y \# M. y \ x) \ P (add_mset x M)" shows "P M" proof (induct "size M" arbitrary: M) case (Suc k) note ih = this(1) and Sk_eq_sz_M = this(2) let ?y = "Max_mset M" let ?N = "M - {#?y#}" have M: "M = add_mset ?y ?N" by (metis Max_in Sk_eq_sz_M finite_set_mset insert_DiffM lessI not_less_zero set_mset_eq_empty_iff size_empty) show ?case by (subst M, rule add, rule ih, metis M Sk_eq_sz_M nat.inject size_add_mset, meson Max_ge finite_set_mset in_diffD) qed (simp add: empty) lemma multi_nonempty_split: "M \ {#} \ \A a. M = add_mset a A" by (induct M) auto lemma multiset_cases [cases type]: obtains (empty) "M = {#}" | (add) x N where "M = add_mset x N" by (induct M) simp_all lemma multi_drop_mem_not_eq: "c \# B \ B - {#c#} \ B" by (cases "B = {#}") (auto dest: multi_member_split) lemma union_filter_mset_complement[simp]: "\x. P x = (\ Q x) \ filter_mset P M + filter_mset Q M = M" by (subst multiset_eq_iff) auto lemma multiset_partition: "M = {#x \# M. P x#} + {#x \# M. \ P x#}" by simp lemma mset_subset_size: "A \# B \ size A < size B" proof (induct A arbitrary: B) case empty then show ?case using nonempty_has_size by auto next case (add x A) have "add_mset x A \# B" by (meson add.prems subset_mset_def) then show ?case by (metis (no_types) add.prems add.right_neutral add_diff_cancel_left' leD nat_neq_iff size_Diff_submset size_eq_0_iff_empty size_mset_mono subset_mset.le_iff_add subset_mset_def) qed lemma size_1_singleton_mset: "size M = 1 \ \a. M = {#a#}" by (cases M) auto subsubsection \Strong induction and subset induction for multisets\ text \Well-foundedness of strict subset relation\ lemma wf_subset_mset_rel: "wf {(M, N :: 'a multiset). M \# N}" apply (rule wf_measure [THEN wf_subset, where f1=size]) apply (clarsimp simp: measure_def inv_image_def mset_subset_size) done lemma full_multiset_induct [case_names less]: assumes ih: "\B. \(A::'a multiset). A \# B \ P A \ P B" shows "P B" apply (rule wf_subset_mset_rel [THEN wf_induct]) apply (rule ih, auto) done lemma multi_subset_induct [consumes 2, case_names empty add]: assumes "F \# A" and empty: "P {#}" and insert: "\a F. a \# A \ P F \ P (add_mset a F)" shows "P F" proof - from \F \# A\ show ?thesis proof (induct F) show "P {#}" by fact next fix x F assume P: "F \# A \ P F" and i: "add_mset x F \# A" show "P (add_mset x F)" proof (rule insert) from i show "x \# A" by (auto dest: mset_subset_eq_insertD) from i have "F \# A" by (auto dest: mset_subset_eq_insertD) with P show "P F" . qed qed qed subsection \The fold combinator\ definition fold_mset :: "('a \ 'b \ 'b) \ 'b \ 'a multiset \ 'b" where "fold_mset f s M = Finite_Set.fold (\x. f x ^^ count M x) s (set_mset M)" lemma fold_mset_empty [simp]: "fold_mset f s {#} = s" by (simp add: fold_mset_def) context comp_fun_commute begin lemma fold_mset_add_mset [simp]: "fold_mset f s (add_mset x M) = f x (fold_mset f s M)" proof - interpret mset: comp_fun_commute "\y. f y ^^ count M y" by (fact comp_fun_commute_funpow) interpret mset_union: comp_fun_commute "\y. f y ^^ count (add_mset x M) y" by (fact comp_fun_commute_funpow) show ?thesis proof (cases "x \ set_mset M") case False then have *: "count (add_mset x M) x = 1" by (simp add: not_in_iff) from False have "Finite_Set.fold (\y. f y ^^ count (add_mset x M) y) s (set_mset M) = Finite_Set.fold (\y. f y ^^ count M y) s (set_mset M)" by (auto intro!: Finite_Set.fold_cong comp_fun_commute_funpow) with False * show ?thesis by (simp add: fold_mset_def del: count_add_mset) next case True define N where "N = set_mset M - {x}" from N_def True have *: "set_mset M = insert x N" "x \ N" "finite N" by auto then have "Finite_Set.fold (\y. f y ^^ count (add_mset x M) y) s N = Finite_Set.fold (\y. f y ^^ count M y) s N" by (auto intro!: Finite_Set.fold_cong comp_fun_commute_funpow) with * show ?thesis by (simp add: fold_mset_def del: count_add_mset) simp qed qed corollary fold_mset_single: "fold_mset f s {#x#} = f x s" by simp lemma fold_mset_fun_left_comm: "f x (fold_mset f s M) = fold_mset f (f x s) M" by (induct M) (simp_all add: fun_left_comm) lemma fold_mset_union [simp]: "fold_mset f s (M + N) = fold_mset f (fold_mset f s M) N" by (induct M) (simp_all add: fold_mset_fun_left_comm) lemma fold_mset_fusion: assumes "comp_fun_commute g" and *: "\x y. h (g x y) = f x (h y)" shows "h (fold_mset g w A) = fold_mset f (h w) A" proof - interpret comp_fun_commute g by (fact assms) from * show ?thesis by (induct A) auto qed end lemma union_fold_mset_add_mset: "A + B = fold_mset add_mset A B" proof - interpret comp_fun_commute add_mset by standard auto show ?thesis by (induction B) auto qed text \ A note on code generation: When defining some function containing a subterm \<^term>\fold_mset F\, code generation is not automatic. When interpreting locale \left_commutative\ with \F\, the would be code thms for \<^const>\fold_mset\ become thms like \<^term>\fold_mset F z {#} = z\ where \F\ is not a pattern but contains defined symbols, i.e.\ is not a code thm. Hence a separate constant with its own code thms needs to be introduced for \F\. See the image operator below. \ subsection \Image\ definition image_mset :: "('a \ 'b) \ 'a multiset \ 'b multiset" where "image_mset f = fold_mset (add_mset \ f) {#}" lemma comp_fun_commute_mset_image: "comp_fun_commute (add_mset \ f)" by unfold_locales (simp add: fun_eq_iff) lemma image_mset_empty [simp]: "image_mset f {#} = {#}" by (simp add: image_mset_def) lemma image_mset_single: "image_mset f {#x#} = {#f x#}" by (simp add: comp_fun_commute.fold_mset_add_mset comp_fun_commute_mset_image image_mset_def) lemma image_mset_union [simp]: "image_mset f (M + N) = image_mset f M + image_mset f N" proof - interpret comp_fun_commute "add_mset \ f" by (fact comp_fun_commute_mset_image) show ?thesis by (induct N) (simp_all add: image_mset_def) qed corollary image_mset_add_mset [simp]: "image_mset f (add_mset a M) = add_mset (f a) (image_mset f M)" unfolding image_mset_union add_mset_add_single[of a M] by (simp add: image_mset_single) lemma set_image_mset [simp]: "set_mset (image_mset f M) = image f (set_mset M)" by (induct M) simp_all lemma size_image_mset [simp]: "size (image_mset f M) = size M" by (induct M) simp_all lemma image_mset_is_empty_iff [simp]: "image_mset f M = {#} \ M = {#}" by (cases M) auto lemma image_mset_If: "image_mset (\x. if P x then f x else g x) A = image_mset f (filter_mset P A) + image_mset g (filter_mset (\x. \P x) A)" by (induction A) auto lemma image_mset_Diff: assumes "B \# A" shows "image_mset f (A - B) = image_mset f A - image_mset f B" proof - have "image_mset f (A - B + B) = image_mset f (A - B) + image_mset f B" by simp also from assms have "A - B + B = A" by (simp add: subset_mset.diff_add) finally show ?thesis by simp qed lemma count_image_mset: "count (image_mset f A) x = (\y\f -` {x} \ set_mset A. count A y)" proof (induction A) case empty then show ?case by simp next case (add x A) moreover have *: "(if x = y then Suc n else n) = n + (if x = y then 1 else 0)" for n y by simp ultimately show ?case by (auto simp: sum.distrib intro!: sum.mono_neutral_left) qed lemma image_mset_subseteq_mono: "A \# B \ image_mset f A \# image_mset f B" by (metis image_mset_union subset_mset.le_iff_add) lemma image_mset_subset_mono: "M \# N \ image_mset f M \# image_mset f N" by (metis (no_types) Diff_eq_empty_iff_mset image_mset_Diff image_mset_is_empty_iff image_mset_subseteq_mono subset_mset.less_le_not_le) syntax (ASCII) "_comprehension_mset" :: "'a \ 'b \ 'b multiset \ 'a multiset" ("({#_/. _ :# _#})") syntax "_comprehension_mset" :: "'a \ 'b \ 'b multiset \ 'a multiset" ("({#_/. _ \# _#})") translations "{#e. x \# M#}" \ "CONST image_mset (\x. e) M" syntax (ASCII) "_comprehension_mset'" :: "'a \ 'b \ 'b multiset \ bool \ 'a multiset" ("({#_/ | _ :# _./ _#})") syntax "_comprehension_mset'" :: "'a \ 'b \ 'b multiset \ bool \ 'a multiset" ("({#_/ | _ \# _./ _#})") translations "{#e | x\#M. P#}" \ "{#e. x \# {# x\#M. P#}#}" text \ This allows to write not just filters like \<^term>\{#x\#M. x but also images like \<^term>\{#x+x. x\#M #}\ and @{term [source] "{#x+x|x\#M. x\{#x+x|x\#M. x. \ lemma in_image_mset: "y \# {#f x. x \# M#} \ y \ f ` set_mset M" by simp functor image_mset: image_mset proof - fix f g show "image_mset f \ image_mset g = image_mset (f \ g)" proof fix A show "(image_mset f \ image_mset g) A = image_mset (f \ g) A" by (induct A) simp_all qed show "image_mset id = id" proof fix A show "image_mset id A = id A" by (induct A) simp_all qed qed declare image_mset.id [simp] image_mset.identity [simp] lemma image_mset_id[simp]: "image_mset id x = x" unfolding id_def by auto lemma image_mset_cong: "(\x. x \# M \ f x = g x) \ {#f x. x \# M#} = {#g x. x \# M#}" by (induct M) auto lemma image_mset_cong_pair: "(\x y. (x, y) \# M \ f x y = g x y) \ {#f x y. (x, y) \# M#} = {#g x y. (x, y) \# M#}" by (metis image_mset_cong split_cong) lemma image_mset_const_eq: "{#c. a \# M#} = replicate_mset (size M) c" by (induct M) simp_all subsection \Further conversions\ primrec mset :: "'a list \ 'a multiset" where "mset [] = {#}" | "mset (a # x) = add_mset a (mset x)" lemma in_multiset_in_set: "x \# mset xs \ x \ set xs" by (induct xs) simp_all lemma count_mset: "count (mset xs) x = length (filter (\y. x = y) xs)" by (induct xs) simp_all lemma mset_zero_iff[simp]: "(mset x = {#}) = (x = [])" by (induct x) auto lemma mset_zero_iff_right[simp]: "({#} = mset x) = (x = [])" by (induct x) auto lemma count_mset_gt_0: "x \ set xs \ count (mset xs) x > 0" by (induction xs) auto lemma count_mset_0_iff [simp]: "count (mset xs) x = 0 \ x \ set xs" by (induction xs) auto lemma mset_single_iff[iff]: "mset xs = {#x#} \ xs = [x]" by (cases xs) auto lemma mset_single_iff_right[iff]: "{#x#} = mset xs \ xs = [x]" by (cases xs) auto lemma set_mset_mset[simp]: "set_mset (mset xs) = set xs" by (induct xs) auto lemma set_mset_comp_mset [simp]: "set_mset \ mset = set" by (simp add: fun_eq_iff) lemma size_mset [simp]: "size (mset xs) = length xs" by (induct xs) simp_all lemma mset_append [simp]: "mset (xs @ ys) = mset xs + mset ys" by (induct xs arbitrary: ys) auto lemma mset_filter[simp]: "mset (filter P xs) = {#x \# mset xs. P x #}" by (induct xs) simp_all lemma mset_rev [simp]: "mset (rev xs) = mset xs" by (induct xs) simp_all lemma surj_mset: "surj mset" apply (unfold surj_def) apply (rule allI) apply (rule_tac M = y in multiset_induct) apply auto apply (rule_tac x = "x # xa" in exI) apply auto done lemma distinct_count_atmost_1: "distinct x = (\a. count (mset x) a = (if a \ set x then 1 else 0))" proof (induct x) case Nil then show ?case by simp next case (Cons x xs) show ?case (is "?lhs \ ?rhs") proof assume ?lhs then show ?rhs using Cons by simp next assume ?rhs then have "x \ set xs" by (simp split: if_splits) moreover from \?rhs\ have "(\a. count (mset xs) a = (if a \ set xs then 1 else 0))" by (auto split: if_splits simp add: count_eq_zero_iff) ultimately show ?lhs using Cons by simp qed qed lemma mset_eq_setD: assumes "mset xs = mset ys" shows "set xs = set ys" proof - from assms have "set_mset (mset xs) = set_mset (mset ys)" by simp then show ?thesis by simp qed lemma set_eq_iff_mset_eq_distinct: \distinct x \ distinct y \ set x = set y \ mset x = mset y\ by (auto simp: multiset_eq_iff distinct_count_atmost_1) lemma set_eq_iff_mset_remdups_eq: \set x = set y \ mset (remdups x) = mset (remdups y)\ apply (rule iffI) apply (simp add: set_eq_iff_mset_eq_distinct[THEN iffD1]) apply (drule distinct_remdups [THEN distinct_remdups [THEN set_eq_iff_mset_eq_distinct [THEN iffD2]]]) apply simp done lemma mset_eq_imp_distinct_iff: \distinct xs \ distinct ys\ if \mset xs = mset ys\ using that by (auto simp add: distinct_count_atmost_1 dest: mset_eq_setD) lemma nth_mem_mset: "i < length ls \ (ls ! i) \# mset ls" proof (induct ls arbitrary: i) case Nil then show ?case by simp next case Cons then show ?case by (cases i) auto qed lemma mset_remove1[simp]: "mset (remove1 a xs) = mset xs - {#a#}" by (induct xs) (auto simp add: multiset_eq_iff) lemma mset_eq_length: assumes "mset xs = mset ys" shows "length xs = length ys" using assms by (metis size_mset) lemma mset_eq_length_filter: assumes "mset xs = mset ys" shows "length (filter (\x. z = x) xs) = length (filter (\y. z = y) ys)" using assms by (metis count_mset) lemma fold_multiset_equiv: assumes f: "\x y. x \ set xs \ y \ set xs \ f x \ f y = f y \ f x" and equiv: "mset xs = mset ys" shows "List.fold f xs = List.fold f ys" using f equiv [symmetric] proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case (Cons x xs) then have *: "set ys = set (x # xs)" by (blast dest: mset_eq_setD) have "\x y. x \ set ys \ y \ set ys \ f x \ f y = f y \ f x" by (rule Cons.prems(1)) (simp_all add: *) moreover from * have "x \ set ys" by simp ultimately have "List.fold f ys = List.fold f (remove1 x ys) \ f x" by (fact fold_remove1_split) moreover from Cons.prems have "List.fold f xs = List.fold f (remove1 x ys)" by (auto intro: Cons.hyps) ultimately show ?case by simp qed lemma mset_shuffles: "zs \ shuffles xs ys \ mset zs = mset xs + mset ys" by (induction xs ys arbitrary: zs rule: shuffles.induct) auto lemma mset_insort [simp]: "mset (insort x xs) = add_mset x (mset xs)" by (induct xs) simp_all lemma mset_map[simp]: "mset (map f xs) = image_mset f (mset xs)" by (induct xs) simp_all global_interpretation mset_set: folding add_mset "{#}" defines mset_set = "folding.F add_mset {#}" by standard (simp add: fun_eq_iff) lemma sum_multiset_singleton [simp]: "sum (\n. {#n#}) A = mset_set A" by (induction A rule: infinite_finite_induct) auto lemma count_mset_set [simp]: "finite A \ x \ A \ count (mset_set A) x = 1" (is "PROP ?P") "\ finite A \ count (mset_set A) x = 0" (is "PROP ?Q") "x \ A \ count (mset_set A) x = 0" (is "PROP ?R") proof - have *: "count (mset_set A) x = 0" if "x \ A" for A proof (cases "finite A") case False then show ?thesis by simp next case True from True \x \ A\ show ?thesis by (induct A) auto qed then show "PROP ?P" "PROP ?Q" "PROP ?R" by (auto elim!: Set.set_insert) qed \ \TODO: maybe define \<^const>\mset_set\ also in terms of \<^const>\Abs_multiset\\ lemma elem_mset_set[simp, intro]: "finite A \ x \# mset_set A \ x \ A" by (induct A rule: finite_induct) simp_all lemma mset_set_Union: "finite A \ finite B \ A \ B = {} \ mset_set (A \ B) = mset_set A + mset_set B" by (induction A rule: finite_induct) auto lemma filter_mset_mset_set [simp]: "finite A \ filter_mset P (mset_set A) = mset_set {x\A. P x}" proof (induction A rule: finite_induct) case (insert x A) from insert.hyps have "filter_mset P (mset_set (insert x A)) = filter_mset P (mset_set A) + mset_set (if P x then {x} else {})" by simp also have "filter_mset P (mset_set A) = mset_set {x\A. P x}" by (rule insert.IH) also from insert.hyps have "\ + mset_set (if P x then {x} else {}) = mset_set ({x \ A. P x} \ (if P x then {x} else {}))" (is "_ = mset_set ?A") by (intro mset_set_Union [symmetric]) simp_all also from insert.hyps have "?A = {y\insert x A. P y}" by auto finally show ?case . qed simp_all lemma mset_set_Diff: assumes "finite A" "B \ A" shows "mset_set (A - B) = mset_set A - mset_set B" proof - from assms have "mset_set ((A - B) \ B) = mset_set (A - B) + mset_set B" by (intro mset_set_Union) (auto dest: finite_subset) also from assms have "A - B \ B = A" by blast finally show ?thesis by simp qed lemma mset_set_set: "distinct xs \ mset_set (set xs) = mset xs" by (induction xs) simp_all lemma count_mset_set': "count (mset_set A) x = (if finite A \ x \ A then 1 else 0)" by auto lemma subset_imp_msubset_mset_set: assumes "A \ B" "finite B" shows "mset_set A \# mset_set B" proof (rule mset_subset_eqI) fix x :: 'a from assms have "finite A" by (rule finite_subset) with assms show "count (mset_set A) x \ count (mset_set B) x" by (cases "x \ A"; cases "x \ B") auto qed lemma mset_set_set_mset_msubset: "mset_set (set_mset A) \# A" proof (rule mset_subset_eqI) fix x show "count (mset_set (set_mset A)) x \ count A x" by (cases "x \# A") simp_all qed context linorder begin definition sorted_list_of_multiset :: "'a multiset \ 'a list" where "sorted_list_of_multiset M = fold_mset insort [] M" lemma sorted_list_of_multiset_empty [simp]: "sorted_list_of_multiset {#} = []" by (simp add: sorted_list_of_multiset_def) lemma sorted_list_of_multiset_singleton [simp]: "sorted_list_of_multiset {#x#} = [x]" proof - interpret comp_fun_commute insort by (fact comp_fun_commute_insort) show ?thesis by (simp add: sorted_list_of_multiset_def) qed lemma sorted_list_of_multiset_insert [simp]: "sorted_list_of_multiset (add_mset x M) = List.insort x (sorted_list_of_multiset M)" proof - interpret comp_fun_commute insort by (fact comp_fun_commute_insort) show ?thesis by (simp add: sorted_list_of_multiset_def) qed end lemma mset_sorted_list_of_multiset[simp]: "mset (sorted_list_of_multiset M) = M" by (induct M) simp_all lemma sorted_list_of_multiset_mset[simp]: "sorted_list_of_multiset (mset xs) = sort xs" by (induct xs) simp_all lemma finite_set_mset_mset_set[simp]: "finite A \ set_mset (mset_set A) = A" by auto lemma mset_set_empty_iff: "mset_set A = {#} \ A = {} \ infinite A" using finite_set_mset_mset_set by fastforce lemma infinite_set_mset_mset_set: "\ finite A \ set_mset (mset_set A) = {}" by simp lemma set_sorted_list_of_multiset [simp]: "set (sorted_list_of_multiset M) = set_mset M" by (induct M) (simp_all add: set_insort_key) lemma sorted_list_of_mset_set [simp]: "sorted_list_of_multiset (mset_set A) = sorted_list_of_set A" by (cases "finite A") (induct A rule: finite_induct, simp_all) lemma mset_upt [simp]: "mset [m.. {#the (map_of xs i). i \# mset (map fst xs)#} = mset (map snd xs)" proof (induction xs) case (Cons x xs) have "{#the (map_of (x # xs) i). i \# mset (map fst (x # xs))#} = add_mset (snd x) {#the (if i = fst x then Some (snd x) else map_of xs i). i \# mset (map fst xs)#}" (is "_ = add_mset _ ?A") by simp also from Cons.prems have "?A = {#the (map_of xs i). i :# mset (map fst xs)#}" by (cases x, intro image_mset_cong) (auto simp: in_multiset_in_set) also from Cons.prems have "\ = mset (map snd xs)" by (intro Cons.IH) simp_all finally show ?case by simp qed simp_all lemma msubset_mset_set_iff[simp]: assumes "finite A" "finite B" shows "mset_set A \# mset_set B \ A \ B" using assms set_mset_mono subset_imp_msubset_mset_set by fastforce lemma mset_set_eq_iff[simp]: assumes "finite A" "finite B" shows "mset_set A = mset_set B \ A = B" using assms by (fastforce dest: finite_set_mset_mset_set) lemma image_mset_mset_set: \<^marker>\contributor \Lukas Bulwahn\\ assumes "inj_on f A" shows "image_mset f (mset_set A) = mset_set (f ` A)" proof cases assume "finite A" from this \inj_on f A\ show ?thesis by (induct A) auto next assume "infinite A" from this \inj_on f A\ have "infinite (f ` A)" using finite_imageD by blast from \infinite A\ \infinite (f ` A)\ show ?thesis by simp qed subsection \More properties of the replicate and repeat operations\ lemma in_replicate_mset[simp]: "x \# replicate_mset n y \ n > 0 \ x = y" unfolding replicate_mset_def by (induct n) auto lemma set_mset_replicate_mset_subset[simp]: "set_mset (replicate_mset n x) = (if n = 0 then {} else {x})" by (auto split: if_splits) lemma size_replicate_mset[simp]: "size (replicate_mset n M) = n" by (induct n, simp_all) lemma count_le_replicate_mset_subset_eq: "n \ count M x \ replicate_mset n x \# M" by (auto simp add: mset_subset_eqI) (metis count_replicate_mset subseteq_mset_def) lemma filter_eq_replicate_mset: "{#y \# D. y = x#} = replicate_mset (count D x) x" by (induct D) simp_all lemma replicate_count_mset_eq_filter_eq: "replicate (count (mset xs) k) k = filter (HOL.eq k) xs" by (induct xs) auto lemma replicate_mset_eq_empty_iff [simp]: "replicate_mset n a = {#} \ n = 0" by (induct n) simp_all lemma replicate_mset_eq_iff: "replicate_mset m a = replicate_mset n b \ m = 0 \ n = 0 \ m = n \ a = b" by (auto simp add: multiset_eq_iff) lemma repeat_mset_cancel1: "repeat_mset a A = repeat_mset a B \ A = B \ a = 0" by (auto simp: multiset_eq_iff) lemma repeat_mset_cancel2: "repeat_mset a A = repeat_mset b A \ a = b \ A = {#}" by (auto simp: multiset_eq_iff) lemma repeat_mset_eq_empty_iff: "repeat_mset n A = {#} \ n = 0 \ A = {#}" by (cases n) auto lemma image_replicate_mset [simp]: "image_mset f (replicate_mset n a) = replicate_mset n (f a)" by (induct n) simp_all lemma replicate_mset_msubseteq_iff: "replicate_mset m a \# replicate_mset n b \ m = 0 \ a = b \ m \ n" by (cases m) (auto simp: insert_subset_eq_iff simp flip: count_le_replicate_mset_subset_eq) lemma msubseteq_replicate_msetE: assumes "A \# replicate_mset n a" obtains m where "m \ n" and "A = replicate_mset m a" proof (cases "n = 0") case True with assms that show thesis by simp next case False from assms have "set_mset A \ set_mset (replicate_mset n a)" by (rule set_mset_mono) with False have "set_mset A \ {a}" by simp then have "\m. A = replicate_mset m a" proof (induction A) case empty then show ?case by simp next case (add b A) then obtain m where "A = replicate_mset m a" by auto with add.prems show ?case by (auto intro: exI [of _ "Suc m"]) qed then obtain m where A: "A = replicate_mset m a" .. with assms have "m \ n" by (auto simp add: replicate_mset_msubseteq_iff) then show thesis using A .. qed subsection \Big operators\ locale comm_monoid_mset = comm_monoid begin interpretation comp_fun_commute f by standard (simp add: fun_eq_iff left_commute) interpretation comp?: comp_fun_commute "f \ g" by (fact comp_comp_fun_commute) context begin definition F :: "'a multiset \ 'a" where eq_fold: "F M = fold_mset f \<^bold>1 M" lemma empty [simp]: "F {#} = \<^bold>1" by (simp add: eq_fold) lemma singleton [simp]: "F {#x#} = x" proof - interpret comp_fun_commute by standard (simp add: fun_eq_iff left_commute) show ?thesis by (simp add: eq_fold) qed lemma union [simp]: "F (M + N) = F M \<^bold>* F N" proof - interpret comp_fun_commute f by standard (simp add: fun_eq_iff left_commute) show ?thesis by (induct N) (simp_all add: left_commute eq_fold) qed lemma add_mset [simp]: "F (add_mset x N) = x \<^bold>* F N" unfolding add_mset_add_single[of x N] union by (simp add: ac_simps) lemma insert [simp]: shows "F (image_mset g (add_mset x A)) = g x \<^bold>* F (image_mset g A)" by (simp add: eq_fold) lemma remove: assumes "x \# A" shows "F A = x \<^bold>* F (A - {#x#})" using multi_member_split[OF assms] by auto lemma neutral: "\x\#A. x = \<^bold>1 \ F A = \<^bold>1" by (induct A) simp_all lemma neutral_const [simp]: "F (image_mset (\_. \<^bold>1) A) = \<^bold>1" by (simp add: neutral) private lemma F_image_mset_product: "F {#g x j \<^bold>* F {#g i j. i \# A#}. j \# B#} = F (image_mset (g x) B) \<^bold>* F {#F {#g i j. i \# A#}. j \# B#}" by (induction B) (simp_all add: left_commute semigroup.assoc semigroup_axioms) lemma swap: "F (image_mset (\i. F (image_mset (g i) B)) A) = F (image_mset (\j. F (image_mset (\i. g i j) A)) B)" apply (induction A, simp) apply (induction B, auto simp add: F_image_mset_product ac_simps) done lemma distrib: "F (image_mset (\x. g x \<^bold>* h x) A) = F (image_mset g A) \<^bold>* F (image_mset h A)" by (induction A) (auto simp: ac_simps) lemma union_disjoint: "A \# B = {#} \ F (image_mset g (A \# B)) = F (image_mset g A) \<^bold>* F (image_mset g B)" by (induction A) (auto simp: ac_simps) end end lemma comp_fun_commute_plus_mset[simp]: "comp_fun_commute ((+) :: 'a multiset \ _ \ _)" by standard (simp add: add_ac comp_def) declare comp_fun_commute.fold_mset_add_mset[OF comp_fun_commute_plus_mset, simp] lemma in_mset_fold_plus_iff[iff]: "x \# fold_mset (+) M NN \ x \# M \ (\N. N \# NN \ x \# N)" by (induct NN) auto context comm_monoid_add begin sublocale sum_mset: comm_monoid_mset plus 0 defines sum_mset = sum_mset.F .. lemma sum_unfold_sum_mset: "sum f A = sum_mset (image_mset f (mset_set A))" by (cases "finite A") (induct A rule: finite_induct, simp_all) end notation sum_mset ("\\<^sub>#") syntax (ASCII) "_sum_mset_image" :: "pttrn \ 'b set \ 'a \ 'a::comm_monoid_add" ("(3SUM _:#_. _)" [0, 51, 10] 10) syntax "_sum_mset_image" :: "pttrn \ 'b set \ 'a \ 'a::comm_monoid_add" ("(3\_\#_. _)" [0, 51, 10] 10) translations "\i \# A. b" \ "CONST sum_mset (CONST image_mset (\i. b) A)" context comm_monoid_add begin lemma sum_mset_sum_list: "sum_mset (mset xs) = sum_list xs" by (induction xs) auto end context canonically_ordered_monoid_add begin lemma sum_mset_0_iff [simp]: "sum_mset M = 0 \ (\x \ set_mset M. x = 0)" by (induction M) auto end context ordered_comm_monoid_add begin lemma sum_mset_mono: "sum_mset (image_mset f K) \ sum_mset (image_mset g K)" if "\i. i \# K \ f i \ g i" using that by (induction K) (simp_all add: add_mono) end context ordered_cancel_comm_monoid_diff begin lemma sum_mset_diff: "sum_mset (M - N) = sum_mset M - sum_mset N" if "N \# M" for M N :: "'a multiset" using that by (auto simp add: subset_mset.le_iff_add) end context semiring_0 begin lemma sum_mset_distrib_left: "c * (\x \# M. f x) = (\x \# M. c * f(x))" by (induction M) (simp_all add: algebra_simps) lemma sum_mset_distrib_right: "(\x \# M. f x) * c = (\x \# M. f x * c)" by (induction M) (simp_all add: algebra_simps) end lemma sum_mset_product: fixes f :: "'a::{comm_monoid_add,times} \ 'b::semiring_0" shows "(\i \# A. f i) * (\i \# B. g i) = (\i\#A. \j\#B. f i * g j)" by (subst sum_mset.swap) (simp add: sum_mset_distrib_left sum_mset_distrib_right) context semiring_1 begin lemma sum_mset_replicate_mset [simp]: "sum_mset (replicate_mset n a) = of_nat n * a" by (induction n) (simp_all add: algebra_simps) lemma sum_mset_delta: "sum_mset (image_mset (\x. if x = y then c else 0) A) = c * of_nat (count A y)" by (induction A) (simp_all add: algebra_simps) lemma sum_mset_delta': "sum_mset (image_mset (\x. if y = x then c else 0) A) = c * of_nat (count A y)" by (induction A) (simp_all add: algebra_simps) end lemma of_nat_sum_mset [simp]: "of_nat (sum_mset A) = sum_mset (image_mset of_nat A)" by (induction A) auto lemma size_eq_sum_mset: "size M = (\a\#M. 1)" using image_mset_const_eq [of "1::nat" M] by simp lemma size_mset_set [simp]: "size (mset_set A) = card A" by (simp only: size_eq_sum_mset card_eq_sum sum_unfold_sum_mset) lemma sum_mset_constant [simp]: fixes y :: "'b::semiring_1" shows \(\x\#A. y) = of_nat (size A) * y\ by (induction A) (auto simp: algebra_simps) lemma set_mset_Union_mset[simp]: "set_mset (\\<^sub># MM) = (\M \ set_mset MM. set_mset M)" by (induct MM) auto lemma in_Union_mset_iff[iff]: "x \# \\<^sub># MM \ (\M. M \# MM \ x \# M)" by (induct MM) auto lemma count_sum: "count (sum f A) x = sum (\a. count (f a) x) A" by (induct A rule: infinite_finite_induct) simp_all lemma sum_eq_empty_iff: assumes "finite A" shows "sum f A = {#} \ (\a\A. f a = {#})" using assms by induct simp_all lemma Union_mset_empty_conv[simp]: "\\<^sub># M = {#} \ (\i\#M. i = {#})" by (induction M) auto lemma Union_image_single_mset[simp]: "\\<^sub># (image_mset (\x. {#x#}) m) = m" by(induction m) auto context comm_monoid_mult begin sublocale prod_mset: comm_monoid_mset times 1 defines prod_mset = prod_mset.F .. lemma prod_mset_empty: "prod_mset {#} = 1" by (fact prod_mset.empty) lemma prod_mset_singleton: "prod_mset {#x#} = x" by (fact prod_mset.singleton) lemma prod_mset_Un: "prod_mset (A + B) = prod_mset A * prod_mset B" by (fact prod_mset.union) lemma prod_mset_prod_list: "prod_mset (mset xs) = prod_list xs" by (induct xs) auto lemma prod_mset_replicate_mset [simp]: "prod_mset (replicate_mset n a) = a ^ n" by (induct n) simp_all lemma prod_unfold_prod_mset: "prod f A = prod_mset (image_mset f (mset_set A))" by (cases "finite A") (induct A rule: finite_induct, simp_all) lemma prod_mset_multiplicity: "prod_mset M = prod (\x. x ^ count M x) (set_mset M)" by (simp add: fold_mset_def prod.eq_fold prod_mset.eq_fold funpow_times_power comp_def) lemma prod_mset_delta: "prod_mset (image_mset (\x. if x = y then c else 1) A) = c ^ count A y" by (induction A) simp_all lemma prod_mset_delta': "prod_mset (image_mset (\x. if y = x then c else 1) A) = c ^ count A y" by (induction A) simp_all lemma prod_mset_subset_imp_dvd: assumes "A \# B" shows "prod_mset A dvd prod_mset B" proof - from assms have "B = (B - A) + A" by (simp add: subset_mset.diff_add) also have "prod_mset \ = prod_mset (B - A) * prod_mset A" by simp also have "prod_mset A dvd \" by simp finally show ?thesis . qed lemma dvd_prod_mset: assumes "x \# A" shows "x dvd prod_mset A" using assms prod_mset_subset_imp_dvd [of "{#x#}" A] by simp end notation prod_mset ("\\<^sub>#") syntax (ASCII) "_prod_mset_image" :: "pttrn \ 'b set \ 'a \ 'a::comm_monoid_mult" ("(3PROD _:#_. _)" [0, 51, 10] 10) syntax "_prod_mset_image" :: "pttrn \ 'b set \ 'a \ 'a::comm_monoid_mult" ("(3\_\#_. _)" [0, 51, 10] 10) translations "\i \# A. b" \ "CONST prod_mset (CONST image_mset (\i. b) A)" lemma prod_mset_constant [simp]: "(\_\#A. c) = c ^ size A" by (simp add: image_mset_const_eq) lemma (in semidom) prod_mset_zero_iff [iff]: "prod_mset A = 0 \ 0 \# A" by (induct A) auto lemma (in semidom_divide) prod_mset_diff: assumes "B \# A" and "0 \# B" shows "prod_mset (A - B) = prod_mset A div prod_mset B" proof - from assms obtain C where "A = B + C" by (metis subset_mset.add_diff_inverse) with assms show ?thesis by simp qed lemma (in semidom_divide) prod_mset_minus: assumes "a \# A" and "a \ 0" shows "prod_mset (A - {#a#}) = prod_mset A div a" using assms prod_mset_diff [of "{#a#}" A] by auto lemma (in normalization_semidom) normalize_prod_mset_normalize: "normalize (prod_mset (image_mset normalize A)) = normalize (prod_mset A)" proof (induction A) case (add x A) have "normalize (prod_mset (image_mset normalize (add_mset x A))) = normalize (x * normalize (prod_mset (image_mset normalize A)))" by simp also note add.IH finally show ?case by simp qed auto lemma (in algebraic_semidom) is_unit_prod_mset_iff: "is_unit (prod_mset A) \ (\x \# A. is_unit x)" by (induct A) (auto simp: is_unit_mult_iff) lemma (in normalization_semidom_multiplicative) normalize_prod_mset: "normalize (prod_mset A) = prod_mset (image_mset normalize A)" by (induct A) (simp_all add: normalize_mult) lemma (in normalization_semidom_multiplicative) normalized_prod_msetI: assumes "\a. a \# A \ normalize a = a" shows "normalize (prod_mset A) = prod_mset A" proof - from assms have "image_mset normalize A = A" by (induct A) simp_all then show ?thesis by (simp add: normalize_prod_mset) qed subsection \Multiset as order-ignorant lists\ context linorder begin lemma mset_insort [simp]: "mset (insort_key k x xs) = add_mset x (mset xs)" by (induct xs) simp_all lemma mset_sort [simp]: "mset (sort_key k xs) = mset xs" by (induct xs) simp_all text \ This lemma shows which properties suffice to show that a function \f\ with \f xs = ys\ behaves like sort. \ lemma properties_for_sort_key: assumes "mset ys = mset xs" and "\k. k \ set ys \ filter (\x. f k = f x) ys = filter (\x. f k = f x) xs" and "sorted (map f ys)" shows "sort_key f xs = ys" using assms proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case (Cons x xs) from Cons.prems(2) have "\k \ set ys. filter (\x. f k = f x) (remove1 x ys) = filter (\x. f k = f x) xs" by (simp add: filter_remove1) with Cons.prems have "sort_key f xs = remove1 x ys" by (auto intro!: Cons.hyps simp add: sorted_map_remove1) moreover from Cons.prems have "x \# mset ys" by auto then have "x \ set ys" by simp ultimately show ?case using Cons.prems by (simp add: insort_key_remove1) qed lemma properties_for_sort: assumes multiset: "mset ys = mset xs" and "sorted ys" shows "sort xs = ys" proof (rule properties_for_sort_key) from multiset show "mset ys = mset xs" . from \sorted ys\ show "sorted (map (\x. x) ys)" by simp from multiset have "length (filter (\y. k = y) ys) = length (filter (\x. k = x) xs)" for k by (rule mset_eq_length_filter) then have "replicate (length (filter (\y. k = y) ys)) k = replicate (length (filter (\x. k = x) xs)) k" for k by simp then show "k \ set ys \ filter (\y. k = y) ys = filter (\x. k = x) xs" for k by (simp add: replicate_length_filter) qed lemma sort_key_inj_key_eq: assumes mset_equal: "mset xs = mset ys" and "inj_on f (set xs)" and "sorted (map f ys)" shows "sort_key f xs = ys" proof (rule properties_for_sort_key) from mset_equal show "mset ys = mset xs" by simp from \sorted (map f ys)\ show "sorted (map f ys)" . show "[x\ys . f k = f x] = [x\xs . f k = f x]" if "k \ set ys" for k proof - from mset_equal have set_equal: "set xs = set ys" by (rule mset_eq_setD) with that have "insert k (set ys) = set ys" by auto with \inj_on f (set xs)\ have inj: "inj_on f (insert k (set ys))" by (simp add: set_equal) from inj have "[x\ys . f k = f x] = filter (HOL.eq k) ys" by (auto intro!: inj_on_filter_key_eq) also have "\ = replicate (count (mset ys) k) k" by (simp add: replicate_count_mset_eq_filter_eq) also have "\ = replicate (count (mset xs) k) k" using mset_equal by simp also have "\ = filter (HOL.eq k) xs" by (simp add: replicate_count_mset_eq_filter_eq) also have "\ = [x\xs . f k = f x]" using inj by (auto intro!: inj_on_filter_key_eq [symmetric] simp add: set_equal) finally show ?thesis . qed qed lemma sort_key_eq_sort_key: assumes "mset xs = mset ys" and "inj_on f (set xs)" shows "sort_key f xs = sort_key f ys" by (rule sort_key_inj_key_eq) (simp_all add: assms) lemma sort_key_by_quicksort: "sort_key f xs = sort_key f [x\xs. f x < f (xs ! (length xs div 2))] @ [x\xs. f x = f (xs ! (length xs div 2))] @ sort_key f [x\xs. f x > f (xs ! (length xs div 2))]" (is "sort_key f ?lhs = ?rhs") proof (rule properties_for_sort_key) show "mset ?rhs = mset ?lhs" by (rule multiset_eqI) auto show "sorted (map f ?rhs)" by (auto simp add: sorted_append intro: sorted_map_same) next fix l assume "l \ set ?rhs" let ?pivot = "f (xs ! (length xs div 2))" have *: "\x. f l = f x \ f x = f l" by auto have "[x \ sort_key f xs . f x = f l] = [x \ xs. f x = f l]" unfolding filter_sort by (rule properties_for_sort_key) (auto intro: sorted_map_same) with * have **: "[x \ sort_key f xs . f l = f x] = [x \ xs. f l = f x]" by simp have "\x P. P (f x) ?pivot \ f l = f x \ P (f l) ?pivot \ f l = f x" by auto then have "\P. [x \ sort_key f xs . P (f x) ?pivot \ f l = f x] = [x \ sort_key f xs. P (f l) ?pivot \ f l = f x]" by simp note *** = this [of "(<)"] this [of "(>)"] this [of "(=)"] show "[x \ ?rhs. f l = f x] = [x \ ?lhs. f l = f x]" proof (cases "f l" ?pivot rule: linorder_cases) case less then have "f l \ ?pivot" and "\ f l > ?pivot" by auto with less show ?thesis by (simp add: filter_sort [symmetric] ** ***) next case equal then show ?thesis by (simp add: * less_le) next case greater then have "f l \ ?pivot" and "\ f l < ?pivot" by auto with greater show ?thesis by (simp add: filter_sort [symmetric] ** ***) qed qed lemma sort_by_quicksort: "sort xs = sort [x\xs. x < xs ! (length xs div 2)] @ [x\xs. x = xs ! (length xs div 2)] @ sort [x\xs. x > xs ! (length xs div 2)]" (is "sort ?lhs = ?rhs") using sort_key_by_quicksort [of "\x. x", symmetric] by simp text \A stable parameterized quicksort\ definition part :: "('b \ 'a) \ 'a \ 'b list \ 'b list \ 'b list \ 'b list" where "part f pivot xs = ([x \ xs. f x < pivot], [x \ xs. f x = pivot], [x \ xs. pivot < f x])" lemma part_code [code]: "part f pivot [] = ([], [], [])" "part f pivot (x # xs) = (let (lts, eqs, gts) = part f pivot xs; x' = f x in if x' < pivot then (x # lts, eqs, gts) else if x' > pivot then (lts, eqs, x # gts) else (lts, x # eqs, gts))" by (auto simp add: part_def Let_def split_def) lemma sort_key_by_quicksort_code [code]: "sort_key f xs = (case xs of [] \ [] | [x] \ xs | [x, y] \ (if f x \ f y then xs else [y, x]) | _ \ let (lts, eqs, gts) = part f (f (xs ! (length xs div 2))) xs in sort_key f lts @ eqs @ sort_key f gts)" proof (cases xs) case Nil then show ?thesis by simp next case (Cons _ ys) note hyps = Cons show ?thesis proof (cases ys) case Nil with hyps show ?thesis by simp next case (Cons _ zs) note hyps = hyps Cons show ?thesis proof (cases zs) case Nil with hyps show ?thesis by auto next case Cons from sort_key_by_quicksort [of f xs] have "sort_key f xs = (let (lts, eqs, gts) = part f (f (xs ! (length xs div 2))) xs in sort_key f lts @ eqs @ sort_key f gts)" by (simp only: split_def Let_def part_def fst_conv snd_conv) with hyps Cons show ?thesis by (simp only: list.cases) qed qed qed end hide_const (open) part lemma mset_remdups_subset_eq: "mset (remdups xs) \# mset xs" by (induct xs) (auto intro: subset_mset.order_trans) lemma mset_update: "i < length ls \ mset (ls[i := v]) = add_mset v (mset ls - {#ls ! i#})" proof (induct ls arbitrary: i) case Nil then show ?case by simp next case (Cons x xs) show ?case proof (cases i) case 0 then show ?thesis by simp next case (Suc i') with Cons show ?thesis by (cases \x = xs ! i'\) auto qed qed lemma mset_swap: "i < length ls \ j < length ls \ mset (ls[j := ls ! i, i := ls ! j]) = mset ls" by (cases "i = j") (simp_all add: mset_update nth_mem_mset) lemma mset_eq_finite: \finite {ys. mset ys = mset xs}\ proof - have \{ys. mset ys = mset xs} \ {ys. set ys \ set xs \ length ys \ length xs}\ by (auto simp add: dest: mset_eq_setD mset_eq_length) moreover have \finite {ys. set ys \ set xs \ length ys \ length xs}\ using finite_lists_length_le by blast ultimately show ?thesis by (rule finite_subset) qed subsection \The multiset order\ subsubsection \Well-foundedness\ definition mult1 :: "('a \ 'a) set \ ('a multiset \ 'a multiset) set" where "mult1 r = {(N, M). \a M0 K. M = add_mset a M0 \ N = M0 + K \ (\b. b \# K \ (b, a) \ r)}" definition mult :: "('a \ 'a) set \ ('a multiset \ 'a multiset) set" where "mult r = (mult1 r)\<^sup>+" lemma mult1I: assumes "M = add_mset a M0" and "N = M0 + K" and "\b. b \# K \ (b, a) \ r" shows "(N, M) \ mult1 r" using assms unfolding mult1_def by blast lemma mult1E: assumes "(N, M) \ mult1 r" obtains a M0 K where "M = add_mset a M0" "N = M0 + K" "\b. b \# K \ (b, a) \ r" using assms unfolding mult1_def by blast lemma mono_mult1: assumes "r \ r'" shows "mult1 r \ mult1 r'" unfolding mult1_def using assms by blast lemma mono_mult: assumes "r \ r'" shows "mult r \ mult r'" unfolding mult_def using mono_mult1[OF assms] trancl_mono by blast lemma not_less_empty [iff]: "(M, {#}) \ mult1 r" by (simp add: mult1_def) lemma less_add: assumes mult1: "(N, add_mset a M0) \ mult1 r" shows "(\M. (M, M0) \ mult1 r \ N = add_mset a M) \ (\K. (\b. b \# K \ (b, a) \ r) \ N = M0 + K)" proof - let ?r = "\K a. \b. b \# K \ (b, a) \ r" let ?R = "\N M. \a M0 K. M = add_mset a M0 \ N = M0 + K \ ?r K a" obtain a' M0' K where M0: "add_mset a M0 = add_mset a' M0'" and N: "N = M0' + K" and r: "?r K a'" using mult1 unfolding mult1_def by auto show ?thesis (is "?case1 \ ?case2") proof - from M0 consider "M0 = M0'" "a = a'" | K' where "M0 = add_mset a' K'" "M0' = add_mset a K'" by atomize_elim (simp only: add_eq_conv_ex) then show ?thesis proof cases case 1 with N r have "?r K a \ N = M0 + K" by simp then have ?case2 .. then show ?thesis .. next case 2 from N 2(2) have n: "N = add_mset a (K' + K)" by simp with r 2(1) have "?R (K' + K) M0" by blast with n have ?case1 by (simp add: mult1_def) then show ?thesis .. qed qed qed lemma all_accessible: assumes "wf r" shows "\M. M \ Wellfounded.acc (mult1 r)" proof let ?R = "mult1 r" let ?W = "Wellfounded.acc ?R" { fix M M0 a assume M0: "M0 \ ?W" and wf_hyp: "\b. (b, a) \ r \ (\M \ ?W. add_mset b M \ ?W)" and acc_hyp: "\M. (M, M0) \ ?R \ add_mset a M \ ?W" have "add_mset a M0 \ ?W" proof (rule accI [of "add_mset a M0"]) fix N assume "(N, add_mset a M0) \ ?R" then consider M where "(M, M0) \ ?R" "N = add_mset a M" | K where "\b. b \# K \ (b, a) \ r" "N = M0 + K" by atomize_elim (rule less_add) then show "N \ ?W" proof cases case 1 from acc_hyp have "(M, M0) \ ?R \ add_mset a M \ ?W" .. from this and \(M, M0) \ ?R\ have "add_mset a M \ ?W" .. then show "N \ ?W" by (simp only: \N = add_mset a M\) next case 2 from this(1) have "M0 + K \ ?W" proof (induct K) case empty from M0 show "M0 + {#} \ ?W" by simp next case (add x K) from add.prems have "(x, a) \ r" by simp with wf_hyp have "\M \ ?W. add_mset x M \ ?W" by blast moreover from add have "M0 + K \ ?W" by simp ultimately have "add_mset x (M0 + K) \ ?W" .. then show "M0 + (add_mset x K) \ ?W" by simp qed then show "N \ ?W" by (simp only: 2(2)) qed qed } note tedious_reasoning = this show "M \ ?W" for M proof (induct M) show "{#} \ ?W" proof (rule accI) fix b assume "(b, {#}) \ ?R" with not_less_empty show "b \ ?W" by contradiction qed fix M a assume "M \ ?W" from \wf r\ have "\M \ ?W. add_mset a M \ ?W" proof induct fix a assume r: "\b. (b, a) \ r \ (\M \ ?W. add_mset b M \ ?W)" show "\M \ ?W. add_mset a M \ ?W" proof fix M assume "M \ ?W" then show "add_mset a M \ ?W" by (rule acc_induct) (rule tedious_reasoning [OF _ r]) qed qed from this and \M \ ?W\ show "add_mset a M \ ?W" .. qed qed theorem wf_mult1: "wf r \ wf (mult1 r)" by (rule acc_wfI) (rule all_accessible) theorem wf_mult: "wf r \ wf (mult r)" unfolding mult_def by (rule wf_trancl) (rule wf_mult1) subsubsection \Closure-free presentation\ text \One direction.\ lemma mult_implies_one_step: assumes trans: "trans r" and MN: "(M, N) \ mult r" shows "\I J K. N = I + J \ M = I + K \ J \ {#} \ (\k \ set_mset K. \j \ set_mset J. (k, j) \ r)" using MN unfolding mult_def mult1_def proof (induction rule: converse_trancl_induct) case (base y) then show ?case by force next case (step y z) note yz = this(1) and zN = this(2) and N_decomp = this(3) obtain I J K where N: "N = I + J" "z = I + K" "J \ {#}" "\k\#K. \j\#J. (k, j) \ r" using N_decomp by blast obtain a M0 K' where z: "z = add_mset a M0" and y: "y = M0 + K'" and K: "\b. b \# K' \ (b, a) \ r" using yz by blast show ?case proof (cases "a \# K") case True moreover have "\j\#J. (k, j) \ r" if "k \# K'" for k using K N trans True by (meson that transE) ultimately show ?thesis by (rule_tac x = I in exI, rule_tac x = J in exI, rule_tac x = "(K - {#a#}) + K'" in exI) (use z y N in \auto simp del: subset_mset.add_diff_assoc2 dest: in_diffD\) next case False then have "a \# I" by (metis N(2) union_iff union_single_eq_member z) moreover have "M0 = I + K - {#a#}" using N(2) z by force ultimately show ?thesis by (rule_tac x = "I - {#a#}" in exI, rule_tac x = "add_mset a J" in exI, rule_tac x = "K + K'" in exI) (use z y N False K in \auto simp: add.assoc\) qed qed lemma one_step_implies_mult: assumes "J \ {#}" and "\k \ set_mset K. \j \ set_mset J. (k, j) \ r" shows "(I + K, I + J) \ mult r" using assms proof (induction "size J" arbitrary: I J K) case 0 then show ?case by auto next case (Suc n) note IH = this(1) and size_J = this(2)[THEN sym] obtain J' a where J: "J = add_mset a J'" using size_J by (blast dest: size_eq_Suc_imp_eq_union) show ?case proof (cases "J' = {#}") case True then show ?thesis using J Suc by (fastforce simp add: mult_def mult1_def) next case [simp]: False have K: "K = {#x \# K. (x, a) \ r#} + {#x \# K. (x, a) \ r#}" by simp have "(I + K, (I + {# x \# K. (x, a) \ r #}) + J') \ mult r" using IH[of J' "{# x \# K. (x, a) \ r#}" "I + {# x \# K. (x, a) \ r#}"] J Suc.prems K size_J by (auto simp: ac_simps) moreover have "(I + {#x \# K. (x, a) \ r#} + J', I + J) \ mult r" by (fastforce simp: J mult1_def mult_def) ultimately show ?thesis unfolding mult_def by simp qed qed lemma subset_implies_mult: assumes sub: "A \# B" shows "(A, B) \ mult r" proof - have ApBmA: "A + (B - A) = B" using sub by simp have BmA: "B - A \ {#}" using sub by (simp add: Diff_eq_empty_iff_mset subset_mset.less_le_not_le) thus ?thesis by (rule one_step_implies_mult[of "B - A" "{#}" _ A, unfolded ApBmA, simplified]) qed subsection \The multiset extension is cancellative for multiset union\ lemma mult_cancel: assumes "trans s" and "irrefl s" shows "(X + Z, Y + Z) \ mult s \ (X, Y) \ mult s" (is "?L \ ?R") proof assume ?L thus ?R proof (induct Z) case (add z Z) obtain X' Y' Z' where *: "add_mset z X + Z = Z' + X'" "add_mset z Y + Z = Z' + Y'" "Y' \ {#}" "\x \ set_mset X'. \y \ set_mset Y'. (x, y) \ s" using mult_implies_one_step[OF \trans s\ add(2)] by auto consider Z2 where "Z' = add_mset z Z2" | X2 Y2 where "X' = add_mset z X2" "Y' = add_mset z Y2" using *(1,2) by (metis add_mset_remove_trivial_If insert_iff set_mset_add_mset_insert union_iff) thus ?case proof (cases) case 1 thus ?thesis using * one_step_implies_mult[of Y' X' s Z2] by (auto simp: add.commute[of _ "{#_#}"] add.assoc intro: add(1)) next case 2 then obtain y where "y \ set_mset Y2" "(z, y) \ s" using *(4) \irrefl s\ by (auto simp: irrefl_def) moreover from this transD[OF \trans s\ _ this(2)] have "x' \ set_mset X2 \ \y \ set_mset Y2. (x', y) \ s" for x' using 2 *(4)[rule_format, of x'] by auto ultimately show ?thesis using * one_step_implies_mult[of Y2 X2 s Z'] 2 by (force simp: add.commute[of "{#_#}"] add.assoc[symmetric] intro: add(1)) qed qed auto next assume ?R then obtain I J K where "Y = I + J" "X = I + K" "J \ {#}" "\k \ set_mset K. \j \ set_mset J. (k, j) \ s" using mult_implies_one_step[OF \trans s\] by blast thus ?L using one_step_implies_mult[of J K s "I + Z"] by (auto simp: ac_simps) qed lemmas mult_cancel_add_mset = mult_cancel[of _ _ "{#_#}", unfolded union_mset_add_mset_right add.comm_neutral] lemma mult_cancel_max: assumes "trans s" and "irrefl s" shows "(X, Y) \ mult s \ (X - X \# Y, Y - X \# Y) \ mult s" (is "?L \ ?R") proof - have "X - X \# Y + X \# Y = X" "Y - X \# Y + X \# Y = Y" by (auto simp flip: count_inject) thus ?thesis using mult_cancel[OF assms, of "X - X \# Y" "X \# Y" "Y - X \# Y"] by auto qed subsection \Quasi-executable version of the multiset extension\ text \ Predicate variants of \mult\ and the reflexive closure of \mult\, which are executable whenever the given predicate \P\ is. Together with the standard code equations for \(\#\) and \(-\) this should yield quadratic (with respect to calls to \P\) implementations of \multp\ and \multeqp\. \ definition multp :: "('a \ 'a \ bool) \ 'a multiset \ 'a multiset \ bool" where "multp P N M = (let Z = M \# N; X = M - Z in X \ {#} \ (let Y = N - Z in (\y \ set_mset Y. \x \ set_mset X. P y x)))" definition multeqp :: "('a \ 'a \ bool) \ 'a multiset \ 'a multiset \ bool" where "multeqp P N M = (let Z = M \# N; X = M - Z; Y = N - Z in (\y \ set_mset Y. \x \ set_mset X. P y x))" lemma multp_iff: assumes "irrefl R" and "trans R" and [simp]: "\x y. P x y \ (x, y) \ R" shows "multp P N M \ (N, M) \ mult R" (is "?L \ ?R") proof - have *: "M \# N + (N - M \# N) = N" "M \# N + (M - M \# N) = M" "(M - M \# N) \# (N - M \# N) = {#}" by (auto simp flip: count_inject) show ?thesis proof assume ?L thus ?R using one_step_implies_mult[of "M - M \# N" "N - M \# N" R "M \# N"] * by (auto simp: multp_def Let_def) next { fix I J K :: "'a multiset" assume "(I + J) \# (I + K) = {#}" then have "I = {#}" by (metis inter_union_distrib_right union_eq_empty) } note [dest!] = this assume ?R thus ?L using mult_implies_one_step[OF assms(2), of "N - M \# N" "M - M \# N"] mult_cancel_max[OF assms(2,1), of "N" "M"] * by (auto simp: multp_def) qed qed lemma multeqp_iff: assumes "irrefl R" and "trans R" and "\x y. P x y \ (x, y) \ R" shows "multeqp P N M \ (N, M) \ (mult R)\<^sup>=" proof - { assume "N \ M" "M - M \# N = {#}" then obtain y where "count N y \ count M y" by (auto simp flip: count_inject) then have "\y. count M y < count N y" using \M - M \# N = {#}\ by (auto simp flip: count_inject dest!: le_neq_implies_less fun_cong[of _ _ y]) } then have "multeqp P N M \ multp P N M \ N = M" by (auto simp: multeqp_def multp_def Let_def in_diff_count) thus ?thesis using multp_iff[OF assms] by simp qed subsubsection \Partial-order properties\ lemma (in preorder) mult1_lessE: assumes "(N, M) \ mult1 {(a, b). a < b}" obtains a M0 K where "M = add_mset a M0" "N = M0 + K" "a \# K" "\b. b \# K \ b < a" proof - from assms obtain a M0 K where "M = add_mset a M0" "N = M0 + K" and *: "b \# K \ b < a" for b by (blast elim: mult1E) moreover from * [of a] have "a \# K" by auto ultimately show thesis by (auto intro: that) qed instantiation multiset :: (preorder) order begin definition less_multiset :: "'a multiset \ 'a multiset \ bool" where "M' < M \ (M', M) \ mult {(x', x). x' < x}" definition less_eq_multiset :: "'a multiset \ 'a multiset \ bool" where "less_eq_multiset M' M \ M' < M \ M' = M" instance proof - have irrefl: "\ M < M" for M :: "'a multiset" proof assume "M < M" then have MM: "(M, M) \ mult {(x, y). x < y}" by (simp add: less_multiset_def) have "trans {(x'::'a, x). x' < x}" by (metis (mono_tags, lifting) case_prodD case_prodI less_trans mem_Collect_eq transI) moreover note MM ultimately have "\I J K. M = I + J \ M = I + K \ J \ {#} \ (\k\set_mset K. \j\set_mset J. (k, j) \ {(x, y). x < y})" by (rule mult_implies_one_step) then obtain I J K where "M = I + J" and "M = I + K" and "J \ {#}" and "(\k\set_mset K. \j\set_mset J. (k, j) \ {(x, y). x < y})" by blast then have *: "K \ {#}" and **: "\k\set_mset K. \j\set_mset K. k < j" by auto have "finite (set_mset K)" by simp moreover note ** ultimately have "set_mset K = {}" by (induct rule: finite_induct) (auto intro: order_less_trans) with * show False by simp qed have trans: "K < M \ M < N \ K < N" for K M N :: "'a multiset" unfolding less_multiset_def mult_def by (blast intro: trancl_trans) show "OFCLASS('a multiset, order_class)" by standard (auto simp add: less_eq_multiset_def irrefl dest: trans) qed -end \ \FIXME avoid junk stemming from type class interpretation\ + +end lemma mset_le_irrefl [elim!]: fixes M :: "'a::preorder multiset" shows "M < M \ R" by simp subsubsection \Monotonicity of multiset union\ lemma mult1_union: "(B, D) \ mult1 r \ (C + B, C + D) \ mult1 r" by (force simp: mult1_def) lemma union_le_mono2: "B < D \ C + B < C + (D::'a::preorder multiset)" apply (unfold less_multiset_def mult_def) apply (erule trancl_induct) apply (blast intro: mult1_union) apply (blast intro: mult1_union trancl_trans) done lemma union_le_mono1: "B < D \ B + C < D + (C::'a::preorder multiset)" apply (subst add.commute [of B C]) apply (subst add.commute [of D C]) apply (erule union_le_mono2) done lemma union_less_mono: fixes A B C D :: "'a::preorder multiset" shows "A < C \ B < D \ A + B < C + D" by (blast intro!: union_le_mono1 union_le_mono2 less_trans) instantiation multiset :: (preorder) ordered_ab_semigroup_add begin instance by standard (auto simp add: less_eq_multiset_def intro: union_le_mono2) end subsubsection \Termination proofs with multiset orders\ lemma multi_member_skip: "x \# XS \ x \# {# y #} + XS" and multi_member_this: "x \# {# x #} + XS" and multi_member_last: "x \# {# x #}" by auto definition "ms_strict = mult pair_less" definition "ms_weak = ms_strict \ Id" lemma ms_reduction_pair: "reduction_pair (ms_strict, ms_weak)" unfolding reduction_pair_def ms_strict_def ms_weak_def pair_less_def by (auto intro: wf_mult1 wf_trancl simp: mult_def) lemma smsI: "(set_mset A, set_mset B) \ max_strict \ (Z + A, Z + B) \ ms_strict" unfolding ms_strict_def by (rule one_step_implies_mult) (auto simp add: max_strict_def pair_less_def elim!:max_ext.cases) lemma wmsI: "(set_mset A, set_mset B) \ max_strict \ A = {#} \ B = {#} \ (Z + A, Z + B) \ ms_weak" unfolding ms_weak_def ms_strict_def by (auto simp add: pair_less_def max_strict_def elim!:max_ext.cases intro: one_step_implies_mult) inductive pw_leq where pw_leq_empty: "pw_leq {#} {#}" | pw_leq_step: "\(x,y) \ pair_leq; pw_leq X Y \ \ pw_leq ({#x#} + X) ({#y#} + Y)" lemma pw_leq_lstep: "(x, y) \ pair_leq \ pw_leq {#x#} {#y#}" by (drule pw_leq_step) (rule pw_leq_empty, simp) lemma pw_leq_split: assumes "pw_leq X Y" shows "\A B Z. X = A + Z \ Y = B + Z \ ((set_mset A, set_mset B) \ max_strict \ (B = {#} \ A = {#}))" using assms proof induct case pw_leq_empty thus ?case by auto next case (pw_leq_step x y X Y) then obtain A B Z where [simp]: "X = A + Z" "Y = B + Z" and 1[simp]: "(set_mset A, set_mset B) \ max_strict \ (B = {#} \ A = {#})" by auto from pw_leq_step consider "x = y" | "(x, y) \ pair_less" unfolding pair_leq_def by auto thus ?case proof cases case [simp]: 1 have "{#x#} + X = A + ({#y#}+Z) \ {#y#} + Y = B + ({#y#}+Z) \ ((set_mset A, set_mset B) \ max_strict \ (B = {#} \ A = {#}))" by auto thus ?thesis by blast next case 2 let ?A' = "{#x#} + A" and ?B' = "{#y#} + B" have "{#x#} + X = ?A' + Z" "{#y#} + Y = ?B' + Z" by auto moreover have "(set_mset ?A', set_mset ?B') \ max_strict" using 1 2 unfolding max_strict_def by (auto elim!: max_ext.cases) ultimately show ?thesis by blast qed qed lemma assumes pwleq: "pw_leq Z Z'" shows ms_strictI: "(set_mset A, set_mset B) \ max_strict \ (Z + A, Z' + B) \ ms_strict" and ms_weakI1: "(set_mset A, set_mset B) \ max_strict \ (Z + A, Z' + B) \ ms_weak" and ms_weakI2: "(Z + {#}, Z' + {#}) \ ms_weak" proof - from pw_leq_split[OF pwleq] obtain A' B' Z'' where [simp]: "Z = A' + Z''" "Z' = B' + Z''" and mx_or_empty: "(set_mset A', set_mset B') \ max_strict \ (A' = {#} \ B' = {#})" by blast { assume max: "(set_mset A, set_mset B) \ max_strict" from mx_or_empty have "(Z'' + (A + A'), Z'' + (B + B')) \ ms_strict" proof assume max': "(set_mset A', set_mset B') \ max_strict" with max have "(set_mset (A + A'), set_mset (B + B')) \ max_strict" by (auto simp: max_strict_def intro: max_ext_additive) thus ?thesis by (rule smsI) next assume [simp]: "A' = {#} \ B' = {#}" show ?thesis by (rule smsI) (auto intro: max) qed thus "(Z + A, Z' + B) \ ms_strict" by (simp add: ac_simps) thus "(Z + A, Z' + B) \ ms_weak" by (simp add: ms_weak_def) } from mx_or_empty have "(Z'' + A', Z'' + B') \ ms_weak" by (rule wmsI) thus "(Z + {#}, Z' + {#}) \ ms_weak" by (simp add: ac_simps) qed lemma empty_neutral: "{#} + x = x" "x + {#} = x" and nonempty_plus: "{# x #} + rs \ {#}" and nonempty_single: "{# x #} \ {#}" by auto setup \ let fun msetT T = Type (\<^type_name>\multiset\, [T]); fun mk_mset T [] = Const (\<^const_abbrev>\empty_mset\, msetT T) | mk_mset T [x] = Const (\<^const_name>\add_mset\, T --> msetT T --> msetT T) $ x $ Const (\<^const_abbrev>\empty_mset\, msetT T) | mk_mset T (x :: xs) = Const (\<^const_name>\plus\, msetT T --> msetT T --> msetT T) $ mk_mset T [x] $ mk_mset T xs fun mset_member_tac ctxt m i = if m <= 0 then resolve_tac ctxt @{thms multi_member_this} i ORELSE resolve_tac ctxt @{thms multi_member_last} i else resolve_tac ctxt @{thms multi_member_skip} i THEN mset_member_tac ctxt (m - 1) i fun mset_nonempty_tac ctxt = resolve_tac ctxt @{thms nonempty_plus} ORELSE' resolve_tac ctxt @{thms nonempty_single} fun regroup_munion_conv ctxt = Function_Lib.regroup_conv ctxt \<^const_abbrev>\empty_mset\ \<^const_name>\plus\ (map (fn t => t RS eq_reflection) (@{thms ac_simps} @ @{thms empty_neutral})) fun unfold_pwleq_tac ctxt i = (resolve_tac ctxt @{thms pw_leq_step} i THEN (fn st => unfold_pwleq_tac ctxt (i + 1) st)) ORELSE (resolve_tac ctxt @{thms pw_leq_lstep} i) ORELSE (resolve_tac ctxt @{thms pw_leq_empty} i) val set_mset_simps = [@{thm set_mset_empty}, @{thm set_mset_single}, @{thm set_mset_union}, @{thm Un_insert_left}, @{thm Un_empty_left}] in ScnpReconstruct.multiset_setup (ScnpReconstruct.Multiset { msetT=msetT, mk_mset=mk_mset, mset_regroup_conv=regroup_munion_conv, mset_member_tac=mset_member_tac, mset_nonempty_tac=mset_nonempty_tac, mset_pwleq_tac=unfold_pwleq_tac, set_of_simps=set_mset_simps, smsI'= @{thm ms_strictI}, wmsI2''= @{thm ms_weakI2}, wmsI1= @{thm ms_weakI1}, reduction_pair = @{thm ms_reduction_pair} }) end \ subsection \Legacy theorem bindings\ lemmas multi_count_eq = multiset_eq_iff [symmetric] lemma union_commute: "M + N = N + (M::'a multiset)" by (fact add.commute) lemma union_assoc: "(M + N) + K = M + (N + (K::'a multiset))" by (fact add.assoc) lemma union_lcomm: "M + (N + K) = N + (M + (K::'a multiset))" by (fact add.left_commute) lemmas union_ac = union_assoc union_commute union_lcomm add_mset_commute lemma union_right_cancel: "M + K = N + K \ M = (N::'a multiset)" by (fact add_right_cancel) lemma union_left_cancel: "K + M = K + N \ M = (N::'a multiset)" by (fact add_left_cancel) lemma multi_union_self_other_eq: "(A::'a multiset) + X = A + Y \ X = Y" by (fact add_left_imp_eq) lemma mset_subset_trans: "(M::'a multiset) \# K \ K \# N \ M \# N" by (fact subset_mset.less_trans) lemma multiset_inter_commute: "A \# B = B \# A" by (fact subset_mset.inf.commute) lemma multiset_inter_assoc: "A \# (B \# C) = A \# B \# C" by (fact subset_mset.inf.assoc [symmetric]) lemma multiset_inter_left_commute: "A \# (B \# C) = B \# (A \# C)" by (fact subset_mset.inf.left_commute) lemmas multiset_inter_ac = multiset_inter_commute multiset_inter_assoc multiset_inter_left_commute lemma mset_le_not_refl: "\ M < (M::'a::preorder multiset)" by (fact less_irrefl) lemma mset_le_trans: "K < M \ M < N \ K < (N::'a::preorder multiset)" by (fact less_trans) lemma mset_le_not_sym: "M < N \ \ N < (M::'a::preorder multiset)" by (fact less_not_sym) lemma mset_le_asym: "M < N \ (\ P \ N < (M::'a::preorder multiset)) \ P" by (fact less_asym) declaration \ let fun multiset_postproc _ maybe_name all_values (T as Type (_, [elem_T])) (Const _ $ t') = let val (maybe_opt, ps) = Nitpick_Model.dest_plain_fun t' ||> (~~) ||> map (apsnd (snd o HOLogic.dest_number)) fun elems_for t = (case AList.lookup (=) ps t of SOME n => replicate n t | NONE => [Const (maybe_name, elem_T --> elem_T) $ t]) in (case maps elems_for (all_values elem_T) @ (if maybe_opt then [Const (Nitpick_Model.unrep_mixfix (), elem_T)] else []) of [] => Const (\<^const_name>\zero_class.zero\, T) | ts => foldl1 (fn (s, t) => Const (\<^const_name>\add_mset\, elem_T --> T --> T) $ s $ t) ts) end | multiset_postproc _ _ _ _ t = t in Nitpick_Model.register_term_postprocessor \<^typ>\'a multiset\ multiset_postproc end \ subsection \Naive implementation using lists\ code_datatype mset lemma [code]: "{#} = mset []" by simp lemma [code]: "add_mset x (mset xs) = mset (x # xs)" by simp lemma [code]: "Multiset.is_empty (mset xs) \ List.null xs" by (simp add: Multiset.is_empty_def List.null_def) lemma union_code [code]: "mset xs + mset ys = mset (xs @ ys)" by simp lemma [code]: "image_mset f (mset xs) = mset (map f xs)" by simp lemma [code]: "filter_mset f (mset xs) = mset (filter f xs)" by simp lemma [code]: "mset xs - mset ys = mset (fold remove1 ys xs)" by (rule sym, induct ys arbitrary: xs) (simp_all add: diff_add diff_right_commute diff_diff_add) lemma [code]: "mset xs \# mset ys = mset (snd (fold (\x (ys, zs). if x \ set ys then (remove1 x ys, x # zs) else (ys, zs)) xs (ys, [])))" proof - have "\zs. mset (snd (fold (\x (ys, zs). if x \ set ys then (remove1 x ys, x # zs) else (ys, zs)) xs (ys, zs))) = (mset xs \# mset ys) + mset zs" by (induct xs arbitrary: ys) (auto simp add: inter_add_right1 inter_add_right2 ac_simps) then show ?thesis by simp qed lemma [code]: "mset xs \# mset ys = mset (case_prod append (fold (\x (ys, zs). (remove1 x ys, x # zs)) xs (ys, [])))" proof - have "\zs. mset (case_prod append (fold (\x (ys, zs). (remove1 x ys, x # zs)) xs (ys, zs))) = (mset xs \# mset ys) + mset zs" by (induct xs arbitrary: ys) (simp_all add: multiset_eq_iff) then show ?thesis by simp qed declare in_multiset_in_set [code_unfold] lemma [code]: "count (mset xs) x = fold (\y. if x = y then Suc else id) xs 0" proof - have "\n. fold (\y. if x = y then Suc else id) xs n = count (mset xs) x + n" by (induct xs) simp_all then show ?thesis by simp qed declare set_mset_mset [code] declare sorted_list_of_multiset_mset [code] lemma [code]: \ \not very efficient, but representation-ignorant!\ "mset_set A = mset (sorted_list_of_set A)" apply (cases "finite A") apply simp_all apply (induct A rule: finite_induct) apply simp_all done declare size_mset [code] fun subset_eq_mset_impl :: "'a list \ 'a list \ bool option" where "subset_eq_mset_impl [] ys = Some (ys \ [])" | "subset_eq_mset_impl (Cons x xs) ys = (case List.extract ((=) x) ys of None \ None | Some (ys1,_,ys2) \ subset_eq_mset_impl xs (ys1 @ ys2))" lemma subset_eq_mset_impl: "(subset_eq_mset_impl xs ys = None \ \ mset xs \# mset ys) \ (subset_eq_mset_impl xs ys = Some True \ mset xs \# mset ys) \ (subset_eq_mset_impl xs ys = Some False \ mset xs = mset ys)" proof (induct xs arbitrary: ys) case (Nil ys) show ?case by (auto simp: subset_mset.zero_less_iff_neq_zero) next case (Cons x xs ys) show ?case proof (cases "List.extract ((=) x) ys") case None hence x: "x \ set ys" by (simp add: extract_None_iff) { assume "mset (x # xs) \# mset ys" from set_mset_mono[OF this] x have False by simp } note nle = this moreover { assume "mset (x # xs) \# mset ys" hence "mset (x # xs) \# mset ys" by auto from nle[OF this] have False . } ultimately show ?thesis using None by auto next case (Some res) obtain ys1 y ys2 where res: "res = (ys1,y,ys2)" by (cases res, auto) note Some = Some[unfolded res] from extract_SomeE[OF Some] have "ys = ys1 @ x # ys2" by simp hence id: "mset ys = add_mset x (mset (ys1 @ ys2))" by auto show ?thesis unfolding subset_eq_mset_impl.simps unfolding Some option.simps split unfolding id using Cons[of "ys1 @ ys2"] unfolding subset_mset_def subseteq_mset_def by auto qed qed lemma [code]: "mset xs \# mset ys \ subset_eq_mset_impl xs ys \ None" using subset_eq_mset_impl[of xs ys] by (cases "subset_eq_mset_impl xs ys", auto) lemma [code]: "mset xs \# mset ys \ subset_eq_mset_impl xs ys = Some True" using subset_eq_mset_impl[of xs ys] by (cases "subset_eq_mset_impl xs ys", auto) instantiation multiset :: (equal) equal begin definition [code del]: "HOL.equal A (B :: 'a multiset) \ A = B" lemma [code]: "HOL.equal (mset xs) (mset ys) \ subset_eq_mset_impl xs ys = Some False" unfolding equal_multiset_def using subset_eq_mset_impl[of xs ys] by (cases "subset_eq_mset_impl xs ys", auto) instance by standard (simp add: equal_multiset_def) end declare sum_mset_sum_list [code] lemma [code]: "prod_mset (mset xs) = fold times xs 1" proof - have "\x. fold times xs x = prod_mset (mset xs) * x" by (induct xs) (simp_all add: ac_simps) then show ?thesis by simp qed text \ Exercise for the casual reader: add implementations for \<^term>\(\)\ and \<^term>\(<)\ (multiset order). \ text \Quickcheck generators\ context includes term_syntax begin definition msetify :: "'a::typerep list \ (unit \ Code_Evaluation.term) \ 'a multiset \ (unit \ Code_Evaluation.term)" where [code_unfold]: "msetify xs = Code_Evaluation.valtermify mset {\} xs" end instantiation multiset :: (random) random begin context includes state_combinator_syntax begin definition "Quickcheck_Random.random i = Quickcheck_Random.random i \\ (\xs. Pair (msetify xs))" instance .. end end instantiation multiset :: (full_exhaustive) full_exhaustive begin definition full_exhaustive_multiset :: "('a multiset \ (unit \ term) \ (bool \ term list) option) \ natural \ (bool \ term list) option" where "full_exhaustive_multiset f i = Quickcheck_Exhaustive.full_exhaustive (\xs. f (msetify xs)) i" instance .. end hide_const (open) msetify subsection \BNF setup\ definition rel_mset where "rel_mset R X Y \ (\xs ys. mset xs = X \ mset ys = Y \ list_all2 R xs ys)" lemma mset_zip_take_Cons_drop_twice: assumes "length xs = length ys" "j \ length xs" shows "mset (zip (take j xs @ x # drop j xs) (take j ys @ y # drop j ys)) = add_mset (x,y) (mset (zip xs ys))" using assms proof (induct xs ys arbitrary: x y j rule: list_induct2) case Nil thus ?case by simp next case (Cons x xs y ys) thus ?case proof (cases "j = 0") case True thus ?thesis by simp next case False then obtain k where k: "j = Suc k" by (cases j) simp hence "k \ length xs" using Cons.prems by auto hence "mset (zip (take k xs @ x # drop k xs) (take k ys @ y # drop k ys)) = add_mset (x,y) (mset (zip xs ys))" by (rule Cons.hyps(2)) thus ?thesis unfolding k by auto qed qed lemma ex_mset_zip_left: assumes "length xs = length ys" "mset xs' = mset xs" shows "\ys'. length ys' = length xs' \ mset (zip xs' ys') = mset (zip xs ys)" using assms proof (induct xs ys arbitrary: xs' rule: list_induct2) case Nil thus ?case by auto next case (Cons x xs y ys xs') obtain j where j_len: "j < length xs'" and nth_j: "xs' ! j = x" by (metis Cons.prems in_set_conv_nth list.set_intros(1) mset_eq_setD) define xsa where "xsa = take j xs' @ drop (Suc j) xs'" have "mset xs' = {#x#} + mset xsa" unfolding xsa_def using j_len nth_j by (metis Cons_nth_drop_Suc union_mset_add_mset_right add_mset_remove_trivial add_diff_cancel_left' append_take_drop_id mset.simps(2) mset_append) hence ms_x: "mset xsa = mset xs" by (simp add: Cons.prems) then obtain ysa where len_a: "length ysa = length xsa" and ms_a: "mset (zip xsa ysa) = mset (zip xs ys)" using Cons.hyps(2) by blast define ys' where "ys' = take j ysa @ y # drop j ysa" have xs': "xs' = take j xsa @ x # drop j xsa" using ms_x j_len nth_j Cons.prems xsa_def by (metis append_eq_append_conv append_take_drop_id diff_Suc_Suc Cons_nth_drop_Suc length_Cons length_drop size_mset) have j_len': "j \ length xsa" using j_len xs' xsa_def by (metis add_Suc_right append_take_drop_id length_Cons length_append less_eq_Suc_le not_less) have "length ys' = length xs'" unfolding ys'_def using Cons.prems len_a ms_x by (metis add_Suc_right append_take_drop_id length_Cons length_append mset_eq_length) moreover have "mset (zip xs' ys') = mset (zip (x # xs) (y # ys))" unfolding xs' ys'_def by (rule trans[OF mset_zip_take_Cons_drop_twice]) (auto simp: len_a ms_a j_len') ultimately show ?case by blast qed lemma list_all2_reorder_left_invariance: assumes rel: "list_all2 R xs ys" and ms_x: "mset xs' = mset xs" shows "\ys'. list_all2 R xs' ys' \ mset ys' = mset ys" proof - have len: "length xs = length ys" using rel list_all2_conv_all_nth by auto obtain ys' where len': "length xs' = length ys'" and ms_xy: "mset (zip xs' ys') = mset (zip xs ys)" using len ms_x by (metis ex_mset_zip_left) have "list_all2 R xs' ys'" using assms(1) len' ms_xy unfolding list_all2_iff by (blast dest: mset_eq_setD) moreover have "mset ys' = mset ys" using len len' ms_xy map_snd_zip mset_map by metis ultimately show ?thesis by blast qed lemma ex_mset: "\xs. mset xs = X" by (induct X) (simp, metis mset.simps(2)) inductive pred_mset :: "('a \ bool) \ 'a multiset \ bool" where "pred_mset P {#}" | "\P a; pred_mset P M\ \ pred_mset P (add_mset a M)" lemma pred_mset_iff: \ \TODO: alias for \<^const>\Multiset.Ball\\ \pred_mset P M \ Multiset.Ball M P\ (is \?P \ ?Q\) proof assume ?P then show ?Q by induction simp_all next assume ?Q then show ?P by (induction M) (auto intro: pred_mset.intros) qed bnf "'a multiset" map: image_mset sets: set_mset bd: natLeq wits: "{#}" rel: rel_mset pred: pred_mset proof - show "image_mset id = id" by (rule image_mset.id) show "image_mset (g \ f) = image_mset g \ image_mset f" for f g unfolding comp_def by (rule ext) (simp add: comp_def image_mset.compositionality) show "(\z. z \ set_mset X \ f z = g z) \ image_mset f X = image_mset g X" for f g X by (induct X) simp_all show "set_mset \ image_mset f = (`) f \ set_mset" for f by auto show "card_order natLeq" by (rule natLeq_card_order) show "BNF_Cardinal_Arithmetic.cinfinite natLeq" by (rule natLeq_cinfinite) show "ordLeq3 (card_of (set_mset X)) natLeq" for X by transfer (auto intro!: ordLess_imp_ordLeq simp: finite_iff_ordLess_natLeq[symmetric]) show "rel_mset R OO rel_mset S \ rel_mset (R OO S)" for R S unfolding rel_mset_def[abs_def] OO_def apply clarify subgoal for X Z Y xs ys' ys zs apply (drule list_all2_reorder_left_invariance [where xs = ys' and ys = zs and xs' = ys]) apply (auto intro: list_all2_trans) done done show "rel_mset R = (\x y. \z. set_mset z \ {(x, y). R x y} \ image_mset fst z = x \ image_mset snd z = y)" for R unfolding rel_mset_def[abs_def] apply (rule ext)+ apply safe apply (rule_tac x = "mset (zip xs ys)" in exI; auto simp: in_set_zip list_all2_iff simp flip: mset_map) apply (rename_tac XY) apply (cut_tac X = XY in ex_mset) apply (erule exE) apply (rename_tac xys) apply (rule_tac x = "map fst xys" in exI) apply (auto simp: mset_map) apply (rule_tac x = "map snd xys" in exI) apply (auto simp: mset_map list_all2I subset_eq zip_map_fst_snd) done show "z \ set_mset {#} \ False" for z by auto show "pred_mset P = (\x. Ball (set_mset x) P)" for P by (simp add: fun_eq_iff pred_mset_iff) qed inductive rel_mset' :: \('a \ 'b \ bool) \ 'a multiset \ 'b multiset \ bool\ where Zero[intro]: "rel_mset' R {#} {#}" | Plus[intro]: "\R a b; rel_mset' R M N\ \ rel_mset' R (add_mset a M) (add_mset b N)" lemma rel_mset_Zero: "rel_mset R {#} {#}" unfolding rel_mset_def Grp_def by auto declare multiset.count[simp] declare count_Abs_multiset[simp] declare multiset.count_inverse[simp] lemma rel_mset_Plus: assumes ab: "R a b" and MN: "rel_mset R M N" shows "rel_mset R (add_mset a M) (add_mset b N)" proof - have "\ya. add_mset a (image_mset fst y) = image_mset fst ya \ add_mset b (image_mset snd y) = image_mset snd ya \ set_mset ya \ {(x, y). R x y}" if "R a b" and "set_mset y \ {(x, y). R x y}" for y using that by (intro exI[of _ "add_mset (a,b) y"]) auto thus ?thesis using assms unfolding multiset.rel_compp_Grp Grp_def by blast qed lemma rel_mset'_imp_rel_mset: "rel_mset' R M N \ rel_mset R M N" by (induct rule: rel_mset'.induct) (auto simp: rel_mset_Zero rel_mset_Plus) lemma rel_mset_size: "rel_mset R M N \ size M = size N" unfolding multiset.rel_compp_Grp Grp_def by auto lemma multiset_induct2[case_names empty addL addR]: assumes empty: "P {#} {#}" and addL: "\a M N. P M N \ P (add_mset a M) N" and addR: "\a M N. P M N \ P M (add_mset a N)" shows "P M N" apply(induct N rule: multiset_induct) apply(induct M rule: multiset_induct, rule empty, erule addL) apply(induct M rule: multiset_induct, erule addR, erule addR) done lemma multiset_induct2_size[consumes 1, case_names empty add]: assumes c: "size M = size N" and empty: "P {#} {#}" and add: "\a b M N a b. P M N \ P (add_mset a M) (add_mset b N)" shows "P M N" using c proof (induct M arbitrary: N rule: measure_induct_rule[of size]) case (less M) show ?case proof(cases "M = {#}") case True hence "N = {#}" using less.prems by auto thus ?thesis using True empty by auto next case False then obtain M1 a where M: "M = add_mset a M1" by (metis multi_nonempty_split) have "N \ {#}" using False less.prems by auto then obtain N1 b where N: "N = add_mset b N1" by (metis multi_nonempty_split) have "size M1 = size N1" using less.prems unfolding M N by auto thus ?thesis using M N less.hyps add by auto qed qed lemma msed_map_invL: assumes "image_mset f (add_mset a M) = N" shows "\N1. N = add_mset (f a) N1 \ image_mset f M = N1" proof - have "f a \# N" using assms multiset.set_map[of f "add_mset a M"] by auto then obtain N1 where N: "N = add_mset (f a) N1" using multi_member_split by metis have "image_mset f M = N1" using assms unfolding N by simp thus ?thesis using N by blast qed lemma msed_map_invR: assumes "image_mset f M = add_mset b N" shows "\M1 a. M = add_mset a M1 \ f a = b \ image_mset f M1 = N" proof - obtain a where a: "a \# M" and fa: "f a = b" using multiset.set_map[of f M] unfolding assms by (metis image_iff union_single_eq_member) then obtain M1 where M: "M = add_mset a M1" using multi_member_split by metis have "image_mset f M1 = N" using assms unfolding M fa[symmetric] by simp thus ?thesis using M fa by blast qed lemma msed_rel_invL: assumes "rel_mset R (add_mset a M) N" shows "\N1 b. N = add_mset b N1 \ R a b \ rel_mset R M N1" proof - obtain K where KM: "image_mset fst K = add_mset a M" and KN: "image_mset snd K = N" and sK: "set_mset K \ {(a, b). R a b}" using assms unfolding multiset.rel_compp_Grp Grp_def by auto obtain K1 ab where K: "K = add_mset ab K1" and a: "fst ab = a" and K1M: "image_mset fst K1 = M" using msed_map_invR[OF KM] by auto obtain N1 where N: "N = add_mset (snd ab) N1" and K1N1: "image_mset snd K1 = N1" using msed_map_invL[OF KN[unfolded K]] by auto have Rab: "R a (snd ab)" using sK a unfolding K by auto have "rel_mset R M N1" using sK K1M K1N1 unfolding K multiset.rel_compp_Grp Grp_def by auto thus ?thesis using N Rab by auto qed lemma msed_rel_invR: assumes "rel_mset R M (add_mset b N)" shows "\M1 a. M = add_mset a M1 \ R a b \ rel_mset R M1 N" proof - obtain K where KN: "image_mset snd K = add_mset b N" and KM: "image_mset fst K = M" and sK: "set_mset K \ {(a, b). R a b}" using assms unfolding multiset.rel_compp_Grp Grp_def by auto obtain K1 ab where K: "K = add_mset ab K1" and b: "snd ab = b" and K1N: "image_mset snd K1 = N" using msed_map_invR[OF KN] by auto obtain M1 where M: "M = add_mset (fst ab) M1" and K1M1: "image_mset fst K1 = M1" using msed_map_invL[OF KM[unfolded K]] by auto have Rab: "R (fst ab) b" using sK b unfolding K by auto have "rel_mset R M1 N" using sK K1N K1M1 unfolding K multiset.rel_compp_Grp Grp_def by auto thus ?thesis using M Rab by auto qed lemma rel_mset_imp_rel_mset': assumes "rel_mset R M N" shows "rel_mset' R M N" using assms proof(induct M arbitrary: N rule: measure_induct_rule[of size]) case (less M) have c: "size M = size N" using rel_mset_size[OF less.prems] . show ?case proof(cases "M = {#}") case True hence "N = {#}" using c by simp thus ?thesis using True rel_mset'.Zero by auto next case False then obtain M1 a where M: "M = add_mset a M1" by (metis multi_nonempty_split) obtain N1 b where N: "N = add_mset b N1" and R: "R a b" and ms: "rel_mset R M1 N1" using msed_rel_invL[OF less.prems[unfolded M]] by auto have "rel_mset' R M1 N1" using less.hyps[of M1 N1] ms unfolding M by simp thus ?thesis using rel_mset'.Plus[of R a b, OF R] unfolding M N by simp qed qed lemma rel_mset_rel_mset': "rel_mset R M N = rel_mset' R M N" using rel_mset_imp_rel_mset' rel_mset'_imp_rel_mset by auto text \The main end product for \<^const>\rel_mset\: inductive characterization:\ lemmas rel_mset_induct[case_names empty add, induct pred: rel_mset] = rel_mset'.induct[unfolded rel_mset_rel_mset'[symmetric]] subsection \Size setup\ lemma size_multiset_o_map: "size_multiset g \ image_mset f = size_multiset (g \ f)" apply (rule ext) subgoal for x by (induct x) auto done setup \ BNF_LFP_Size.register_size_global \<^type_name>\multiset\ \<^const_name>\size_multiset\ @{thm size_multiset_overloaded_def} @{thms size_multiset_empty size_multiset_single size_multiset_union size_empty size_single size_union} @{thms size_multiset_o_map} \ subsection \Lemmas about Size\ lemma size_mset_SucE: "size A = Suc n \ (\a B. A = {#a#} + B \ size B = n \ P) \ P" by (cases A) (auto simp add: ac_simps) lemma size_Suc_Diff1: "x \# M \ Suc (size (M - {#x#})) = size M" using arg_cong[OF insert_DiffM, of _ _ size] by simp lemma size_Diff_singleton: "x \# M \ size (M - {#x#}) = size M - 1" by (simp flip: size_Suc_Diff1) lemma size_Diff_singleton_if: "size (A - {#x#}) = (if x \# A then size A - 1 else size A)" by (simp add: diff_single_trivial size_Diff_singleton) lemma size_Un_Int: "size A + size B = size (A \# B) + size (A \# B)" by (metis inter_subset_eq_union size_union subset_mset.diff_add union_diff_inter_eq_sup) lemma size_Un_disjoint: "A \# B = {#} \ size (A \# B) = size A + size B" using size_Un_Int[of A B] by simp lemma size_Diff_subset_Int: "size (M - M') = size M - size (M \# M')" by (metis diff_intersect_left_idem size_Diff_submset subset_mset.inf_le1) lemma diff_size_le_size_Diff: "size (M :: _ multiset) - size M' \ size (M - M')" by (simp add: diff_le_mono2 size_Diff_subset_Int size_mset_mono) lemma size_Diff1_less: "x\# M \ size (M - {#x#}) < size M" by (rule Suc_less_SucD) (simp add: size_Suc_Diff1) lemma size_Diff2_less: "x\# M \ y\# M \ size (M - {#x#} - {#y#}) < size M" by (metis less_imp_diff_less size_Diff1_less size_Diff_subset_Int) lemma size_Diff1_le: "size (M - {#x#}) \ size M" by (cases "x \# M") (simp_all add: size_Diff1_less less_imp_le diff_single_trivial) lemma size_psubset: "M \# M' \ size M < size M' \ M \# M'" using less_irrefl subset_mset_def by blast hide_const (open) wcount end diff --git a/src/HOL/Library/Sublist.thy b/src/HOL/Library/Sublist.thy --- a/src/HOL/Library/Sublist.thy +++ b/src/HOL/Library/Sublist.thy @@ -1,1497 +1,1518 @@ (* Title: HOL/Library/Sublist.thy Author: Tobias Nipkow and Markus Wenzel, TU München Author: Christian Sternagel, JAIST Author: Manuel Eberl, TU München *) section \List prefixes, suffixes, and homeomorphic embedding\ theory Sublist imports Main begin subsection \Prefix order on lists\ definition prefix :: "'a list \ 'a list \ bool" where "prefix xs ys \ (\zs. ys = xs @ zs)" definition strict_prefix :: "'a list \ 'a list \ bool" where "strict_prefix xs ys \ prefix xs ys \ xs \ ys" +global_interpretation prefix_order: ordering prefix strict_prefix + by standard (auto simp add: prefix_def strict_prefix_def) + interpretation prefix_order: order prefix strict_prefix by standard (auto simp: prefix_def strict_prefix_def) +global_interpretation prefix_bot: ordering_top \\xs ys. prefix ys xs\ \\xs ys. strict_prefix ys xs\ \[]\ + by standard (simp add: prefix_def) + interpretation prefix_bot: order_bot Nil prefix strict_prefix by standard (simp add: prefix_def) lemma prefixI [intro?]: "ys = xs @ zs \ prefix xs ys" unfolding prefix_def by blast lemma prefixE [elim?]: assumes "prefix xs ys" obtains zs where "ys = xs @ zs" using assms unfolding prefix_def by blast lemma strict_prefixI' [intro?]: "ys = xs @ z # zs \ strict_prefix xs ys" unfolding strict_prefix_def prefix_def by blast lemma strict_prefixE' [elim?]: assumes "strict_prefix xs ys" obtains z zs where "ys = xs @ z # zs" proof - from \strict_prefix xs ys\ obtain us where "ys = xs @ us" and "xs \ ys" unfolding strict_prefix_def prefix_def by blast with that show ?thesis by (auto simp add: neq_Nil_conv) qed (* FIXME rm *) lemma strict_prefixI [intro?]: "prefix xs ys \ xs \ ys \ strict_prefix xs ys" by(fact prefix_order.le_neq_trans) lemma strict_prefixE [elim?]: fixes xs ys :: "'a list" assumes "strict_prefix xs ys" obtains "prefix xs ys" and "xs \ ys" using assms unfolding strict_prefix_def by blast subsection \Basic properties of prefixes\ (* FIXME rm *) theorem Nil_prefix [simp]: "prefix [] xs" by (fact prefix_bot.bot_least) (* FIXME rm *) theorem prefix_Nil [simp]: "(prefix xs []) = (xs = [])" by (fact prefix_bot.bot_unique) lemma prefix_snoc [simp]: "prefix xs (ys @ [y]) \ xs = ys @ [y] \ prefix xs ys" proof assume "prefix xs (ys @ [y])" then obtain zs where zs: "ys @ [y] = xs @ zs" .. show "xs = ys @ [y] \ prefix xs ys" by (metis append_Nil2 butlast_append butlast_snoc prefixI zs) next assume "xs = ys @ [y] \ prefix xs ys" then show "prefix xs (ys @ [y])" - by (metis prefix_order.eq_iff prefix_order.order_trans prefixI) + by auto (metis append.assoc prefix_def) qed lemma Cons_prefix_Cons [simp]: "prefix (x # xs) (y # ys) = (x = y \ prefix xs ys)" by (auto simp add: prefix_def) lemma prefix_code [code]: "prefix [] xs \ True" "prefix (x # xs) [] \ False" "prefix (x # xs) (y # ys) \ x = y \ prefix xs ys" by simp_all lemma same_prefix_prefix [simp]: "prefix (xs @ ys) (xs @ zs) = prefix ys zs" by (induct xs) simp_all lemma same_prefix_nil [simp]: "prefix (xs @ ys) xs = (ys = [])" - by (metis append_Nil2 append_self_conv prefix_order.eq_iff prefixI) + by (simp add: prefix_def) lemma prefix_prefix [simp]: "prefix xs ys \ prefix xs (ys @ zs)" unfolding prefix_def by fastforce lemma append_prefixD: "prefix (xs @ ys) zs \ prefix xs zs" by (auto simp add: prefix_def) theorem prefix_Cons: "prefix xs (y # ys) = (xs = [] \ (\zs. xs = y # zs \ prefix zs ys))" by (cases xs) (auto simp add: prefix_def) theorem prefix_append: "prefix xs (ys @ zs) = (prefix xs ys \ (\us. xs = ys @ us \ prefix us zs))" apply (induct zs rule: rev_induct) apply force apply (simp flip: append_assoc) apply (metis append_eq_appendI) done lemma append_one_prefix: "prefix xs ys \ length xs < length ys \ prefix (xs @ [ys ! length xs]) ys" proof (unfold prefix_def) assume a1: "\zs. ys = xs @ zs" then obtain sk :: "'a list" where sk: "ys = xs @ sk" by fastforce assume a2: "length xs < length ys" have f1: "\v. ([]::'a list) @ v = v" using append_Nil2 by simp have "[] \ sk" using a1 a2 sk less_not_refl by force hence "\v. xs @ hd sk # v = ys" using sk by (metis hd_Cons_tl) thus "\zs. ys = (xs @ [ys ! length xs]) @ zs" using f1 by fastforce qed theorem prefix_length_le: "prefix xs ys \ length xs \ length ys" by (auto simp add: prefix_def) lemma prefix_same_cases: "prefix (xs\<^sub>1::'a list) ys \ prefix xs\<^sub>2 ys \ prefix xs\<^sub>1 xs\<^sub>2 \ prefix xs\<^sub>2 xs\<^sub>1" unfolding prefix_def by (force simp: append_eq_append_conv2) lemma prefix_length_prefix: "prefix ps xs \ prefix qs xs \ length ps \ length qs \ prefix ps qs" by (auto simp: prefix_def) (metis append_Nil2 append_eq_append_conv_if) lemma set_mono_prefix: "prefix xs ys \ set xs \ set ys" by (auto simp add: prefix_def) lemma take_is_prefix: "prefix (take n xs) xs" unfolding prefix_def by (metis append_take_drop_id) lemma takeWhile_is_prefix: "prefix (takeWhile P xs) xs" unfolding prefix_def by (metis takeWhile_dropWhile_id) lemma prefixeq_butlast: "prefix (butlast xs) xs" by (simp add: butlast_conv_take take_is_prefix) lemma prefix_map_rightE: assumes "prefix xs (map f ys)" shows "\xs'. prefix xs' ys \ xs = map f xs'" proof - define n where "n = length xs" have "xs = take n (map f ys)" using assms by (auto simp: prefix_def n_def) thus ?thesis by (intro exI[of _ "take n ys"]) (auto simp: take_map take_is_prefix) qed lemma map_mono_prefix: "prefix xs ys \ prefix (map f xs) (map f ys)" by (auto simp: prefix_def) lemma filter_mono_prefix: "prefix xs ys \ prefix (filter P xs) (filter P ys)" by (auto simp: prefix_def) lemma sorted_antimono_prefix: "prefix xs ys \ sorted ys \ sorted xs" by (metis sorted_append prefix_def) lemma prefix_length_less: "strict_prefix xs ys \ length xs < length ys" by (auto simp: strict_prefix_def prefix_def) lemma prefix_snocD: "prefix (xs@[x]) ys \ strict_prefix xs ys" by (simp add: strict_prefixI' prefix_order.dual_order.strict_trans1) lemma strict_prefix_simps [simp, code]: "strict_prefix xs [] \ False" "strict_prefix [] (x # xs) \ True" "strict_prefix (x # xs) (y # ys) \ x = y \ strict_prefix xs ys" by (simp_all add: strict_prefix_def cong: conj_cong) lemma take_strict_prefix: "strict_prefix xs ys \ strict_prefix (take n xs) ys" proof (induct n arbitrary: xs ys) case 0 then show ?case by (cases ys) simp_all next case (Suc n) then show ?case by (metis prefix_order.less_trans strict_prefixI take_is_prefix) qed lemma prefix_takeWhile: assumes "prefix xs ys" shows "prefix (takeWhile P xs) (takeWhile P ys)" proof - from assms obtain zs where ys: "ys = xs @ zs" by (auto simp: prefix_def) have "prefix (takeWhile P xs) (takeWhile P (xs @ zs))" by (induction xs) auto thus ?thesis by (simp add: ys) qed lemma prefix_dropWhile: assumes "prefix xs ys" shows "prefix (dropWhile P xs) (dropWhile P ys)" proof - from assms obtain zs where ys: "ys = xs @ zs" by (auto simp: prefix_def) have "prefix (dropWhile P xs) (dropWhile P (xs @ zs))" by (induction xs) auto thus ?thesis by (simp add: ys) qed lemma prefix_remdups_adj: assumes "prefix xs ys" shows "prefix (remdups_adj xs) (remdups_adj ys)" using assms proof (induction "length xs" arbitrary: xs ys rule: less_induct) case (less xs) show ?case proof (cases xs) case [simp]: (Cons x xs') then obtain y ys' where [simp]: "ys = y # ys'" using \prefix xs ys\ by (cases ys) auto from less show ?thesis by (auto simp: remdups_adj_Cons' less_Suc_eq_le length_dropWhile_le intro!: less prefix_dropWhile) qed auto qed lemma not_prefix_cases: assumes pfx: "\ prefix ps ls" obtains (c1) "ps \ []" and "ls = []" | (c2) a as x xs where "ps = a#as" and "ls = x#xs" and "x = a" and "\ prefix as xs" | (c3) a as x xs where "ps = a#as" and "ls = x#xs" and "x \ a" proof (cases ps) case Nil then show ?thesis using pfx by simp next case (Cons a as) note c = \ps = a#as\ show ?thesis proof (cases ls) case Nil then show ?thesis by (metis append_Nil2 pfx c1 same_prefix_nil) next case (Cons x xs) show ?thesis proof (cases "x = a") case True have "\ prefix as xs" using pfx c Cons True by simp with c Cons True show ?thesis by (rule c2) next case False with c Cons show ?thesis by (rule c3) qed qed qed lemma not_prefix_induct [consumes 1, case_names Nil Neq Eq]: assumes np: "\ prefix ps ls" and base: "\x xs. P (x#xs) []" and r1: "\x xs y ys. x \ y \ P (x#xs) (y#ys)" and r2: "\x xs y ys. \ x = y; \ prefix xs ys; P xs ys \ \ P (x#xs) (y#ys)" shows "P ps ls" using np proof (induct ls arbitrary: ps) case Nil then show ?case by (auto simp: neq_Nil_conv elim!: not_prefix_cases intro!: base) next case (Cons y ys) then have npfx: "\ prefix ps (y # ys)" by simp then obtain x xs where pv: "ps = x # xs" by (rule not_prefix_cases) auto show ?case by (metis Cons.hyps Cons_prefix_Cons npfx pv r1 r2) qed subsection \Prefixes\ primrec prefixes where "prefixes [] = [[]]" | "prefixes (x#xs) = [] # map ((#) x) (prefixes xs)" lemma in_set_prefixes[simp]: "xs \ set (prefixes ys) \ prefix xs ys" proof (induct xs arbitrary: ys) case Nil then show ?case by (cases ys) auto next case (Cons a xs) then show ?case by (cases ys) auto qed lemma length_prefixes[simp]: "length (prefixes xs) = length xs+1" by (induction xs) auto lemma distinct_prefixes [intro]: "distinct (prefixes xs)" by (induction xs) (auto simp: distinct_map) lemma prefixes_snoc [simp]: "prefixes (xs@[x]) = prefixes xs @ [xs@[x]]" by (induction xs) auto lemma prefixes_not_Nil [simp]: "prefixes xs \ []" by (cases xs) auto lemma hd_prefixes [simp]: "hd (prefixes xs) = []" by (cases xs) simp_all lemma last_prefixes [simp]: "last (prefixes xs) = xs" by (induction xs) (simp_all add: last_map) lemma prefixes_append: "prefixes (xs @ ys) = prefixes xs @ map (\ys'. xs @ ys') (tl (prefixes ys))" proof (induction xs) case Nil thus ?case by (cases ys) auto qed simp_all lemma prefixes_eq_snoc: "prefixes ys = xs @ [x] \ (ys = [] \ xs = [] \ (\z zs. ys = zs@[z] \ xs = prefixes zs)) \ x = ys" by (cases ys rule: rev_cases) auto lemma prefixes_tailrec [code]: "prefixes xs = rev (snd (foldl (\(acc1, acc2) x. (x#acc1, rev (x#acc1)#acc2)) ([],[[]]) xs))" proof - have "foldl (\(acc1, acc2) x. (x#acc1, rev (x#acc1)#acc2)) (ys, rev ys # zs) xs = (rev xs @ ys, rev (map (\as. rev ys @ as) (prefixes xs)) @ zs)" for ys zs proof (induction xs arbitrary: ys zs) case (Cons x xs ys zs) from Cons.IH[of "x # ys" "rev ys # zs"] show ?case by (simp add: o_def) qed simp_all from this [of "[]" "[]"] show ?thesis by simp qed lemma set_prefixes_eq: "set (prefixes xs) = {ys. prefix ys xs}" by auto lemma card_set_prefixes [simp]: "card (set (prefixes xs)) = Suc (length xs)" by (subst distinct_card) auto lemma set_prefixes_append: "set (prefixes (xs @ ys)) = set (prefixes xs) \ {xs @ ys' |ys'. ys' \ set (prefixes ys)}" by (subst prefixes_append, cases ys) auto subsection \Longest Common Prefix\ definition Longest_common_prefix :: "'a list set \ 'a list" where "Longest_common_prefix L = (ARG_MAX length ps. \xs \ L. prefix ps xs)" lemma Longest_common_prefix_ex: "L \ {} \ \ps. (\xs \ L. prefix ps xs) \ (\qs. (\xs \ L. prefix qs xs) \ size qs \ size ps)" (is "_ \ \ps. ?P L ps") proof(induction "LEAST n. \xs \L. n = length xs" arbitrary: L) case 0 have "[] \ L" using "0.hyps" LeastI[of "\n. \xs\L. n = length xs"] \L \ {}\ by auto hence "?P L []" by(auto) thus ?case .. next case (Suc n) let ?EX = "\n. \xs\L. n = length xs" obtain x xs where xxs: "x#xs \ L" "size xs = n" using Suc.prems Suc.hyps(2) by(metis LeastI_ex[of ?EX] Suc_length_conv ex_in_conv) hence "[] \ L" using Suc.hyps(2) by auto show ?case proof (cases "\xs \ L. \ys. xs = x#ys") case True let ?L = "{ys. x#ys \ L}" have 1: "(LEAST n. \xs \ ?L. n = length xs) = n" using xxs Suc.prems Suc.hyps(2) Least_le[of "?EX"] by - (rule Least_equality, fastforce+) have 2: "?L \ {}" using \x # xs \ L\ by auto from Suc.hyps(1)[OF 1[symmetric] 2] obtain ps where IH: "?P ?L ps" .. { fix qs assume "\qs. (\xa. x # xa \ L \ prefix qs xa) \ length qs \ length ps" and "\xs\L. prefix qs xs" hence "length (tl qs) \ length ps" by (metis Cons_prefix_Cons hd_Cons_tl list.sel(2) Nil_prefix) hence "length qs \ Suc (length ps)" by auto } hence "?P L (x#ps)" using True IH by auto thus ?thesis .. next case False then obtain y ys where yys: "x\y" "y#ys \ L" using \[] \ L\ by (auto) (metis list.exhaust) have "\qs. (\xs\L. prefix qs xs) \ qs = []" using yys \x#xs \ L\ by auto (metis Cons_prefix_Cons prefix_Cons) hence "?P L []" by auto thus ?thesis .. qed qed -lemma Longest_common_prefix_unique: "L \ {} \ - \! ps. (\xs \ L. prefix ps xs) \ (\qs. (\xs \ L. prefix qs xs) \ size qs \ size ps)" -by(rule ex_ex1I[OF Longest_common_prefix_ex]; - meson equals0I prefix_length_prefix prefix_order.antisym) +lemma Longest_common_prefix_unique: + \\! ps. (\xs \ L. prefix ps xs) \ (\qs. (\xs \ L. prefix qs xs) \ length qs \ length ps)\ + if \L \ {}\ + using that apply (rule ex_ex1I[OF Longest_common_prefix_ex]) + using that apply (auto simp add: prefix_def) + apply (metis append_eq_append_conv_if order.antisym) + done lemma Longest_common_prefix_eq: "\ L \ {}; \xs \ L. prefix ps xs; \qs. (\xs \ L. prefix qs xs) \ size qs \ size ps \ \ Longest_common_prefix L = ps" unfolding Longest_common_prefix_def arg_max_def is_arg_max_linorder by(rule some1_equality[OF Longest_common_prefix_unique]) auto lemma Longest_common_prefix_prefix: "xs \ L \ prefix (Longest_common_prefix L) xs" unfolding Longest_common_prefix_def arg_max_def is_arg_max_linorder by(rule someI2_ex[OF Longest_common_prefix_ex]) auto lemma Longest_common_prefix_longest: "L \ {} \ \xs\L. prefix ps xs \ length ps \ length(Longest_common_prefix L)" unfolding Longest_common_prefix_def arg_max_def is_arg_max_linorder by(rule someI2_ex[OF Longest_common_prefix_ex]) auto lemma Longest_common_prefix_max_prefix: "L \ {} \ \xs\L. prefix ps xs \ prefix ps (Longest_common_prefix L)" by(metis Longest_common_prefix_prefix Longest_common_prefix_longest prefix_length_prefix ex_in_conv) lemma Longest_common_prefix_Nil: "[] \ L \ Longest_common_prefix L = []" using Longest_common_prefix_prefix prefix_Nil by blast lemma Longest_common_prefix_image_Cons: "L \ {} \ Longest_common_prefix ((#) x ` L) = x # Longest_common_prefix L" apply(rule Longest_common_prefix_eq) apply(simp) apply (simp add: Longest_common_prefix_prefix) apply simp by(metis Longest_common_prefix_longest[of L] Cons_prefix_Cons Nitpick.size_list_simp(2) Suc_le_mono hd_Cons_tl order.strict_implies_order zero_less_Suc) lemma Longest_common_prefix_eq_Cons: assumes "L \ {}" "[] \ L" "\xs\L. hd xs = x" shows "Longest_common_prefix L = x # Longest_common_prefix {ys. x#ys \ L}" proof - have "L = (#) x ` {ys. x#ys \ L}" using assms(2,3) by (auto simp: image_def)(metis hd_Cons_tl) thus ?thesis by (metis Longest_common_prefix_image_Cons image_is_empty assms(1)) qed lemma Longest_common_prefix_eq_Nil: "\x#ys \ L; y#zs \ L; x \ y \ \ Longest_common_prefix L = []" by (metis Longest_common_prefix_prefix list.inject prefix_Cons) fun longest_common_prefix :: "'a list \ 'a list \ 'a list" where "longest_common_prefix (x#xs) (y#ys) = (if x=y then x # longest_common_prefix xs ys else [])" | "longest_common_prefix _ _ = []" lemma longest_common_prefix_prefix1: "prefix (longest_common_prefix xs ys) xs" by(induction xs ys rule: longest_common_prefix.induct) auto lemma longest_common_prefix_prefix2: "prefix (longest_common_prefix xs ys) ys" by(induction xs ys rule: longest_common_prefix.induct) auto lemma longest_common_prefix_max_prefix: "\ prefix ps xs; prefix ps ys \ \ prefix ps (longest_common_prefix xs ys)" by(induction xs ys arbitrary: ps rule: longest_common_prefix.induct) (auto simp: prefix_Cons) subsection \Parallel lists\ definition parallel :: "'a list \ 'a list \ bool" (infixl "\" 50) where "(xs \ ys) = (\ prefix xs ys \ \ prefix ys xs)" lemma parallelI [intro]: "\ prefix xs ys \ \ prefix ys xs \ xs \ ys" unfolding parallel_def by blast lemma parallelE [elim]: assumes "xs \ ys" obtains "\ prefix xs ys \ \ prefix ys xs" using assms unfolding parallel_def by blast theorem prefix_cases: obtains "prefix xs ys" | "strict_prefix ys xs" | "xs \ ys" unfolding parallel_def strict_prefix_def by blast lemma parallel_cancel: "a#xs \ a#ys \ xs \ ys" by (simp add: parallel_def) theorem parallel_decomp: "xs \ ys \ \as b bs c cs. b \ c \ xs = as @ b # bs \ ys = as @ c # cs" proof (induct rule: list_induct2', blast, force, force) case (4 x xs y ys) then show ?case proof (cases "x \ y", blast) assume "\ x \ y" hence "x = y" by blast then show ?thesis using "4.hyps"[OF parallel_cancel[OF "4.prems"[folded \x = y\]]] by (meson Cons_eq_appendI) qed qed lemma parallel_append: "a \ b \ a @ c \ b @ d" apply (rule parallelI) apply (erule parallelE, erule conjE, induct rule: not_prefix_induct, simp+)+ done lemma parallel_appendI: "xs \ ys \ x = xs @ xs' \ y = ys @ ys' \ x \ y" by (simp add: parallel_append) lemma parallel_commute: "a \ b \ b \ a" unfolding parallel_def by auto subsection \Suffix order on lists\ definition suffix :: "'a list \ 'a list \ bool" where "suffix xs ys = (\zs. ys = zs @ xs)" definition strict_suffix :: "'a list \ 'a list \ bool" where "strict_suffix xs ys \ suffix xs ys \ xs \ ys" +global_interpretation suffix_order: ordering suffix strict_suffix + by standard (auto simp: suffix_def strict_suffix_def) + interpretation suffix_order: order suffix strict_suffix by standard (auto simp: suffix_def strict_suffix_def) +global_interpretation suffix_bot: ordering_top \\xs ys. suffix ys xs\ \\xs ys. strict_suffix ys xs\ \[]\ + by standard (simp add: suffix_def) + interpretation suffix_bot: order_bot Nil suffix strict_suffix by standard (simp add: suffix_def) lemma suffixI [intro?]: "ys = zs @ xs \ suffix xs ys" unfolding suffix_def by blast lemma suffixE [elim?]: assumes "suffix xs ys" obtains zs where "ys = zs @ xs" using assms unfolding suffix_def by blast lemma suffix_tl [simp]: "suffix (tl xs) xs" by (induct xs) (auto simp: suffix_def) lemma strict_suffix_tl [simp]: "xs \ [] \ strict_suffix (tl xs) xs" by (induct xs) (auto simp: strict_suffix_def suffix_def) lemma Nil_suffix [simp]: "suffix [] xs" by (simp add: suffix_def) lemma suffix_Nil [simp]: "(suffix xs []) = (xs = [])" by (auto simp add: suffix_def) lemma suffix_ConsI: "suffix xs ys \ suffix xs (y # ys)" by (auto simp add: suffix_def) lemma suffix_ConsD: "suffix (x # xs) ys \ suffix xs ys" by (auto simp add: suffix_def) lemma suffix_appendI: "suffix xs ys \ suffix xs (zs @ ys)" by (auto simp add: suffix_def) lemma suffix_appendD: "suffix (zs @ xs) ys \ suffix xs ys" by (auto simp add: suffix_def) lemma strict_suffix_set_subset: "strict_suffix xs ys \ set xs \ set ys" by (auto simp: strict_suffix_def suffix_def) lemma set_mono_suffix: "suffix xs ys \ set xs \ set ys" by (auto simp: suffix_def) lemma sorted_antimono_suffix: "suffix xs ys \ sorted ys \ sorted xs" by (metis sorted_append suffix_def) lemma suffix_ConsD2: "suffix (x # xs) (y # ys) \ suffix xs ys" proof - assume "suffix (x # xs) (y # ys)" then obtain zs where "y # ys = zs @ x # xs" .. then show ?thesis by (induct zs) (auto intro!: suffix_appendI suffix_ConsI) qed lemma suffix_to_prefix [code]: "suffix xs ys \ prefix (rev xs) (rev ys)" proof assume "suffix xs ys" then obtain zs where "ys = zs @ xs" .. then have "rev ys = rev xs @ rev zs" by simp then show "prefix (rev xs) (rev ys)" .. next assume "prefix (rev xs) (rev ys)" then obtain zs where "rev ys = rev xs @ zs" .. then have "rev (rev ys) = rev zs @ rev (rev xs)" by simp then have "ys = rev zs @ xs" by simp then show "suffix xs ys" .. qed lemma strict_suffix_to_prefix [code]: "strict_suffix xs ys \ strict_prefix (rev xs) (rev ys)" by (auto simp: suffix_to_prefix strict_suffix_def strict_prefix_def) lemma distinct_suffix: "distinct ys \ suffix xs ys \ distinct xs" by (clarsimp elim!: suffixE) lemma map_mono_suffix: "suffix xs ys \ suffix (map f xs) (map f ys)" by (auto elim!: suffixE intro: suffixI) lemma filter_mono_suffix: "suffix xs ys \ suffix (filter P xs) (filter P ys)" by (auto simp: suffix_def) lemma suffix_drop: "suffix (drop n as) as" unfolding suffix_def by (metis append_take_drop_id) lemma suffix_dropWhile: "suffix (dropWhile P xs) xs" unfolding suffix_def by (metis takeWhile_dropWhile_id) lemma suffix_take: "suffix xs ys \ ys = take (length ys - length xs) ys @ xs" by (auto elim!: suffixE) lemma strict_suffix_reflclp_conv: "strict_suffix\<^sup>=\<^sup>= = suffix" by (intro ext) (auto simp: suffix_def strict_suffix_def) lemma suffix_lists: "suffix xs ys \ ys \ lists A \ xs \ lists A" unfolding suffix_def by auto lemma suffix_snoc [simp]: "suffix xs (ys @ [y]) \ xs = [] \ (\zs. xs = zs @ [y] \ suffix zs ys)" by (cases xs rule: rev_cases) (auto simp: suffix_def) lemma snoc_suffix_snoc [simp]: "suffix (xs @ [x]) (ys @ [y]) = (x = y \ suffix xs ys)" by (auto simp add: suffix_def) lemma same_suffix_suffix [simp]: "suffix (ys @ xs) (zs @ xs) = suffix ys zs" by (simp add: suffix_to_prefix) lemma same_suffix_nil [simp]: "suffix (ys @ xs) xs = (ys = [])" by (simp add: suffix_to_prefix) theorem suffix_Cons: "suffix xs (y # ys) \ xs = y # ys \ suffix xs ys" unfolding suffix_def by (auto simp: Cons_eq_append_conv) theorem suffix_append: "suffix xs (ys @ zs) \ suffix xs zs \ (\xs'. xs = xs' @ zs \ suffix xs' ys)" by (auto simp: suffix_def append_eq_append_conv2) theorem suffix_length_le: "suffix xs ys \ length xs \ length ys" by (auto simp add: suffix_def) lemma suffix_same_cases: "suffix (xs\<^sub>1::'a list) ys \ suffix xs\<^sub>2 ys \ suffix xs\<^sub>1 xs\<^sub>2 \ suffix xs\<^sub>2 xs\<^sub>1" unfolding suffix_def by (force simp: append_eq_append_conv2) lemma suffix_length_suffix: "suffix ps xs \ suffix qs xs \ length ps \ length qs \ suffix ps qs" by (auto simp: suffix_to_prefix intro: prefix_length_prefix) lemma suffix_length_less: "strict_suffix xs ys \ length xs < length ys" by (auto simp: strict_suffix_def suffix_def) lemma suffix_ConsD': "suffix (x#xs) ys \ strict_suffix xs ys" by (auto simp: strict_suffix_def suffix_def) lemma drop_strict_suffix: "strict_suffix xs ys \ strict_suffix (drop n xs) ys" proof (induct n arbitrary: xs ys) case 0 then show ?case by (cases ys) simp_all next case (Suc n) then show ?case by (cases xs) (auto intro: Suc dest: suffix_ConsD' suffix_order.less_imp_le) qed lemma suffix_map_rightE: assumes "suffix xs (map f ys)" shows "\xs'. suffix xs' ys \ xs = map f xs'" proof - from assms obtain xs' where xs': "map f ys = xs' @ xs" by (auto simp: suffix_def) define n where "n = length xs'" have "xs = drop n (map f ys)" by (simp add: xs' n_def) thus ?thesis by (intro exI[of _ "drop n ys"]) (auto simp: drop_map suffix_drop) qed lemma suffix_remdups_adj: "suffix xs ys \ suffix (remdups_adj xs) (remdups_adj ys)" using prefix_remdups_adj[of "rev xs" "rev ys"] by (simp add: suffix_to_prefix) lemma not_suffix_cases: assumes pfx: "\ suffix ps ls" obtains (c1) "ps \ []" and "ls = []" | (c2) a as x xs where "ps = as@[a]" and "ls = xs@[x]" and "x = a" and "\ suffix as xs" | (c3) a as x xs where "ps = as@[a]" and "ls = xs@[x]" and "x \ a" proof (cases ps rule: rev_cases) case Nil then show ?thesis using pfx by simp next case (snoc as a) note c = \ps = as@[a]\ show ?thesis proof (cases ls rule: rev_cases) case Nil then show ?thesis by (metis append_Nil2 pfx c1 same_suffix_nil) next case (snoc xs x) show ?thesis proof (cases "x = a") case True have "\ suffix as xs" using pfx c snoc True by simp with c snoc True show ?thesis by (rule c2) next case False with c snoc show ?thesis by (rule c3) qed qed qed lemma not_suffix_induct [consumes 1, case_names Nil Neq Eq]: assumes np: "\ suffix ps ls" and base: "\x xs. P (xs@[x]) []" and r1: "\x xs y ys. x \ y \ P (xs@[x]) (ys@[y])" and r2: "\x xs y ys. \ x = y; \ suffix xs ys; P xs ys \ \ P (xs@[x]) (ys@[y])" shows "P ps ls" using np proof (induct ls arbitrary: ps rule: rev_induct) case Nil then show ?case by (cases ps rule: rev_cases) (auto intro: base) next case (snoc y ys ps) then have npfx: "\ suffix ps (ys @ [y])" by simp then obtain x xs where pv: "ps = xs @ [x]" by (rule not_suffix_cases) auto show ?case by (metis snoc.hyps snoc_suffix_snoc npfx pv r1 r2) qed lemma parallelD1: "x \ y \ \ prefix x y" by blast lemma parallelD2: "x \ y \ \ prefix y x" by blast lemma parallel_Nil1 [simp]: "\ x \ []" unfolding parallel_def by simp lemma parallel_Nil2 [simp]: "\ [] \ x" unfolding parallel_def by simp lemma Cons_parallelI1: "a \ b \ a # as \ b # bs" by auto lemma Cons_parallelI2: "\ a = b; as \ bs \ \ a # as \ b # bs" by (metis Cons_prefix_Cons parallelE parallelI) lemma not_equal_is_parallel: assumes neq: "xs \ ys" and len: "length xs = length ys" shows "xs \ ys" using len neq proof (induct rule: list_induct2) case Nil then show ?case by simp next case (Cons a as b bs) have ih: "as \ bs \ as \ bs" by fact show ?case proof (cases "a = b") case True then have "as \ bs" using Cons by simp then show ?thesis by (rule Cons_parallelI2 [OF True ih]) next case False then show ?thesis by (rule Cons_parallelI1) qed qed subsection \Suffixes\ primrec suffixes where "suffixes [] = [[]]" | "suffixes (x#xs) = suffixes xs @ [x # xs]" lemma in_set_suffixes [simp]: "xs \ set (suffixes ys) \ suffix xs ys" by (induction ys) (auto simp: suffix_def Cons_eq_append_conv) lemma distinct_suffixes [intro]: "distinct (suffixes xs)" by (induction xs) (auto simp: suffix_def) lemma length_suffixes [simp]: "length (suffixes xs) = Suc (length xs)" by (induction xs) auto lemma suffixes_snoc [simp]: "suffixes (xs @ [x]) = [] # map (\ys. ys @ [x]) (suffixes xs)" by (induction xs) auto lemma suffixes_not_Nil [simp]: "suffixes xs \ []" by (cases xs) auto lemma hd_suffixes [simp]: "hd (suffixes xs) = []" by (induction xs) simp_all lemma last_suffixes [simp]: "last (suffixes xs) = xs" by (cases xs) simp_all lemma suffixes_append: "suffixes (xs @ ys) = suffixes ys @ map (\xs'. xs' @ ys) (tl (suffixes xs))" proof (induction ys rule: rev_induct) case Nil thus ?case by (cases xs rule: rev_cases) auto next case (snoc y ys) show ?case by (simp only: append.assoc [symmetric] suffixes_snoc snoc.IH) simp qed lemma suffixes_eq_snoc: "suffixes ys = xs @ [x] \ (ys = [] \ xs = [] \ (\z zs. ys = z#zs \ xs = suffixes zs)) \ x = ys" by (cases ys) auto lemma suffixes_tailrec [code]: "suffixes xs = rev (snd (foldl (\(acc1, acc2) x. (x#acc1, (x#acc1)#acc2)) ([],[[]]) (rev xs)))" proof - have "foldl (\(acc1, acc2) x. (x#acc1, (x#acc1)#acc2)) (ys, ys # zs) (rev xs) = (xs @ ys, rev (map (\as. as @ ys) (suffixes xs)) @ zs)" for ys zs proof (induction xs arbitrary: ys zs) case (Cons x xs ys zs) from Cons.IH[of ys zs] show ?case by (simp add: o_def case_prod_unfold) qed simp_all from this [of "[]" "[]"] show ?thesis by simp qed lemma set_suffixes_eq: "set (suffixes xs) = {ys. suffix ys xs}" by auto lemma card_set_suffixes [simp]: "card (set (suffixes xs)) = Suc (length xs)" by (subst distinct_card) auto lemma set_suffixes_append: "set (suffixes (xs @ ys)) = set (suffixes ys) \ {xs' @ ys |xs'. xs' \ set (suffixes xs)}" by (subst suffixes_append, cases xs rule: rev_cases) auto lemma suffixes_conv_prefixes: "suffixes xs = map rev (prefixes (rev xs))" by (induction xs) auto lemma prefixes_conv_suffixes: "prefixes xs = map rev (suffixes (rev xs))" by (induction xs) auto lemma prefixes_rev: "prefixes (rev xs) = map rev (suffixes xs)" by (induction xs) auto lemma suffixes_rev: "suffixes (rev xs) = map rev (prefixes xs)" by (induction xs) auto subsection \Homeomorphic embedding on lists\ inductive list_emb :: "('a \ 'a \ bool) \ 'a list \ 'a list \ bool" for P :: "('a \ 'a \ bool)" where list_emb_Nil [intro, simp]: "list_emb P [] ys" | list_emb_Cons [intro] : "list_emb P xs ys \ list_emb P xs (y#ys)" | list_emb_Cons2 [intro]: "P x y \ list_emb P xs ys \ list_emb P (x#xs) (y#ys)" lemma list_emb_mono: assumes "\x y. P x y \ Q x y" shows "list_emb P xs ys \ list_emb Q xs ys" proof assume "list_emb P xs ys" then show "list_emb Q xs ys" by (induct) (auto simp: assms) qed lemma list_emb_Nil2 [simp]: assumes "list_emb P xs []" shows "xs = []" using assms by (cases rule: list_emb.cases) auto lemma list_emb_refl: assumes "\x. x \ set xs \ P x x" shows "list_emb P xs xs" using assms by (induct xs) auto lemma list_emb_Cons_Nil [simp]: "list_emb P (x#xs) [] = False" proof - { assume "list_emb P (x#xs) []" from list_emb_Nil2 [OF this] have False by simp } moreover { assume False then have "list_emb P (x#xs) []" by simp } ultimately show ?thesis by blast qed lemma list_emb_append2 [intro]: "list_emb P xs ys \ list_emb P xs (zs @ ys)" by (induct zs) auto lemma list_emb_prefix [intro]: assumes "list_emb P xs ys" shows "list_emb P xs (ys @ zs)" using assms by (induct arbitrary: zs) auto lemma list_emb_ConsD: assumes "list_emb P (x#xs) ys" shows "\us v vs. ys = us @ v # vs \ P x v \ list_emb P xs vs" using assms proof (induct x \ "x # xs" ys arbitrary: x xs) case list_emb_Cons then show ?case by (metis append_Cons) next case (list_emb_Cons2 x y xs ys) then show ?case by blast qed lemma list_emb_appendD: assumes "list_emb P (xs @ ys) zs" shows "\us vs. zs = us @ vs \ list_emb P xs us \ list_emb P ys vs" using assms proof (induction xs arbitrary: ys zs) case Nil then show ?case by auto next case (Cons x xs) then obtain us v vs where zs: "zs = us @ v # vs" and p: "P x v" and lh: "list_emb P (xs @ ys) vs" by (auto dest: list_emb_ConsD) obtain sk\<^sub>0 :: "'a list \ 'a list \ 'a list" and sk\<^sub>1 :: "'a list \ 'a list \ 'a list" where sk: "\x\<^sub>0 x\<^sub>1. \ list_emb P (xs @ x\<^sub>0) x\<^sub>1 \ sk\<^sub>0 x\<^sub>0 x\<^sub>1 @ sk\<^sub>1 x\<^sub>0 x\<^sub>1 = x\<^sub>1 \ list_emb P xs (sk\<^sub>0 x\<^sub>0 x\<^sub>1) \ list_emb P x\<^sub>0 (sk\<^sub>1 x\<^sub>0 x\<^sub>1)" using Cons(1) by (metis (no_types)) hence "\x\<^sub>2. list_emb P (x # xs) (x\<^sub>2 @ v # sk\<^sub>0 ys vs)" using p lh by auto thus ?case using lh zs sk by (metis (no_types) append_Cons append_assoc) qed lemma list_emb_strict_suffix: assumes "list_emb P xs ys" and "strict_suffix ys zs" shows "list_emb P xs zs" using assms(2) and list_emb_append2 [OF assms(1)] by (auto simp: strict_suffix_def suffix_def) lemma list_emb_suffix: assumes "list_emb P xs ys" and "suffix ys zs" shows "list_emb P xs zs" using assms and list_emb_strict_suffix unfolding strict_suffix_reflclp_conv[symmetric] by auto lemma list_emb_length: "list_emb P xs ys \ length xs \ length ys" by (induct rule: list_emb.induct) auto lemma list_emb_trans: assumes "\x y z. \x \ set xs; y \ set ys; z \ set zs; P x y; P y z\ \ P x z" shows "\list_emb P xs ys; list_emb P ys zs\ \ list_emb P xs zs" proof - assume "list_emb P xs ys" and "list_emb P ys zs" then show "list_emb P xs zs" using assms proof (induction arbitrary: zs) case list_emb_Nil show ?case by blast next case (list_emb_Cons xs ys y) from list_emb_ConsD [OF \list_emb P (y#ys) zs\] obtain us v vs where zs: "zs = us @ v # vs" and "P\<^sup>=\<^sup>= y v" and "list_emb P ys vs" by blast then have "list_emb P ys (v#vs)" by blast then have "list_emb P ys zs" unfolding zs by (rule list_emb_append2) from list_emb_Cons.IH [OF this] and list_emb_Cons.prems show ?case by auto next case (list_emb_Cons2 x y xs ys) from list_emb_ConsD [OF \list_emb P (y#ys) zs\] obtain us v vs where zs: "zs = us @ v # vs" and "P y v" and "list_emb P ys vs" by blast with list_emb_Cons2 have "list_emb P xs vs" by auto moreover have "P x v" proof - from zs have "v \ set zs" by auto moreover have "x \ set (x#xs)" and "y \ set (y#ys)" by simp_all ultimately show ?thesis using \P x y\ and \P y v\ and list_emb_Cons2 by blast qed ultimately have "list_emb P (x#xs) (v#vs)" by blast then show ?case unfolding zs by (rule list_emb_append2) qed qed lemma list_emb_set: assumes "list_emb P xs ys" and "x \ set xs" obtains y where "y \ set ys" and "P x y" using assms by (induct) auto lemma list_emb_Cons_iff1 [simp]: assumes "P x y" shows "list_emb P (x#xs) (y#ys) \ list_emb P xs ys" using assms by (subst list_emb.simps) (auto dest: list_emb_ConsD) lemma list_emb_Cons_iff2 [simp]: assumes "\P x y" shows "list_emb P (x#xs) (y#ys) \ list_emb P (x#xs) ys" using assms by (subst list_emb.simps) auto lemma list_emb_code [code]: "list_emb P [] ys \ True" "list_emb P (x#xs) [] \ False" "list_emb P (x#xs) (y#ys) \ (if P x y then list_emb P xs ys else list_emb P (x#xs) ys)" by simp_all subsection \Subsequences (special case of homeomorphic embedding)\ abbreviation subseq :: "'a list \ 'a list \ bool" where "subseq xs ys \ list_emb (=) xs ys" definition strict_subseq where "strict_subseq xs ys \ xs \ ys \ subseq xs ys" lemma subseq_Cons2: "subseq xs ys \ subseq (x#xs) (x#ys)" by auto lemma subseq_same_length: assumes "subseq xs ys" and "length xs = length ys" shows "xs = ys" using assms by (induct) (auto dest: list_emb_length) lemma not_subseq_length [simp]: "length ys < length xs \ \ subseq xs ys" by (metis list_emb_length linorder_not_less) lemma subseq_Cons': "subseq (x#xs) ys \ subseq xs ys" by (induct xs, simp, blast dest: list_emb_ConsD) lemma subseq_Cons2': assumes "subseq (x#xs) (x#ys)" shows "subseq xs ys" using assms by (cases) (rule subseq_Cons') lemma subseq_Cons2_neq: assumes "subseq (x#xs) (y#ys)" shows "x \ y \ subseq (x#xs) ys" using assms by (cases) auto lemma subseq_Cons2_iff [simp]: "subseq (x#xs) (y#ys) = (if x = y then subseq xs ys else subseq (x#xs) ys)" by simp lemma subseq_append': "subseq (zs @ xs) (zs @ ys) \ subseq xs ys" by (induct zs) simp_all - -interpretation subseq_order: order subseq strict_subseq + +global_interpretation subseq_order: ordering subseq strict_subseq proof - fix xs ys :: "'a list" - { - assume "subseq xs ys" and "subseq ys xs" - thus "xs = ys" - proof (induct) - case list_emb_Nil - from list_emb_Nil2 [OF this] show ?case by simp - next - case list_emb_Cons2 - thus ?case by simp - next - case list_emb_Cons - hence False using subseq_Cons' by fastforce - thus ?case .. - qed - } - thus "strict_subseq xs ys \ (subseq xs ys \ \subseq ys xs)" + show \subseq xs xs\ for xs :: \'a list\ + using refl by (rule list_emb_refl) + show \subseq xs zs\ if \subseq xs ys\ and \subseq ys zs\ + for xs ys zs :: \'a list\ + using trans [OF refl] that by (rule list_emb_trans) simp + show \xs = ys\ if \subseq xs ys\ and \subseq ys xs\ + for xs ys :: \'a list\ + using that proof induction + case list_emb_Nil + from list_emb_Nil2 [OF this] show ?case by simp + next + case list_emb_Cons2 + then show ?case by simp + next + case list_emb_Cons + hence False using subseq_Cons' by fastforce + then show ?case .. + qed + show \strict_subseq xs ys \ subseq xs ys \ xs \ ys\ + for xs ys :: \'a list\ by (auto simp: strict_subseq_def) -qed (auto simp: list_emb_refl intro: list_emb_trans) +qed + +interpretation subseq_order: order subseq strict_subseq + by (rule ordering_orderI) standard lemma in_set_subseqs [simp]: "xs \ set (subseqs ys) \ subseq xs ys" proof assume "xs \ set (subseqs ys)" thus "subseq xs ys" by (induction ys arbitrary: xs) (auto simp: Let_def) next have [simp]: "[] \ set (subseqs ys)" for ys :: "'a list" by (induction ys) (auto simp: Let_def) assume "subseq xs ys" thus "xs \ set (subseqs ys)" by (induction xs ys rule: list_emb.induct) (auto simp: Let_def) qed lemma set_subseqs_eq: "set (subseqs ys) = {xs. subseq xs ys}" by auto lemma subseq_append_le_same_iff: "subseq (xs @ ys) ys \ xs = []" by (auto dest: list_emb_length) lemma subseq_singleton_left: "subseq [x] ys \ x \ set ys" by (fastforce dest: list_emb_ConsD split_list_last) lemma list_emb_append_mono: "\ list_emb P xs xs'; list_emb P ys ys' \ \ list_emb P (xs@ys) (xs'@ys')" by (induct rule: list_emb.induct) auto lemma prefix_imp_subseq [intro]: "prefix xs ys \ subseq xs ys" by (auto simp: prefix_def) lemma suffix_imp_subseq [intro]: "suffix xs ys \ subseq xs ys" by (auto simp: suffix_def) subsection \Appending elements\ lemma subseq_append [simp]: "subseq (xs @ zs) (ys @ zs) \ subseq xs ys" (is "?l = ?r") proof { fix xs' ys' xs ys zs :: "'a list" assume "subseq xs' ys'" then have "xs' = xs @ zs \ ys' = ys @ zs \ subseq xs ys" proof (induct arbitrary: xs ys zs) case list_emb_Nil show ?case by simp next case (list_emb_Cons xs' ys' x) { assume "ys=[]" then have ?case using list_emb_Cons(1) by auto } moreover { fix us assume "ys = x#us" then have ?case using list_emb_Cons(2) by(simp add: list_emb.list_emb_Cons) } ultimately show ?case by (auto simp:Cons_eq_append_conv) next case (list_emb_Cons2 x y xs' ys') { assume "xs=[]" then have ?case using list_emb_Cons2(1) by auto } moreover { fix us vs assume "xs=x#us" "ys=x#vs" then have ?case using list_emb_Cons2 by auto} moreover { fix us assume "xs=x#us" "ys=[]" then have ?case using list_emb_Cons2(2) by bestsimp } ultimately show ?case using \(=) x y\ by (auto simp: Cons_eq_append_conv) qed } moreover assume ?l ultimately show ?r by blast next assume ?r then show ?l by (metis list_emb_append_mono subseq_order.order_refl) qed lemma subseq_append_iff: "subseq xs (ys @ zs) \ (\xs1 xs2. xs = xs1 @ xs2 \ subseq xs1 ys \ subseq xs2 zs)" (is "?lhs = ?rhs") proof assume ?lhs thus ?rhs proof (induction xs "ys @ zs" arbitrary: ys zs rule: list_emb.induct) case (list_emb_Cons xs ws y ys zs) from list_emb_Cons(2)[of "tl ys" zs] and list_emb_Cons(2)[of "[]" "tl zs"] and list_emb_Cons(1,3) show ?case by (cases ys) auto next case (list_emb_Cons2 x y xs ws ys zs) from list_emb_Cons2(3)[of "tl ys" zs] and list_emb_Cons2(3)[of "[]" "tl zs"] and list_emb_Cons2(1,2,4) show ?case by (cases ys) (auto simp: Cons_eq_append_conv) qed auto qed (auto intro: list_emb_append_mono) lemma subseq_appendE [case_names append]: assumes "subseq xs (ys @ zs)" obtains xs1 xs2 where "xs = xs1 @ xs2" "subseq xs1 ys" "subseq xs2 zs" using assms by (subst (asm) subseq_append_iff) auto lemma subseq_drop_many: "subseq xs ys \ subseq xs (zs @ ys)" by (induct zs) auto lemma subseq_rev_drop_many: "subseq xs ys \ subseq xs (ys @ zs)" by (metis append_Nil2 list_emb_Nil list_emb_append_mono) subsection \Relation to standard list operations\ lemma subseq_map: assumes "subseq xs ys" shows "subseq (map f xs) (map f ys)" using assms by (induct) auto lemma subseq_filter_left [simp]: "subseq (filter P xs) xs" by (induct xs) auto lemma subseq_filter [simp]: assumes "subseq xs ys" shows "subseq (filter P xs) (filter P ys)" using assms by induct auto lemma subseq_conv_nths: "subseq xs ys \ (\N. xs = nths ys N)" (is "?L = ?R") proof assume ?L then show ?R proof (induct) case list_emb_Nil show ?case by (metis nths_empty) next case (list_emb_Cons xs ys x) then obtain N where "xs = nths ys N" by blast then have "xs = nths (x#ys) (Suc ` N)" by (clarsimp simp add: nths_Cons inj_image_mem_iff) then show ?case by blast next case (list_emb_Cons2 x y xs ys) then obtain N where "xs = nths ys N" by blast then have "x#xs = nths (x#ys) (insert 0 (Suc ` N))" by (clarsimp simp add: nths_Cons inj_image_mem_iff) moreover from list_emb_Cons2 have "x = y" by simp ultimately show ?case by blast qed next assume ?R then obtain N where "xs = nths ys N" .. moreover have "subseq (nths ys N) ys" proof (induct ys arbitrary: N) case Nil show ?case by simp next case Cons then show ?case by (auto simp: nths_Cons) qed ultimately show ?L by simp qed subsection \Contiguous sublists\ subsubsection \\sublist\\ definition sublist :: "'a list \ 'a list \ bool" where "sublist xs ys = (\ps ss. ys = ps @ xs @ ss)" definition strict_sublist :: "'a list \ 'a list \ bool" where "strict_sublist xs ys \ sublist xs ys \ xs \ ys" interpretation sublist_order: order sublist strict_sublist proof fix xs ys zs :: "'a list" assume "sublist xs ys" "sublist ys zs" then obtain xs1 xs2 ys1 ys2 where "ys = xs1 @ xs @ xs2" "zs = ys1 @ ys @ ys2" by (auto simp: sublist_def) hence "zs = (ys1 @ xs1) @ xs @ (xs2 @ ys2)" by simp thus "sublist xs zs" unfolding sublist_def by blast next fix xs ys :: "'a list" { assume "sublist xs ys" "sublist ys xs" then obtain as bs cs ds where xs: "xs = as @ ys @ bs" and ys: "ys = cs @ xs @ ds" by (auto simp: sublist_def) have "xs = as @ cs @ xs @ ds @ bs" by (subst xs, subst ys) auto also have "length \ = length as + length cs + length xs + length bs + length ds" by simp finally have "as = []" "bs = []" by simp_all with xs show "xs = ys" by simp } thus "strict_sublist xs ys \ (sublist xs ys \ \sublist ys xs)" by (auto simp: strict_sublist_def) qed (auto simp: strict_sublist_def sublist_def intro: exI[of _ "[]"]) lemma sublist_Nil_left [simp, intro]: "sublist [] ys" by (auto simp: sublist_def) lemma sublist_Cons_Nil [simp]: "\sublist (x#xs) []" by (auto simp: sublist_def) lemma sublist_Nil_right [simp]: "sublist xs [] \ xs = []" by (cases xs) auto lemma sublist_appendI [simp, intro]: "sublist xs (ps @ xs @ ss)" by (auto simp: sublist_def) lemma sublist_append_leftI [simp, intro]: "sublist xs (ps @ xs)" by (auto simp: sublist_def intro: exI[of _ "[]"]) lemma sublist_append_rightI [simp, intro]: "sublist xs (xs @ ss)" by (auto simp: sublist_def intro: exI[of _ "[]"]) lemma sublist_altdef: "sublist xs ys \ (\ys'. prefix ys' ys \ suffix xs ys')" proof safe assume "sublist xs ys" then obtain ps ss where "ys = ps @ xs @ ss" by (auto simp: sublist_def) thus "\ys'. prefix ys' ys \ suffix xs ys'" by (intro exI[of _ "ps @ xs"] conjI suffix_appendI) auto next fix ys' assume "prefix ys' ys" "suffix xs ys'" thus "sublist xs ys" by (auto simp: prefix_def suffix_def) qed lemma sublist_altdef': "sublist xs ys \ (\ys'. suffix ys' ys \ prefix xs ys')" proof safe assume "sublist xs ys" then obtain ps ss where "ys = ps @ xs @ ss" by (auto simp: sublist_def) thus "\ys'. suffix ys' ys \ prefix xs ys'" by (intro exI[of _ "xs @ ss"] conjI suffixI) auto next fix ys' assume "suffix ys' ys" "prefix xs ys'" thus "sublist xs ys" by (auto simp: prefix_def suffix_def) qed lemma sublist_Cons_right: "sublist xs (y # ys) \ prefix xs (y # ys) \ sublist xs ys" by (auto simp: sublist_def prefix_def Cons_eq_append_conv) lemma sublist_code [code]: "sublist [] ys \ True" "sublist (x # xs) [] \ False" "sublist (x # xs) (y # ys) \ prefix (x # xs) (y # ys) \ sublist (x # xs) ys" by (simp_all add: sublist_Cons_right) lemma sublist_append: "sublist xs (ys @ zs) \ sublist xs ys \ sublist xs zs \ (\xs1 xs2. xs = xs1 @ xs2 \ suffix xs1 ys \ prefix xs2 zs)" by (auto simp: sublist_altdef prefix_append suffix_append) lemma map_mono_sublist: assumes "sublist xs ys" shows "sublist (map f xs) (map f ys)" proof - from assms obtain xs1 xs2 where ys: "ys = xs1 @ xs @ xs2" by (auto simp: sublist_def) have "map f ys = map f xs1 @ map f xs @ map f xs2" by (auto simp: ys) thus ?thesis by (auto simp: sublist_def) qed lemma sublist_length_le: "sublist xs ys \ length xs \ length ys" by (auto simp add: sublist_def) lemma set_mono_sublist: "sublist xs ys \ set xs \ set ys" by (auto simp add: sublist_def) lemma prefix_imp_sublist [simp, intro]: "prefix xs ys \ sublist xs ys" by (auto simp: sublist_def prefix_def intro: exI[of _ "[]"]) lemma suffix_imp_sublist [simp, intro]: "suffix xs ys \ sublist xs ys" by (auto simp: sublist_def suffix_def intro: exI[of _ "[]"]) lemma sublist_take [simp, intro]: "sublist (take n xs) xs" by (rule prefix_imp_sublist[OF take_is_prefix]) lemma sublist_takeWhile [simp, intro]: "sublist (takeWhile P xs) xs" by (rule prefix_imp_sublist[OF takeWhile_is_prefix]) lemma sublist_drop [simp, intro]: "sublist (drop n xs) xs" by (rule suffix_imp_sublist[OF suffix_drop]) lemma sublist_dropWhile [simp, intro]: "sublist (dropWhile P xs) xs" by (rule suffix_imp_sublist[OF suffix_dropWhile]) lemma sublist_tl [simp, intro]: "sublist (tl xs) xs" by (rule suffix_imp_sublist) (simp_all add: suffix_drop) lemma sublist_butlast [simp, intro]: "sublist (butlast xs) xs" by (rule prefix_imp_sublist) (simp_all add: prefixeq_butlast) lemma sublist_rev [simp]: "sublist (rev xs) (rev ys) = sublist xs ys" proof assume "sublist (rev xs) (rev ys)" then obtain as bs where "rev ys = as @ rev xs @ bs" by (auto simp: sublist_def) also have "rev \ = rev bs @ xs @ rev as" by simp finally show "sublist xs ys" by simp next assume "sublist xs ys" then obtain as bs where "ys = as @ xs @ bs" by (auto simp: sublist_def) also have "rev \ = rev bs @ rev xs @ rev as" by simp finally show "sublist (rev xs) (rev ys)" by simp qed lemma sublist_rev_left: "sublist (rev xs) ys = sublist xs (rev ys)" by (subst sublist_rev [symmetric]) (simp only: rev_rev_ident) lemma sublist_rev_right: "sublist xs (rev ys) = sublist (rev xs) ys" by (subst sublist_rev [symmetric]) (simp only: rev_rev_ident) lemma snoc_sublist_snoc: "sublist (xs @ [x]) (ys @ [y]) \ (x = y \ suffix xs ys \ sublist (xs @ [x]) ys) " by (subst (1 2) sublist_rev [symmetric]) (simp del: sublist_rev add: sublist_Cons_right suffix_to_prefix) lemma sublist_snoc: "sublist xs (ys @ [y]) \ suffix xs (ys @ [y]) \ sublist xs ys" by (subst (1 2) sublist_rev [symmetric]) (simp del: sublist_rev add: sublist_Cons_right suffix_to_prefix) lemma sublist_imp_subseq [intro]: "sublist xs ys \ subseq xs ys" by (auto simp: sublist_def) lemma sublist_map_rightE: assumes "sublist xs (map f ys)" shows "\xs'. sublist xs' ys \ xs = map f xs'" proof - note takedrop = sublist_take sublist_drop define n where "n = (length ys - length xs)" from assms obtain xs1 xs2 where xs12: "map f ys = xs1 @ xs @ xs2" by (auto simp: sublist_def) define n where "n = length xs1" have "xs = take (length xs) (drop n (map f ys))" by (simp add: xs12 n_def) thus ?thesis by (intro exI[of _ "take (length xs) (drop n ys)"]) (auto simp: take_map drop_map intro!: takedrop[THEN sublist_order.order.trans]) qed lemma sublist_remdups_adj: assumes "sublist xs ys" shows "sublist (remdups_adj xs) (remdups_adj ys)" proof - from assms obtain xs1 xs2 where ys: "ys = xs1 @ xs @ xs2" by (auto simp: sublist_def) have "suffix (remdups_adj (xs @ xs2)) (remdups_adj (xs1 @ xs @ xs2))" by (rule suffix_remdups_adj, rule suffix_appendI) auto then obtain zs1 where zs1: "remdups_adj (xs1 @ xs @ xs2) = zs1 @ remdups_adj (xs @ xs2)" by (auto simp: suffix_def) have "prefix (remdups_adj xs) (remdups_adj (xs @ xs2))" by (intro prefix_remdups_adj) auto then obtain zs2 where zs2: "remdups_adj (xs @ xs2) = remdups_adj xs @ zs2" by (auto simp: prefix_def) show ?thesis by (simp add: ys zs1 zs2) qed subsubsection \\sublists\\ primrec sublists :: "'a list \ 'a list list" where "sublists [] = [[]]" | "sublists (x # xs) = sublists xs @ map ((#) x) (prefixes xs)" lemma in_set_sublists [simp]: "xs \ set (sublists ys) \ sublist xs ys" by (induction ys arbitrary: xs) (auto simp: sublist_Cons_right prefix_Cons) lemma set_sublists_eq: "set (sublists xs) = {ys. sublist ys xs}" by auto lemma length_sublists [simp]: "length (sublists xs) = Suc (length xs * Suc (length xs) div 2)" by (induction xs) simp_all subsection \Parametricity\ context includes lifting_syntax begin private lemma prefix_primrec: "prefix = rec_list (\xs. True) (\x xs xsa ys. case ys of [] \ False | y # ys \ x = y \ xsa ys)" proof (intro ext, goal_cases) case (1 xs ys) show ?case by (induction xs arbitrary: ys) (auto simp: prefix_Cons split: list.splits) qed private lemma sublist_primrec: "sublist = (\xs ys. rec_list (\xs. xs = []) (\y ys ysa xs. prefix xs (y # ys) \ ysa xs) ys xs)" proof (intro ext, goal_cases) case (1 xs ys) show ?case by (induction ys) (auto simp: sublist_Cons_right) qed private lemma list_emb_primrec: "list_emb = (\uu uua uuaa. rec_list (\P xs. List.null xs) (\y ys ysa P xs. case xs of [] \ True | x # xs \ if P x y then ysa P xs else ysa P (x # xs)) uuaa uu uua)" proof (intro ext, goal_cases) case (1 P xs ys) show ?case by (induction ys arbitrary: xs) (auto simp: list_emb_code List.null_def split: list.splits) qed lemma prefix_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) prefix prefix" unfolding prefix_primrec by transfer_prover lemma suffix_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) suffix suffix" unfolding suffix_to_prefix [abs_def] by transfer_prover lemma sublist_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) sublist sublist" unfolding sublist_primrec by transfer_prover lemma parallel_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) parallel parallel" unfolding parallel_def by transfer_prover lemma list_emb_transfer [transfer_rule]: "((A ===> A ===> (=)) ===> list_all2 A ===> list_all2 A ===> (=)) list_emb list_emb" unfolding list_emb_primrec by transfer_prover lemma strict_prefix_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) strict_prefix strict_prefix" unfolding strict_prefix_def by transfer_prover lemma strict_suffix_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) strict_suffix strict_suffix" unfolding strict_suffix_def by transfer_prover lemma strict_subseq_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) strict_subseq strict_subseq" unfolding strict_subseq_def by transfer_prover lemma strict_sublist_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A ===> (=)) strict_sublist strict_sublist" unfolding strict_sublist_def by transfer_prover lemma prefixes_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 (list_all2 A)) prefixes prefixes" unfolding prefixes_def by transfer_prover lemma suffixes_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 (list_all2 A)) suffixes suffixes" unfolding suffixes_def by transfer_prover lemma sublists_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 (list_all2 A)) sublists sublists" unfolding sublists_def by transfer_prover end end diff --git a/src/HOL/Library/Subseq_Order.thy b/src/HOL/Library/Subseq_Order.thy --- a/src/HOL/Library/Subseq_Order.thy +++ b/src/HOL/Library/Subseq_Order.thy @@ -1,76 +1,78 @@ (* Title: HOL/Library/Subseq_Order.thy Author: Peter Lammich, Uni Muenster Author: Florian Haftmann, TU Muenchen Author: Tobias Nipkow, TU Muenchen *) section \Subsequence Ordering\ theory Subseq_Order imports Sublist begin text \ This theory defines subsequence ordering on lists. A list \ys\ is a subsequence of a list \xs\, iff one obtains \ys\ by erasing some elements from \xs\. \ subsection \Definitions and basic lemmas\ instantiation list :: (type) ord begin definition "xs \ ys \ subseq xs ys" for xs ys :: "'a list" definition "xs < ys \ xs \ ys \ \ ys \ xs" for xs ys :: "'a list" instance .. end instance list :: (type) order proof fix xs ys zs :: "'a list" show "xs < ys \ xs \ ys \ \ ys \ xs" unfolding less_list_def .. show "xs \ xs" by (simp add: less_eq_list_def) show "xs = ys" if "xs \ ys" and "ys \ xs" - using that unfolding less_eq_list_def by (rule subseq_order.antisym) + using that unfolding less_eq_list_def + by (rule subseq_order.antisym) show "xs \ zs" if "xs \ ys" and "ys \ zs" - using that unfolding less_eq_list_def by (rule subseq_order.order_trans) + using that unfolding less_eq_list_def + by (rule subseq_order.order_trans) qed lemmas less_eq_list_induct [consumes 1, case_names empty drop take] = list_emb.induct [of "(=)", folded less_eq_list_def] lemmas less_eq_list_drop = list_emb.list_emb_Cons [of "(=)", folded less_eq_list_def] lemmas le_list_Cons2_iff [simp, code] = subseq_Cons2_iff [folded less_eq_list_def] lemmas le_list_map = subseq_map [folded less_eq_list_def] lemmas le_list_filter = subseq_filter [folded less_eq_list_def] lemmas le_list_length = list_emb_length [of "(=)", folded less_eq_list_def] lemma less_list_length: "xs < ys \ length xs < length ys" by (metis list_emb_length subseq_same_length le_neq_implies_less less_list_def less_eq_list_def) lemma less_list_empty [simp]: "[] < xs \ xs \ []" by (metis less_eq_list_def list_emb_Nil order_less_le) lemma less_list_below_empty [simp]: "xs < [] \ False" by (metis list_emb_Nil less_eq_list_def less_list_def) lemma less_list_drop: "xs < ys \ xs < x # ys" by (unfold less_le less_eq_list_def) (auto) lemma less_list_take_iff: "x # xs < x # ys \ xs < ys" by (metis subseq_Cons2_iff less_list_def less_eq_list_def) lemma less_list_drop_many: "xs < ys \ xs < zs @ ys" by (metis subseq_append_le_same_iff subseq_drop_many order_less_le self_append_conv2 less_eq_list_def) lemma less_list_take_many_iff: "zs @ xs < zs @ ys \ xs < ys" by (metis less_list_def less_eq_list_def subseq_append') lemma less_list_rev_take: "xs @ zs < ys @ zs \ xs < ys" by (unfold less_le less_eq_list_def) auto end diff --git a/src/HOL/List.thy b/src/HOL/List.thy --- a/src/HOL/List.thy +++ b/src/HOL/List.thy @@ -1,8221 +1,8223 @@ (* Title: HOL/List.thy Author: Tobias Nipkow; proofs tidied by LCP *) section \The datatype of finite lists\ theory List imports Sledgehammer Code_Numeral Lifting_Set begin datatype (set: 'a) list = Nil ("[]") | Cons (hd: 'a) (tl: "'a list") (infixr "#" 65) for map: map rel: list_all2 pred: list_all where "tl [] = []" datatype_compat list lemma [case_names Nil Cons, cases type: list]: \ \for backward compatibility -- names of variables differ\ "(y = [] \ P) \ (\a list. y = a # list \ P) \ P" by (rule list.exhaust) lemma [case_names Nil Cons, induct type: list]: \ \for backward compatibility -- names of variables differ\ "P [] \ (\a list. P list \ P (a # list)) \ P list" by (rule list.induct) text \Compatibility:\ setup \Sign.mandatory_path "list"\ lemmas inducts = list.induct lemmas recs = list.rec lemmas cases = list.case setup \Sign.parent_path\ lemmas set_simps = list.set (* legacy *) syntax \ \list Enumeration\ "_list" :: "args => 'a list" ("[(_)]") translations "[x, xs]" == "x#[xs]" "[x]" == "x#[]" subsection \Basic list processing functions\ primrec (nonexhaustive) last :: "'a list \ 'a" where "last (x # xs) = (if xs = [] then x else last xs)" primrec butlast :: "'a list \ 'a list" where "butlast [] = []" | "butlast (x # xs) = (if xs = [] then [] else x # butlast xs)" lemma set_rec: "set xs = rec_list {} (\x _. insert x) xs" by (induct xs) auto definition coset :: "'a list \ 'a set" where [simp]: "coset xs = - set xs" primrec append :: "'a list \ 'a list \ 'a list" (infixr "@" 65) where append_Nil: "[] @ ys = ys" | append_Cons: "(x#xs) @ ys = x # xs @ ys" primrec rev :: "'a list \ 'a list" where "rev [] = []" | "rev (x # xs) = rev xs @ [x]" primrec filter:: "('a \ bool) \ 'a list \ 'a list" where "filter P [] = []" | "filter P (x # xs) = (if P x then x # filter P xs else filter P xs)" text \Special input syntax for filter:\ syntax (ASCII) "_filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_<-_./ _])") syntax "_filter" :: "[pttrn, 'a list, bool] => 'a list" ("(1[_\_ ./ _])") translations "[x<-xs . P]" \ "CONST filter (\x. P) xs" primrec fold :: "('a \ 'b \ 'b) \ 'a list \ 'b \ 'b" where fold_Nil: "fold f [] = id" | fold_Cons: "fold f (x # xs) = fold f xs \ f x" primrec foldr :: "('a \ 'b \ 'b) \ 'a list \ 'b \ 'b" where foldr_Nil: "foldr f [] = id" | foldr_Cons: "foldr f (x # xs) = f x \ foldr f xs" primrec foldl :: "('b \ 'a \ 'b) \ 'b \ 'a list \ 'b" where foldl_Nil: "foldl f a [] = a" | foldl_Cons: "foldl f a (x # xs) = foldl f (f a x) xs" primrec concat:: "'a list list \ 'a list" where "concat [] = []" | "concat (x # xs) = x @ concat xs" primrec drop:: "nat \ 'a list \ 'a list" where drop_Nil: "drop n [] = []" | drop_Cons: "drop n (x # xs) = (case n of 0 \ x # xs | Suc m \ drop m xs)" \ \Warning: simpset does not contain this definition, but separate theorems for \n = 0\ and \n = Suc k\\ primrec take:: "nat \ 'a list \ 'a list" where take_Nil:"take n [] = []" | take_Cons: "take n (x # xs) = (case n of 0 \ [] | Suc m \ x # take m xs)" \ \Warning: simpset does not contain this definition, but separate theorems for \n = 0\ and \n = Suc k\\ primrec (nonexhaustive) nth :: "'a list => nat => 'a" (infixl "!" 100) where nth_Cons: "(x # xs) ! n = (case n of 0 \ x | Suc k \ xs ! k)" \ \Warning: simpset does not contain this definition, but separate theorems for \n = 0\ and \n = Suc k\\ primrec list_update :: "'a list \ nat \ 'a \ 'a list" where "list_update [] i v = []" | "list_update (x # xs) i v = (case i of 0 \ v # xs | Suc j \ x # list_update xs j v)" nonterminal lupdbinds and lupdbind syntax "_lupdbind":: "['a, 'a] => lupdbind" ("(2_ :=/ _)") "" :: "lupdbind => lupdbinds" ("_") "_lupdbinds" :: "[lupdbind, lupdbinds] => lupdbinds" ("_,/ _") "_LUpdate" :: "['a, lupdbinds] => 'a" ("_/[(_)]" [1000,0] 900) translations "_LUpdate xs (_lupdbinds b bs)" == "_LUpdate (_LUpdate xs b) bs" "xs[i:=x]" == "CONST list_update xs i x" primrec takeWhile :: "('a \ bool) \ 'a list \ 'a list" where "takeWhile P [] = []" | "takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])" primrec dropWhile :: "('a \ bool) \ 'a list \ 'a list" where "dropWhile P [] = []" | "dropWhile P (x # xs) = (if P x then dropWhile P xs else x # xs)" primrec zip :: "'a list \ 'b list \ ('a \ 'b) list" where "zip xs [] = []" | zip_Cons: "zip xs (y # ys) = (case xs of [] \ [] | z # zs \ (z, y) # zip zs ys)" \ \Warning: simpset does not contain this definition, but separate theorems for \xs = []\ and \xs = z # zs\\ abbreviation map2 :: "('a \ 'b \ 'c) \ 'a list \ 'b list \ 'c list" where "map2 f xs ys \ map (\(x,y). f x y) (zip xs ys)" primrec product :: "'a list \ 'b list \ ('a \ 'b) list" where "product [] _ = []" | "product (x#xs) ys = map (Pair x) ys @ product xs ys" hide_const (open) product primrec product_lists :: "'a list list \ 'a list list" where "product_lists [] = [[]]" | "product_lists (xs # xss) = concat (map (\x. map (Cons x) (product_lists xss)) xs)" primrec upt :: "nat \ nat \ nat list" ("(1[_.. j then [i.. 'a list \ 'a list" where "insert x xs = (if x \ set xs then xs else x # xs)" definition union :: "'a list \ 'a list \ 'a list" where "union = fold insert" hide_const (open) insert union hide_fact (open) insert_def union_def primrec find :: "('a \ bool) \ 'a list \ 'a option" where "find _ [] = None" | "find P (x#xs) = (if P x then Some x else find P xs)" text \In the context of multisets, \count_list\ is equivalent to \<^term>\count \ mset\ and it it advisable to use the latter.\ primrec count_list :: "'a list \ 'a \ nat" where "count_list [] y = 0" | "count_list (x#xs) y = (if x=y then count_list xs y + 1 else count_list xs y)" definition "extract" :: "('a \ bool) \ 'a list \ ('a list * 'a * 'a list) option" where "extract P xs = (case dropWhile (Not \ P) xs of [] \ None | y#ys \ Some(takeWhile (Not \ P) xs, y, ys))" hide_const (open) "extract" primrec those :: "'a option list \ 'a list option" where "those [] = Some []" | "those (x # xs) = (case x of None \ None | Some y \ map_option (Cons y) (those xs))" primrec remove1 :: "'a \ 'a list \ 'a list" where "remove1 x [] = []" | "remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)" primrec removeAll :: "'a \ 'a list \ 'a list" where "removeAll x [] = []" | "removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)" primrec distinct :: "'a list \ bool" where "distinct [] \ True" | "distinct (x # xs) \ x \ set xs \ distinct xs" fun successively :: "('a \ 'a \ bool) \ 'a list \ bool" where "successively P [] = True" | "successively P [x] = True" | "successively P (x # y # xs) = (P x y \ successively P (y#xs))" definition distinct_adj where "distinct_adj = successively (\)" primrec remdups :: "'a list \ 'a list" where "remdups [] = []" | "remdups (x # xs) = (if x \ set xs then remdups xs else x # remdups xs)" fun remdups_adj :: "'a list \ 'a list" where "remdups_adj [] = []" | "remdups_adj [x] = [x]" | "remdups_adj (x # y # xs) = (if x = y then remdups_adj (x # xs) else x # remdups_adj (y # xs))" primrec replicate :: "nat \ 'a \ 'a list" where replicate_0: "replicate 0 x = []" | replicate_Suc: "replicate (Suc n) x = x # replicate n x" text \ Function \size\ is overloaded for all datatypes. Users may refer to the list version as \length\.\ abbreviation length :: "'a list \ nat" where "length \ size" definition enumerate :: "nat \ 'a list \ (nat \ 'a) list" where enumerate_eq_zip: "enumerate n xs = zip [n.. 'a list" where "rotate1 [] = []" | "rotate1 (x # xs) = xs @ [x]" definition rotate :: "nat \ 'a list \ 'a list" where "rotate n = rotate1 ^^ n" definition nths :: "'a list => nat set => 'a list" where "nths xs A = map fst (filter (\p. snd p \ A) (zip xs [0.. 'a list list" where "subseqs [] = [[]]" | "subseqs (x#xs) = (let xss = subseqs xs in map (Cons x) xss @ xss)" primrec n_lists :: "nat \ 'a list \ 'a list list" where "n_lists 0 xs = [[]]" | "n_lists (Suc n) xs = concat (map (\ys. map (\y. y # ys) xs) (n_lists n xs))" hide_const (open) n_lists function splice :: "'a list \ 'a list \ 'a list" where "splice [] ys = ys" | "splice (x#xs) ys = x # splice ys xs" by pat_completeness auto termination by(relation "measure(\(xs,ys). size xs + size ys)") auto function shuffles where "shuffles [] ys = {ys}" | "shuffles xs [] = {xs}" | "shuffles (x # xs) (y # ys) = (#) x ` shuffles xs (y # ys) \ (#) y ` shuffles (x # xs) ys" by pat_completeness simp_all termination by lexicographic_order text\Use only if you cannot use \<^const>\Min\ instead:\ fun min_list :: "'a::ord list \ 'a" where "min_list (x # xs) = (case xs of [] \ x | _ \ min x (min_list xs))" text\Returns first minimum:\ fun arg_min_list :: "('a \ ('b::linorder)) \ 'a list \ 'a" where "arg_min_list f [x] = x" | "arg_min_list f (x#y#zs) = (let m = arg_min_list f (y#zs) in if f x \ f m then x else m)" text\ \begin{figure}[htbp] \fbox{ \begin{tabular}{l} @{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\ @{lemma "length [a,b,c] = 3" by simp}\\ @{lemma "set [a,b,c] = {a,b,c}" by simp}\\ @{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\ @{lemma "rev [a,b,c] = [c,b,a]" by simp}\\ @{lemma "hd [a,b,c,d] = a" by simp}\\ @{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\ @{lemma "last [a,b,c,d] = d" by simp}\\ @{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\ @{lemma[source] "filter (\n::nat. n<2) [0,2,1] = [0,1]" by simp}\\ @{lemma "concat [[a,b],[c,d,e],[],[f]] = [a,b,c,d,e,f]" by simp}\\ @{lemma "fold f [a,b,c] x = f c (f b (f a x))" by simp}\\ @{lemma "foldr f [a,b,c] x = f a (f b (f c x))" by simp}\\ @{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ @{lemma "successively (\) [True,False,True,False]" by simp}\\ @{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ @{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ @{lemma "enumerate 3 [a,b,c] = [(3,a),(4,b),(5,c)]" by normalization}\\ @{lemma "List.product [a,b] [c,d] = [(a, c), (a, d), (b, c), (b, d)]" by simp}\\ @{lemma "product_lists [[a,b], [c], [d,e]] = [[a,c,d], [a,c,e], [b,c,d], [b,c,e]]" by simp}\\ @{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ @{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ @{lemma "shuffles [a,b] [c,d] = {[a,b,c,d],[a,c,b,d],[a,c,d,b],[c,a,b,d],[c,a,d,b],[c,d,a,b]}" by (simp add: insert_commute)}\\ @{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ @{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ @{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ @{lemma "drop 6 [a,b,c,d] = []" by simp}\\ @{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ @{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ @{lemma "distinct [2,0,1::nat]" by simp}\\ @{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\ @{lemma "remdups_adj [2,2,3,1,1::nat,2,1] = [2,3,1,2,1]" by simp}\\ @{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ @{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ @{lemma "List.union [2,3,4] [0::int,1,2] = [4,3,0,1,2]" by (simp add: List.insert_def List.union_def)}\\ @{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ @{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ @{lemma "count_list [0,1,0,2::int] 0 = 2" by (simp)}\\ @{lemma "List.extract (%i::int. i>0) [0,0] = None" by(simp add: extract_def)}\\ @{lemma "List.extract (%i::int. i>0) [0,1,0,2] = Some([0], 1, [0,2])" by(simp add: extract_def)}\\ @{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ @{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\ @{lemma "nth [a,b,c,d] 2 = c" by simp}\\ @{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\ @{lemma "nths [a,b,c,d,e] {0,2,3} = [a,c,d]" by (simp add:nths_def)}\\ @{lemma "subseqs [a,b] = [[a, b], [a], [b], []]" by simp}\\ @{lemma "List.n_lists 2 [a,b,c] = [[a, a], [b, a], [c, a], [a, b], [b, b], [c, b], [a, c], [b, c], [c, c]]" by (simp add: eval_nat_numeral)}\\ @{lemma "rotate1 [a,b,c,d] = [b,c,d,a]" by simp}\\ @{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate_def eval_nat_numeral)}\\ @{lemma "replicate 4 a = [a,a,a,a]" by (simp add:eval_nat_numeral)}\\ @{lemma "[2..<5] = [2,3,4]" by (simp add:eval_nat_numeral)}\\ @{lemma "min_list [3,1,-2::int] = -2" by (simp)}\\ @{lemma "arg_min_list (\i. i*i) [3,-1,1,-2::int] = -1" by (simp)} \end{tabular}} \caption{Characteristic examples} \label{fig:Characteristic} \end{figure} Figure~\ref{fig:Characteristic} shows characteristic examples that should give an intuitive understanding of the above functions. \ text\The following simple sort(ed) functions are intended for proofs, not for efficient implementations.\ text \A sorted predicate w.r.t. a relation:\ fun sorted_wrt :: "('a \ 'a \ bool) \ 'a list \ bool" where "sorted_wrt P [] = True" | "sorted_wrt P (x # ys) = ((\y \ set ys. P x y) \ sorted_wrt P ys)" text \A class-based sorted predicate:\ context linorder begin fun sorted :: "'a list \ bool" where "sorted [] = True" | "sorted (x # ys) = ((\y \ set ys. x \ y) \ sorted ys)" fun strict_sorted :: "'a list \ bool" where "strict_sorted [] = True" | "strict_sorted (x # ys) = ((\y \ List.set ys. x < y) \ strict_sorted ys)" lemma sorted_sorted_wrt: "sorted = sorted_wrt (\)" proof (rule ext) fix xs show "sorted xs = sorted_wrt (\) xs" by(induction xs rule: sorted.induct) auto qed lemma strict_sorted_sorted_wrt: "strict_sorted = sorted_wrt (<)" proof (rule ext) fix xs show "strict_sorted xs = sorted_wrt (<) xs" by(induction xs rule: strict_sorted.induct) auto qed primrec insort_key :: "('b \ 'a) \ 'b \ 'b list \ 'b list" where "insort_key f x [] = [x]" | "insort_key f x (y#ys) = (if f x \ f y then (x#y#ys) else y#(insort_key f x ys))" definition sort_key :: "('b \ 'a) \ 'b list \ 'b list" where "sort_key f xs = foldr (insort_key f) xs []" definition insort_insert_key :: "('b \ 'a) \ 'b \ 'b list \ 'b list" where "insort_insert_key f x xs = (if f x \ f ` set xs then xs else insort_key f x xs)" abbreviation "sort \ sort_key (\x. x)" abbreviation "insort \ insort_key (\x. x)" abbreviation "insort_insert \ insort_insert_key (\x. x)" definition stable_sort_key :: "(('b \ 'a) \ 'b list \ 'b list) \ bool" where "stable_sort_key sk = (\f xs k. filter (\y. f y = k) (sk f xs) = filter (\y. f y = k) xs)" lemma strict_sorted_iff: "strict_sorted l \ sorted l \ distinct l" by (induction l) (auto iff: antisym_conv1) lemma strict_sorted_imp_sorted: "strict_sorted xs \ sorted xs" by (auto simp: strict_sorted_iff) end subsubsection \List comprehension\ text\Input syntax for Haskell-like list comprehension notation. Typical example: \[(x,y). x \ xs, y \ ys, x \ y]\, the list of all pairs of distinct elements from \xs\ and \ys\. The syntax is as in Haskell, except that \|\ becomes a dot (like in Isabelle's set comprehension): \[e. x \ xs, \]\ rather than \verb![e| x <- xs, ...]!. The qualifiers after the dot are \begin{description} \item[generators] \p \ xs\, where \p\ is a pattern and \xs\ an expression of list type, or \item[guards] \b\, where \b\ is a boolean expression. %\item[local bindings] @ {text"let x = e"}. \end{description} Just like in Haskell, list comprehension is just a shorthand. To avoid misunderstandings, the translation into desugared form is not reversed upon output. Note that the translation of \[e. x \ xs]\ is optmized to \<^term>\map (%x. e) xs\. It is easy to write short list comprehensions which stand for complex expressions. During proofs, they may become unreadable (and mangled). In such cases it can be advisable to introduce separate definitions for the list comprehensions in question.\ nonterminal lc_qual and lc_quals syntax "_listcompr" :: "'a \ lc_qual \ lc_quals \ 'a list" ("[_ . __") "_lc_gen" :: "'a \ 'a list \ lc_qual" ("_ \ _") "_lc_test" :: "bool \ lc_qual" ("_") (*"_lc_let" :: "letbinds => lc_qual" ("let _")*) "_lc_end" :: "lc_quals" ("]") "_lc_quals" :: "lc_qual \ lc_quals \ lc_quals" (", __") syntax (ASCII) "_lc_gen" :: "'a \ 'a list \ lc_qual" ("_ <- _") parse_translation \ let val NilC = Syntax.const \<^const_syntax>\Nil\; val ConsC = Syntax.const \<^const_syntax>\Cons\; val mapC = Syntax.const \<^const_syntax>\map\; val concatC = Syntax.const \<^const_syntax>\concat\; val IfC = Syntax.const \<^const_syntax>\If\; val dummyC = Syntax.const \<^const_syntax>\Pure.dummy_pattern\ fun single x = ConsC $ x $ NilC; fun pat_tr ctxt p e opti = (* %x. case x of p => e | _ => [] *) let (* FIXME proper name context!? *) val x = Free (singleton (Name.variant_list (fold Term.add_free_names [p, e] [])) "x", dummyT); val e = if opti then single e else e; val case1 = Syntax.const \<^syntax_const>\_case1\ $ p $ e; val case2 = Syntax.const \<^syntax_const>\_case1\ $ dummyC $ NilC; val cs = Syntax.const \<^syntax_const>\_case2\ $ case1 $ case2; in Syntax_Trans.abs_tr [x, Case_Translation.case_tr false ctxt [x, cs]] end; fun pair_pat_tr (x as Free _) e = Syntax_Trans.abs_tr [x, e] | pair_pat_tr (_ $ p1 $ p2) e = Syntax.const \<^const_syntax>\case_prod\ $ pair_pat_tr p1 (pair_pat_tr p2 e) | pair_pat_tr dummy e = Syntax_Trans.abs_tr [Syntax.const "_idtdummy", e] fun pair_pat ctxt (Const (\<^const_syntax>\Pair\,_) $ s $ t) = pair_pat ctxt s andalso pair_pat ctxt t | pair_pat ctxt (Free (s,_)) = let val thy = Proof_Context.theory_of ctxt; val s' = Proof_Context.intern_const ctxt s; in not (Sign.declared_const thy s') end | pair_pat _ t = (t = dummyC); fun abs_tr ctxt p e opti = let val p = Term_Position.strip_positions p in if pair_pat ctxt p then (pair_pat_tr p e, true) else (pat_tr ctxt p e opti, false) end fun lc_tr ctxt [e, Const (\<^syntax_const>\_lc_test\, _) $ b, qs] = let val res = (case qs of Const (\<^syntax_const>\_lc_end\, _) => single e | Const (\<^syntax_const>\_lc_quals\, _) $ q $ qs => lc_tr ctxt [e, q, qs]); in IfC $ b $ res $ NilC end | lc_tr ctxt [e, Const (\<^syntax_const>\_lc_gen\, _) $ p $ es, Const(\<^syntax_const>\_lc_end\, _)] = (case abs_tr ctxt p e true of (f, true) => mapC $ f $ es | (f, false) => concatC $ (mapC $ f $ es)) | lc_tr ctxt [e, Const (\<^syntax_const>\_lc_gen\, _) $ p $ es, Const (\<^syntax_const>\_lc_quals\, _) $ q $ qs] = let val e' = lc_tr ctxt [e, q, qs]; in concatC $ (mapC $ (fst (abs_tr ctxt p e' false)) $ es) end; in [(\<^syntax_const>\_listcompr\, lc_tr)] end \ ML_val \ let val read = Syntax.read_term \<^context> o Syntax.implode_input; fun check s1 s2 = read s1 aconv read s2 orelse error ("Check failed: " ^ quote (#1 (Input.source_content s1)) ^ Position.here_list [Input.pos_of s1, Input.pos_of s2]); in check \[(x,y,z). b]\ \if b then [(x, y, z)] else []\; check \[(x,y,z). (x,_,y)\xs]\ \map (\(x,_,y). (x, y, z)) xs\; check \[e x y. (x,_)\xs, y\ys]\ \concat (map (\(x,_). map (\y. e x y) ys) xs)\; check \[(x,y,z). xb]\ \if x < a then if b < x then [(x, y, z)] else [] else []\; check \[(x,y,z). x\xs, x>b]\ \concat (map (\x. if b < x then [(x, y, z)] else []) xs)\; check \[(x,y,z). xxs]\ \if x < a then map (\x. (x, y, z)) xs else []\; check \[(x,y). Cons True x \ xs]\ \concat (map (\xa. case xa of [] \ [] | True # x \ [(x, y)] | False # x \ []) xs)\; check \[(x,y,z). Cons x [] \ xs]\ \concat (map (\xa. case xa of [] \ [] | [x] \ [(x, y, z)] | x # aa # lista \ []) xs)\; check \[(x,y,z). xb, x=d]\ \if x < a then if b < x then if x = d then [(x, y, z)] else [] else [] else []\; check \[(x,y,z). xb, y\ys]\ \if x < a then if b < x then map (\y. (x, y, z)) ys else [] else []\; check \[(x,y,z). xxs,y>b]\ \if x < a then concat (map (\(_,x). if b < y then [(x, y, z)] else []) xs) else []\; check \[(x,y,z). xxs, y\ys]\ \if x < a then concat (map (\x. map (\y. (x, y, z)) ys) xs) else []\; check \[(x,y,z). x\xs, x>b, y \concat (map (\x. if b < x then if y < a then [(x, y, z)] else [] else []) xs)\; check \[(x,y,z). x\xs, x>b, y\ys]\ \concat (map (\x. if b < x then map (\y. (x, y, z)) ys else []) xs)\; check \[(x,y,z). x\xs, (y,_)\ys,y>x]\ \concat (map (\x. concat (map (\(y,_). if x < y then [(x, y, z)] else []) ys)) xs)\; check \[(x,y,z). x\xs, y\ys,z\zs]\ \concat (map (\x. concat (map (\y. map (\z. (x, y, z)) zs) ys)) xs)\ end; \ ML \ (* Simproc for rewriting list comprehensions applied to List.set to set comprehension. *) signature LIST_TO_SET_COMPREHENSION = sig val simproc : Proof.context -> cterm -> thm option end structure List_to_Set_Comprehension : LIST_TO_SET_COMPREHENSION = struct (* conversion *) fun all_exists_conv cv ctxt ct = (case Thm.term_of ct of Const (\<^const_name>\Ex\, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv (all_exists_conv cv o #2) ctxt) ct | _ => cv ctxt ct) fun all_but_last_exists_conv cv ctxt ct = (case Thm.term_of ct of Const (\<^const_name>\Ex\, _) $ Abs (_, _, Const (\<^const_name>\Ex\, _) $ _) => Conv.arg_conv (Conv.abs_conv (all_but_last_exists_conv cv o #2) ctxt) ct | _ => cv ctxt ct) fun Collect_conv cv ctxt ct = (case Thm.term_of ct of Const (\<^const_name>\Collect\, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv cv ctxt) ct | _ => raise CTERM ("Collect_conv", [ct])) fun rewr_conv' th = Conv.rewr_conv (mk_meta_eq th) fun conjunct_assoc_conv ct = Conv.try_conv (rewr_conv' @{thm conj_assoc} then_conv HOLogic.conj_conv Conv.all_conv conjunct_assoc_conv) ct fun right_hand_set_comprehension_conv conv ctxt = HOLogic.Trueprop_conv (HOLogic.eq_conv Conv.all_conv (Collect_conv (all_exists_conv conv o #2) ctxt)) (* term abstraction of list comprehension patterns *) datatype termlets = If | Case of typ * int local val set_Nil_I = @{lemma "set [] = {x. False}" by (simp add: empty_def [symmetric])} val set_singleton = @{lemma "set [a] = {x. x = a}" by simp} val inst_Collect_mem_eq = @{lemma "set A = {x. x \ set A}" by simp} val del_refl_eq = @{lemma "(t = t \ P) \ P" by simp} fun mk_set T = Const (\<^const_name>\set\, HOLogic.listT T --> HOLogic.mk_setT T) fun dest_set (Const (\<^const_name>\set\, _) $ xs) = xs fun dest_singleton_list (Const (\<^const_name>\Cons\, _) $ t $ (Const (\<^const_name>\Nil\, _))) = t | dest_singleton_list t = raise TERM ("dest_singleton_list", [t]) (*We check that one case returns a singleton list and all other cases return [], and return the index of the one singleton list case.*) fun possible_index_of_singleton_case cases = let fun check (i, case_t) s = (case strip_abs_body case_t of (Const (\<^const_name>\Nil\, _)) => s | _ => (case s of SOME NONE => SOME (SOME i) | _ => NONE)) in fold_index check cases (SOME NONE) |> the_default NONE end (*returns condition continuing term option*) fun dest_if (Const (\<^const_name>\If\, _) $ cond $ then_t $ Const (\<^const_name>\Nil\, _)) = SOME (cond, then_t) | dest_if _ = NONE (*returns (case_expr type index chosen_case constr_name) option*) fun dest_case ctxt case_term = let val (case_const, args) = strip_comb case_term in (case try dest_Const case_const of SOME (c, T) => (case Ctr_Sugar.ctr_sugar_of_case ctxt c of SOME {ctrs, ...} => (case possible_index_of_singleton_case (fst (split_last args)) of SOME i => let val constr_names = map (fst o dest_Const) ctrs val (Ts, _) = strip_type T val T' = List.last Ts in SOME (List.last args, T', i, nth args i, nth constr_names i) end | NONE => NONE) | NONE => NONE) | NONE => NONE) end fun tac ctxt [] = resolve_tac ctxt [set_singleton] 1 ORELSE resolve_tac ctxt [inst_Collect_mem_eq] 1 | tac ctxt (If :: cont) = Splitter.split_tac ctxt @{thms if_split} 1 THEN resolve_tac ctxt @{thms conjI} 1 THEN resolve_tac ctxt @{thms impI} 1 THEN Subgoal.FOCUS (fn {prems, context = ctxt', ...} => CONVERSION (right_hand_set_comprehension_conv (K (HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_TrueI})) Conv.all_conv then_conv rewr_conv' @{lemma "(True \ P) = P" by simp})) ctxt') 1) ctxt 1 THEN tac ctxt cont THEN resolve_tac ctxt @{thms impI} 1 THEN Subgoal.FOCUS (fn {prems, context = ctxt', ...} => CONVERSION (right_hand_set_comprehension_conv (K (HOLogic.conj_conv (Conv.rewr_conv (List.last prems RS @{thm Eq_FalseI})) Conv.all_conv then_conv rewr_conv' @{lemma "(False \ P) = False" by simp})) ctxt') 1) ctxt 1 THEN resolve_tac ctxt [set_Nil_I] 1 | tac ctxt (Case (T, i) :: cont) = let val SOME {injects, distincts, case_thms, split, ...} = Ctr_Sugar.ctr_sugar_of ctxt (fst (dest_Type T)) in (* do case distinction *) Splitter.split_tac ctxt [split] 1 THEN EVERY (map_index (fn (i', _) => (if i' < length case_thms - 1 then resolve_tac ctxt @{thms conjI} 1 else all_tac) THEN REPEAT_DETERM (resolve_tac ctxt @{thms allI} 1) THEN resolve_tac ctxt @{thms impI} 1 THEN (if i' = i then (* continue recursively *) Subgoal.FOCUS (fn {prems, context = ctxt', ...} => CONVERSION (Thm.eta_conversion then_conv right_hand_set_comprehension_conv (K ((HOLogic.conj_conv (HOLogic.eq_conv Conv.all_conv (rewr_conv' (List.last prems)) then_conv (Conv.try_conv (Conv.rewrs_conv (map mk_meta_eq injects)))) Conv.all_conv) then_conv (Conv.try_conv (Conv.rewr_conv del_refl_eq)) then_conv conjunct_assoc_conv)) ctxt' then_conv (HOLogic.Trueprop_conv (HOLogic.eq_conv Conv.all_conv (Collect_conv (fn (_, ctxt'') => Conv.repeat_conv (all_but_last_exists_conv (K (rewr_conv' @{lemma "(\x. x = t \ P x) = P t" by simp})) ctxt'')) ctxt')))) 1) ctxt 1 THEN tac ctxt cont else Subgoal.FOCUS (fn {prems, context = ctxt', ...} => CONVERSION (right_hand_set_comprehension_conv (K (HOLogic.conj_conv ((HOLogic.eq_conv Conv.all_conv (rewr_conv' (List.last prems))) then_conv (Conv.rewrs_conv (map (fn th => th RS @{thm Eq_FalseI}) distincts))) Conv.all_conv then_conv (rewr_conv' @{lemma "(False \ P) = False" by simp}))) ctxt' then_conv HOLogic.Trueprop_conv (HOLogic.eq_conv Conv.all_conv (Collect_conv (fn (_, ctxt'') => Conv.repeat_conv (Conv.bottom_conv (K (rewr_conv' @{lemma "(\x. P) = P" by simp})) ctxt'')) ctxt'))) 1) ctxt 1 THEN resolve_tac ctxt [set_Nil_I] 1)) case_thms) end in fun simproc ctxt redex = let fun make_inner_eqs bound_vs Tis eqs t = (case dest_case ctxt t of SOME (x, T, i, cont, constr_name) => let val (vs, body) = strip_abs (Envir.eta_long (map snd bound_vs) cont) val x' = incr_boundvars (length vs) x val eqs' = map (incr_boundvars (length vs)) eqs val constr_t = list_comb (Const (constr_name, map snd vs ---> T), map Bound (((length vs) - 1) downto 0)) val constr_eq = Const (\<^const_name>\HOL.eq\, T --> T --> \<^typ>\bool\) $ constr_t $ x' in make_inner_eqs (rev vs @ bound_vs) (Case (T, i) :: Tis) (constr_eq :: eqs') body end | NONE => (case dest_if t of SOME (condition, cont) => make_inner_eqs bound_vs (If :: Tis) (condition :: eqs) cont | NONE => if null eqs then NONE (*no rewriting, nothing to be done*) else let val Type (\<^type_name>\list\, [rT]) = fastype_of1 (map snd bound_vs, t) val pat_eq = (case try dest_singleton_list t of SOME t' => Const (\<^const_name>\HOL.eq\, rT --> rT --> \<^typ>\bool\) $ Bound (length bound_vs) $ t' | NONE => Const (\<^const_name>\Set.member\, rT --> HOLogic.mk_setT rT --> \<^typ>\bool\) $ Bound (length bound_vs) $ (mk_set rT $ t)) val reverse_bounds = curry subst_bounds ((map Bound ((length bound_vs - 1) downto 0)) @ [Bound (length bound_vs)]) val eqs' = map reverse_bounds eqs val pat_eq' = reverse_bounds pat_eq val inner_t = fold (fn (_, T) => fn t => HOLogic.exists_const T $ absdummy T t) (rev bound_vs) (fold (curry HOLogic.mk_conj) eqs' pat_eq') val lhs = Thm.term_of redex val rhs = HOLogic.mk_Collect ("x", rT, inner_t) val rewrite_rule_t = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)) in SOME ((Goal.prove ctxt [] [] rewrite_rule_t (fn {context = ctxt', ...} => tac ctxt' (rev Tis))) RS @{thm eq_reflection}) end)) in make_inner_eqs [] [] [] (dest_set (Thm.term_of redex)) end end end \ simproc_setup list_to_set_comprehension ("set xs") = \K List_to_Set_Comprehension.simproc\ code_datatype set coset hide_const (open) coset subsubsection \\<^const>\Nil\ and \<^const>\Cons\\ lemma not_Cons_self [simp]: "xs \ x # xs" by (induct xs) auto lemma not_Cons_self2 [simp]: "x # xs \ xs" by (rule not_Cons_self [symmetric]) lemma neq_Nil_conv: "(xs \ []) = (\y ys. xs = y # ys)" by (induct xs) auto lemma tl_Nil: "tl xs = [] \ xs = [] \ (\x. xs = [x])" by (cases xs) auto lemma Nil_tl: "[] = tl xs \ xs = [] \ (\x. xs = [x])" by (cases xs) auto lemma length_induct: "(\xs. \ys. length ys < length xs \ P ys \ P xs) \ P xs" by (fact measure_induct) lemma induct_list012: "\P []; \x. P [x]; \x y zs. \ P zs; P (y # zs) \ \ P (x # y # zs)\ \ P xs" by induction_schema (pat_completeness, lexicographic_order) lemma list_nonempty_induct [consumes 1, case_names single cons]: "\ xs \ []; \x. P [x]; \x xs. xs \ [] \ P xs \ P (x # xs)\ \ P xs" by(induction xs rule: induct_list012) auto lemma inj_split_Cons: "inj_on (\(xs, n). n#xs) X" by (auto intro!: inj_onI) lemma inj_on_Cons1 [simp]: "inj_on ((#) x) A" by(simp add: inj_on_def) subsubsection \\<^const>\length\\ text \ Needs to come before \@\ because of theorem \append_eq_append_conv\. \ lemma length_append [simp]: "length (xs @ ys) = length xs + length ys" by (induct xs) auto lemma length_map [simp]: "length (map f xs) = length xs" by (induct xs) auto lemma length_rev [simp]: "length (rev xs) = length xs" by (induct xs) auto lemma length_tl [simp]: "length (tl xs) = length xs - 1" by (cases xs) auto lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])" by (induct xs) auto lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \ [])" by (induct xs) auto lemma length_pos_if_in_set: "x \ set xs \ length xs > 0" by auto lemma length_Suc_conv: "(length xs = Suc n) = (\y ys. xs = y # ys \ length ys = n)" by (induct xs) auto lemma Suc_length_conv: "(Suc n = length xs) = (\y ys. xs = y # ys \ length ys = n)" by (induct xs; simp; blast) lemma Suc_le_length_iff: "(Suc n \ length xs) = (\x ys. xs = x # ys \ n \ length ys)" by (metis Suc_le_D[of n] Suc_le_mono[of n] Suc_length_conv[of _ xs]) lemma impossible_Cons: "length xs \ length ys \ xs = x # ys = False" by (induct xs) auto lemma list_induct2 [consumes 1, case_names Nil Cons]: "length xs = length ys \ P [] [] \ (\x xs y ys. length xs = length ys \ P xs ys \ P (x#xs) (y#ys)) \ P xs ys" proof (induct xs arbitrary: ys) case (Cons x xs ys) then show ?case by (cases ys) simp_all qed simp lemma list_induct3 [consumes 2, case_names Nil Cons]: "length xs = length ys \ length ys = length zs \ P [] [] [] \ (\x xs y ys z zs. length xs = length ys \ length ys = length zs \ P xs ys zs \ P (x#xs) (y#ys) (z#zs)) \ P xs ys zs" proof (induct xs arbitrary: ys zs) case Nil then show ?case by simp next case (Cons x xs ys zs) then show ?case by (cases ys, simp_all) (cases zs, simp_all) qed lemma list_induct4 [consumes 3, case_names Nil Cons]: "length xs = length ys \ length ys = length zs \ length zs = length ws \ P [] [] [] [] \ (\x xs y ys z zs w ws. length xs = length ys \ length ys = length zs \ length zs = length ws \ P xs ys zs ws \ P (x#xs) (y#ys) (z#zs) (w#ws)) \ P xs ys zs ws" proof (induct xs arbitrary: ys zs ws) case Nil then show ?case by simp next case (Cons x xs ys zs ws) then show ?case by ((cases ys, simp_all), (cases zs,simp_all)) (cases ws, simp_all) qed lemma list_induct2': "\ P [] []; \x xs. P (x#xs) []; \y ys. P [] (y#ys); \x xs y ys. P xs ys \ P (x#xs) (y#ys) \ \ P xs ys" by (induct xs arbitrary: ys) (case_tac x, auto)+ lemma list_all2_iff: "list_all2 P xs ys \ length xs = length ys \ (\(x, y) \ set (zip xs ys). P x y)" by (induct xs ys rule: list_induct2') auto lemma neq_if_length_neq: "length xs \ length ys \ (xs = ys) == False" by (rule Eq_FalseI) auto subsubsection \\@\ -- append\ global_interpretation append: monoid append Nil proof fix xs ys zs :: "'a list" show "(xs @ ys) @ zs = xs @ (ys @ zs)" by (induct xs) simp_all show "xs @ [] = xs" by (induct xs) simp_all qed simp lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)" by (fact append.assoc) lemma append_Nil2: "xs @ [] = xs" by (fact append.right_neutral) lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \ ys = [])" by (induct xs) auto lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \ ys = [])" by (induct xs) auto lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])" by (induct xs) auto lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])" by (induct xs) auto lemma append_eq_append_conv [simp]: "length xs = length ys \ length us = length vs \ (xs@us = ys@vs) = (xs=ys \ us=vs)" by (induct xs arbitrary: ys; case_tac ys; force) lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) = (\us. xs = zs @ us \ us @ ys = ts \ xs @ us = zs \ ys = us @ ts)" proof (induct xs arbitrary: ys zs ts) case (Cons x xs) then show ?case by (cases zs) auto qed fastforce lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)" by simp lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \ x = y)" by simp lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)" by simp lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])" using append_same_eq [of _ _ "[]"] by auto lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])" using append_same_eq [of "[]"] by auto lemma hd_Cons_tl: "xs \ [] \ hd xs # tl xs = xs" by (fact list.collapse) lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)" by (induct xs) auto lemma hd_append2 [simp]: "xs \ [] \ hd (xs @ ys) = hd xs" by (simp add: hd_append split: list.split) lemma tl_append: "tl (xs @ ys) = (case xs of [] \ tl ys | z#zs \ zs @ ys)" by (simp split: list.split) lemma tl_append2 [simp]: "xs \ [] \ tl (xs @ ys) = tl xs @ ys" by (simp add: tl_append split: list.split) lemma Cons_eq_append_conv: "x#xs = ys@zs = (ys = [] \ x#xs = zs \ (\ys'. x#ys' = ys \ xs = ys'@zs))" by(cases ys) auto lemma append_eq_Cons_conv: "(ys@zs = x#xs) = (ys = [] \ zs = x#xs \ (\ys'. ys = x#ys' \ ys'@zs = xs))" by(cases ys) auto lemma longest_common_prefix: "\ps xs' ys'. xs = ps @ xs' \ ys = ps @ ys' \ (xs' = [] \ ys' = [] \ hd xs' \ hd ys')" by (induct xs ys rule: list_induct2') (blast, blast, blast, metis (no_types, hide_lams) append_Cons append_Nil list.sel(1)) text \Trivial rules for solving \@\-equations automatically.\ lemma eq_Nil_appendI: "xs = ys \ xs = [] @ ys" by simp lemma Cons_eq_appendI: "\x # xs1 = ys; xs = xs1 @ zs\ \ x # xs = ys @ zs" by auto lemma append_eq_appendI: "\xs @ xs1 = zs; ys = xs1 @ us\ \ xs @ ys = zs @ us" by auto text \ Simplification procedure for all list equalities. Currently only tries to rearrange \@\ to see if - both lists end in a singleton list, - or both lists end in the same list. \ simproc_setup list_eq ("(xs::'a list) = ys") = \ let fun last (cons as Const (\<^const_name>\Cons\, _) $ _ $ xs) = (case xs of Const (\<^const_name>\Nil\, _) => cons | _ => last xs) | last (Const(\<^const_name>\append\,_) $ _ $ ys) = last ys | last t = t; fun list1 (Const(\<^const_name>\Cons\,_) $ _ $ Const(\<^const_name>\Nil\,_)) = true | list1 _ = false; fun butlast ((cons as Const(\<^const_name>\Cons\,_) $ x) $ xs) = (case xs of Const (\<^const_name>\Nil\, _) => xs | _ => cons $ butlast xs) | butlast ((app as Const (\<^const_name>\append\, _) $ xs) $ ys) = app $ butlast ys | butlast xs = Const(\<^const_name>\Nil\, fastype_of xs); val rearr_ss = simpset_of (put_simpset HOL_basic_ss \<^context> addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]); fun list_eq ctxt (F as (eq as Const(_,eqT)) $ lhs $ rhs) = let val lastl = last lhs and lastr = last rhs; fun rearr conv = let val lhs1 = butlast lhs and rhs1 = butlast rhs; val Type(_,listT::_) = eqT val appT = [listT,listT] ---> listT val app = Const(\<^const_name>\append\,appT) val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr) val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2)); val thm = Goal.prove ctxt [] [] eq (K (simp_tac (put_simpset rearr_ss ctxt) 1)); in SOME ((conv RS (thm RS trans)) RS eq_reflection) end; in if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv} else if lastl aconv lastr then rearr @{thm append_same_eq} else NONE end; in fn _ => fn ctxt => fn ct => list_eq ctxt (Thm.term_of ct) end \ subsubsection \\<^const>\map\\ lemma hd_map: "xs \ [] \ hd (map f xs) = f (hd xs)" by (cases xs) simp_all lemma map_tl: "map f (tl xs) = tl (map f xs)" by (cases xs) simp_all lemma map_ext: "(\x. x \ set xs \ f x = g x) \ map f xs = map g xs" by (induct xs) simp_all lemma map_ident [simp]: "map (\x. x) = (\xs. xs)" by (rule ext, induct_tac xs) auto lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys" by (induct xs) auto lemma map_map [simp]: "map f (map g xs) = map (f \ g) xs" by (induct xs) auto lemma map_comp_map[simp]: "((map f) \ (map g)) = map(f \ g)" by (rule ext) simp lemma rev_map: "rev (map f xs) = map f (rev xs)" by (induct xs) auto lemma map_eq_conv[simp]: "(map f xs = map g xs) = (\x \ set xs. f x = g x)" by (induct xs) auto lemma map_cong [fundef_cong]: "xs = ys \ (\x. x \ set ys \ f x = g x) \ map f xs = map g ys" by simp lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])" by (cases xs) auto lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])" by (cases xs) auto lemma map_eq_Cons_conv: "(map f xs = y#ys) = (\z zs. xs = z#zs \ f z = y \ map f zs = ys)" by (cases xs) auto lemma Cons_eq_map_conv: "(x#xs = map f ys) = (\z zs. ys = z#zs \ x = f z \ xs = map f zs)" by (cases ys) auto lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1] lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1] declare map_eq_Cons_D [dest!] Cons_eq_map_D [dest!] lemma ex_map_conv: "(\xs. ys = map f xs) = (\y \ set ys. \x. y = f x)" by(induct ys, auto simp add: Cons_eq_map_conv) lemma map_eq_imp_length_eq: assumes "map f xs = map g ys" shows "length xs = length ys" using assms proof (induct ys arbitrary: xs) case Nil then show ?case by simp next case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto from Cons xs have "map f zs = map g ys" by simp with Cons have "length zs = length ys" by blast with xs show ?case by simp qed lemma map_inj_on: assumes map: "map f xs = map f ys" and inj: "inj_on f (set xs Un set ys)" shows "xs = ys" using map_eq_imp_length_eq [OF map] assms proof (induct rule: list_induct2) case (Cons x xs y ys) then show ?case by (auto intro: sym) qed auto lemma inj_on_map_eq_map: "inj_on f (set xs Un set ys) \ (map f xs = map f ys) = (xs = ys)" by(blast dest:map_inj_on) lemma map_injective: "map f xs = map f ys \ inj f \ xs = ys" by (induct ys arbitrary: xs) (auto dest!:injD) lemma inj_map_eq_map[simp]: "inj f \ (map f xs = map f ys) = (xs = ys)" by(blast dest:map_injective) lemma inj_mapI: "inj f \ inj (map f)" by (iprover dest: map_injective injD intro: inj_onI) lemma inj_mapD: "inj (map f) \ inj f" by (metis (no_types, hide_lams) injI list.inject list.simps(9) the_inv_f_f) lemma inj_map[iff]: "inj (map f) = inj f" by (blast dest: inj_mapD intro: inj_mapI) lemma inj_on_mapI: "inj_on f (\(set ` A)) \ inj_on (map f) A" by (blast intro:inj_onI dest:inj_onD map_inj_on) lemma map_idI: "(\x. x \ set xs \ f x = x) \ map f xs = xs" by (induct xs, auto) lemma map_fun_upd [simp]: "y \ set xs \ map (f(y:=v)) xs = map f xs" by (induct xs) auto lemma map_fst_zip[simp]: "length xs = length ys \ map fst (zip xs ys) = xs" by (induct rule:list_induct2, simp_all) lemma map_snd_zip[simp]: "length xs = length ys \ map snd (zip xs ys) = ys" by (induct rule:list_induct2, simp_all) lemma map_fst_zip_take: "map fst (zip xs ys) = take (min (length xs) (length ys)) xs" by (induct xs ys rule: list_induct2') simp_all lemma map_snd_zip_take: "map snd (zip xs ys) = take (min (length xs) (length ys)) ys" by (induct xs ys rule: list_induct2') simp_all lemma map2_map_map: "map2 h (map f xs) (map g xs) = map (\x. h (f x) (g x)) xs" by (induction xs) (auto) functor map: map by (simp_all add: id_def) declare map.id [simp] subsubsection \\<^const>\rev\\ lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs" by (induct xs) auto lemma rev_rev_ident [simp]: "rev (rev xs) = xs" by (induct xs) auto lemma rev_swap: "(rev xs = ys) = (xs = rev ys)" by auto lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])" by (induct xs) auto lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])" by (induct xs) auto lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])" by (cases xs) auto lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])" by (cases xs) auto lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)" proof (induct xs arbitrary: ys) case Nil then show ?case by force next case Cons then show ?case by (cases ys) auto qed lemma inj_on_rev[iff]: "inj_on rev A" by(simp add:inj_on_def) lemma rev_induct [case_names Nil snoc]: assumes "P []" and "\x xs. P xs \ P (xs @ [x])" shows "P xs" proof - have "P (rev (rev xs))" by (rule_tac list = "rev xs" in list.induct, simp_all add: assms) then show ?thesis by simp qed lemma rev_exhaust [case_names Nil snoc]: "(xs = [] \ P) \(\ys y. xs = ys @ [y] \ P) \ P" by (induct xs rule: rev_induct) auto lemmas rev_cases = rev_exhaust lemma rev_nonempty_induct [consumes 1, case_names single snoc]: assumes "xs \ []" and single: "\x. P [x]" and snoc': "\x xs. xs \ [] \ P xs \ P (xs@[x])" shows "P xs" using \xs \ []\ proof (induct xs rule: rev_induct) case (snoc x xs) then show ?case proof (cases xs) case Nil thus ?thesis by (simp add: single) next case Cons with snoc show ?thesis by (fastforce intro!: snoc') qed qed simp lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])" by(rule rev_cases[of xs]) auto subsubsection \\<^const>\set\\ declare list.set[code_post] \ \pretty output\ lemma finite_set [iff]: "finite (set xs)" by (induct xs) auto lemma set_append [simp]: "set (xs @ ys) = (set xs \ set ys)" by (induct xs) auto lemma hd_in_set[simp]: "xs \ [] \ hd xs \ set xs" by(cases xs) auto lemma set_subset_Cons: "set xs \ set (x # xs)" by auto lemma set_ConsD: "y \ set (x # xs) \ y=x \ y \ set xs" by auto lemma set_empty [iff]: "(set xs = {}) = (xs = [])" by (induct xs) auto lemma set_empty2[iff]: "({} = set xs) = (xs = [])" by(induct xs) auto lemma set_rev [simp]: "set (rev xs) = set xs" by (induct xs) auto lemma set_map [simp]: "set (map f xs) = f`(set xs)" by (induct xs) auto lemma set_filter [simp]: "set (filter P xs) = {x. x \ set xs \ P x}" by (induct xs) auto lemma set_upt [simp]: "set[i.. set xs \ \ys zs. xs = ys @ x # zs" proof (induct xs) case Nil thus ?case by simp next case Cons thus ?case by (auto intro: Cons_eq_appendI) qed lemma in_set_conv_decomp: "x \ set xs \ (\ys zs. xs = ys @ x # zs)" by (auto elim: split_list) lemma split_list_first: "x \ set xs \ \ys zs. xs = ys @ x # zs \ x \ set ys" proof (induct xs) case Nil thus ?case by simp next case (Cons a xs) show ?case proof cases assume "x = a" thus ?case using Cons by fastforce next assume "x \ a" thus ?case using Cons by(fastforce intro!: Cons_eq_appendI) qed qed lemma in_set_conv_decomp_first: "(x \ set xs) = (\ys zs. xs = ys @ x # zs \ x \ set ys)" by (auto dest!: split_list_first) lemma split_list_last: "x \ set xs \ \ys zs. xs = ys @ x # zs \ x \ set zs" proof (induct xs rule: rev_induct) case Nil thus ?case by simp next case (snoc a xs) show ?case proof cases assume "x = a" thus ?case using snoc by (auto intro!: exI) next assume "x \ a" thus ?case using snoc by fastforce qed qed lemma in_set_conv_decomp_last: "(x \ set xs) = (\ys zs. xs = ys @ x # zs \ x \ set zs)" by (auto dest!: split_list_last) lemma split_list_prop: "\x \ set xs. P x \ \ys x zs. xs = ys @ x # zs \ P x" proof (induct xs) case Nil thus ?case by simp next case Cons thus ?case by(simp add:Bex_def)(metis append_Cons append.simps(1)) qed lemma split_list_propE: assumes "\x \ set xs. P x" obtains ys x zs where "xs = ys @ x # zs" and "P x" using split_list_prop [OF assms] by blast lemma split_list_first_prop: "\x \ set xs. P x \ \ys x zs. xs = ys@x#zs \ P x \ (\y \ set ys. \ P y)" proof (induct xs) case Nil thus ?case by simp next case (Cons x xs) show ?case proof cases assume "P x" hence "x # xs = [] @ x # xs \ P x \ (\y\set []. \ P y)" by simp thus ?thesis by fast next assume "\ P x" hence "\x\set xs. P x" using Cons(2) by simp thus ?thesis using \\ P x\ Cons(1) by (metis append_Cons set_ConsD) qed qed lemma split_list_first_propE: assumes "\x \ set xs. P x" obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\y \ set ys. \ P y" using split_list_first_prop [OF assms] by blast lemma split_list_first_prop_iff: "(\x \ set xs. P x) \ (\ys x zs. xs = ys@x#zs \ P x \ (\y \ set ys. \ P y))" by (rule, erule split_list_first_prop) auto lemma split_list_last_prop: "\x \ set xs. P x \ \ys x zs. xs = ys@x#zs \ P x \ (\z \ set zs. \ P z)" proof(induct xs rule:rev_induct) case Nil thus ?case by simp next case (snoc x xs) show ?case proof cases assume "P x" thus ?thesis by (auto intro!: exI) next assume "\ P x" hence "\x\set xs. P x" using snoc(2) by simp thus ?thesis using \\ P x\ snoc(1) by fastforce qed qed lemma split_list_last_propE: assumes "\x \ set xs. P x" obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\z \ set zs. \ P z" using split_list_last_prop [OF assms] by blast lemma split_list_last_prop_iff: "(\x \ set xs. P x) \ (\ys x zs. xs = ys@x#zs \ P x \ (\z \ set zs. \ P z))" by rule (erule split_list_last_prop, auto) lemma finite_list: "finite A \ \xs. set xs = A" by (erule finite_induct) (auto simp add: list.set(2)[symmetric] simp del: list.set(2)) lemma card_length: "card (set xs) \ length xs" by (induct xs) (auto simp add: card_insert_if) lemma set_minus_filter_out: "set xs - {y} = set (filter (\x. \ (x = y)) xs)" by (induct xs) auto lemma append_Cons_eq_iff: "\ x \ set xs; x \ set ys \ \ xs @ x # ys = xs' @ x # ys' \ (xs = xs' \ ys = ys')" by(auto simp: append_eq_Cons_conv Cons_eq_append_conv append_eq_append_conv2) subsubsection \\<^const>\concat\\ lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys" by (induct xs) auto lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\xs \ set xss. xs = [])" by (induct xss) auto lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\xs \ set xss. xs = [])" by (induct xss) auto lemma set_concat [simp]: "set (concat xs) = (\x\set xs. set x)" by (induct xs) auto lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs" by (induct xs) auto lemma map_concat: "map f (concat xs) = concat (map (map f) xs)" by (induct xs) auto lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))" by (induct xs) auto lemma length_concat_rev[simp]: "length (concat (rev xs)) = length (concat xs)" by (induction xs) auto lemma concat_eq_concat_iff: "\(x, y) \ set (zip xs ys). length x = length y \ length xs = length ys \ (concat xs = concat ys) = (xs = ys)" proof (induct xs arbitrary: ys) case (Cons x xs ys) thus ?case by (cases ys) auto qed (auto) lemma concat_injective: "concat xs = concat ys \ length xs = length ys \ \(x, y) \ set (zip xs ys). length x = length y \ xs = ys" by (simp add: concat_eq_concat_iff) lemma concat_eq_appendD: assumes "concat xss = ys @ zs" "xss \ []" shows "\xss1 xs xs' xss2. xss = xss1 @ (xs @ xs') # xss2 \ ys = concat xss1 @ xs \ zs = xs' @ concat xss2" using assms proof(induction xss arbitrary: ys) case (Cons xs xss) from Cons.prems consider us where "xs @ us = ys" "concat xss = us @ zs" | us where "xs = ys @ us" "us @ concat xss = zs" by(auto simp add: append_eq_append_conv2) then show ?case proof cases case 1 then show ?thesis using Cons.IH[OF 1(2)] by(cases xss)(auto intro: exI[where x="[]"], metis append.assoc append_Cons concat.simps(2)) qed(auto intro: exI[where x="[]"]) qed simp lemma concat_eq_append_conv: "concat xss = ys @ zs \ (if xss = [] then ys = [] \ zs = [] else \xss1 xs xs' xss2. xss = xss1 @ (xs @ xs') # xss2 \ ys = concat xss1 @ xs \ zs = xs' @ concat xss2)" by(auto dest: concat_eq_appendD) lemma hd_concat: "\xs \ []; hd xs \ []\ \ hd (concat xs) = hd (hd xs)" by (metis concat.simps(2) hd_Cons_tl hd_append2) simproc_setup list_neq ("(xs::'a list) = ys") = \ (* Reduces xs=ys to False if xs and ys cannot be of the same length. This is the case if the atomic sublists of one are a submultiset of those of the other list and there are fewer Cons's in one than the other. *) let fun len (Const(\<^const_name>\Nil\,_)) acc = acc | len (Const(\<^const_name>\Cons\,_) $ _ $ xs) (ts,n) = len xs (ts,n+1) | len (Const(\<^const_name>\append\,_) $ xs $ ys) acc = len xs (len ys acc) | len (Const(\<^const_name>\rev\,_) $ xs) acc = len xs acc | len (Const(\<^const_name>\map\,_) $ _ $ xs) acc = len xs acc | len (Const(\<^const_name>\concat\,T) $ (Const(\<^const_name>\rev\,_) $ xss)) acc = len (Const(\<^const_name>\concat\,T) $ xss) acc | len t (ts,n) = (t::ts,n); val ss = simpset_of \<^context>; fun list_neq ctxt ct = let val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct; val (ls,m) = len lhs ([],0) and (rs,n) = len rhs ([],0); fun prove_neq() = let val Type(_,listT::_) = eqT; val size = HOLogic.size_const listT; val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs); val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len); val thm = Goal.prove ctxt [] [] neq_len (K (simp_tac (put_simpset ss ctxt) 1)); in SOME (thm RS @{thm neq_if_length_neq}) end in if m < n andalso submultiset (op aconv) (ls,rs) orelse n < m andalso submultiset (op aconv) (rs,ls) then prove_neq() else NONE end; in K list_neq end \ subsubsection \\<^const>\filter\\ lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys" by (induct xs) auto lemma rev_filter: "rev (filter P xs) = filter P (rev xs)" by (induct xs) simp_all lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\x. Q x \ P x) xs" by (induct xs) auto lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)" by (induct xs) auto lemma length_filter_le [simp]: "length (filter P xs) \ length xs" by (induct xs) (auto simp add: le_SucI) lemma sum_length_filter_compl: "length(filter P xs) + length(filter (\x. \P x) xs) = length xs" by(induct xs) simp_all lemma filter_True [simp]: "\x \ set xs. P x \ filter P xs = xs" by (induct xs) auto lemma filter_False [simp]: "\x \ set xs. \ P x \ filter P xs = []" by (induct xs) auto lemma filter_empty_conv: "(filter P xs = []) = (\x\set xs. \ P x)" by (induct xs) simp_all lemma filter_id_conv: "(filter P xs = xs) = (\x\set xs. P x)" proof (induct xs) case (Cons x xs) then show ?case using length_filter_le by (simp add: impossible_Cons) qed auto lemma filter_map: "filter P (map f xs) = map f (filter (P \ f) xs)" by (induct xs) simp_all lemma length_filter_map[simp]: "length (filter P (map f xs)) = length(filter (P \ f) xs)" by (simp add:filter_map) lemma filter_is_subset [simp]: "set (filter P xs) \ set xs" by auto lemma length_filter_less: "\ x \ set xs; \ P x \ \ length(filter P xs) < length xs" proof (induct xs) case Nil thus ?case by simp next case (Cons x xs) thus ?case using Suc_le_eq by fastforce qed lemma length_filter_conv_card: "length(filter p xs) = card{i. i < length xs \ p(xs!i)}" proof (induct xs) case Nil thus ?case by simp next case (Cons x xs) let ?S = "{i. i < length xs \ p(xs!i)}" have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite) show ?case (is "?l = card ?S'") proof (cases) assume "p x" hence eq: "?S' = insert 0 (Suc ` ?S)" by(auto simp: image_def split:nat.split dest:gr0_implies_Suc) have "length (filter p (x # xs)) = Suc(card ?S)" using Cons \p x\ by simp also have "\ = Suc(card(Suc ` ?S))" using fin by (simp add: card_image) also have "\ = card ?S'" using eq fin by (simp add:card_insert_if) finally show ?thesis . next assume "\ p x" hence eq: "?S' = Suc ` ?S" by(auto simp add: image_def split:nat.split elim:lessE) have "length (filter p (x # xs)) = card ?S" using Cons \\ p x\ by simp also have "\ = card(Suc ` ?S)" using fin by (simp add: card_image) also have "\ = card ?S'" using eq fin by (simp add:card_insert_if) finally show ?thesis . qed qed lemma Cons_eq_filterD: "x#xs = filter P ys \ \us vs. ys = us @ x # vs \ (\u\set us. \ P u) \ P x \ xs = filter P vs" (is "_ \ \us vs. ?P ys us vs") proof(induct ys) case Nil thus ?case by simp next case (Cons y ys) show ?case (is "\x. ?Q x") proof cases assume Py: "P y" show ?thesis proof cases assume "x = y" with Py Cons.prems have "?Q []" by simp then show ?thesis .. next assume "x \ y" with Py Cons.prems show ?thesis by simp qed next assume "\ P y" with Cons obtain us vs where "?P (y#ys) (y#us) vs" by fastforce then have "?Q (y#us)" by simp then show ?thesis .. qed qed lemma filter_eq_ConsD: "filter P ys = x#xs \ \us vs. ys = us @ x # vs \ (\u\set us. \ P u) \ P x \ xs = filter P vs" by(rule Cons_eq_filterD) simp lemma filter_eq_Cons_iff: "(filter P ys = x#xs) = (\us vs. ys = us @ x # vs \ (\u\set us. \ P u) \ P x \ xs = filter P vs)" by(auto dest:filter_eq_ConsD) lemma Cons_eq_filter_iff: "(x#xs = filter P ys) = (\us vs. ys = us @ x # vs \ (\u\set us. \ P u) \ P x \ xs = filter P vs)" by(auto dest:Cons_eq_filterD) lemma inj_on_filter_key_eq: assumes "inj_on f (insert y (set xs))" shows "filter (\x. f y = f x) xs = filter (HOL.eq y) xs" using assms by (induct xs) auto lemma filter_cong[fundef_cong]: "xs = ys \ (\x. x \ set ys \ P x = Q x) \ filter P xs = filter Q ys" by (induct ys arbitrary: xs) auto subsubsection \List partitioning\ primrec partition :: "('a \ bool) \'a list \ 'a list \ 'a list" where "partition P [] = ([], [])" | "partition P (x # xs) = (let (yes, no) = partition P xs in if P x then (x # yes, no) else (yes, x # no))" lemma partition_filter1: "fst (partition P xs) = filter P xs" by (induct xs) (auto simp add: Let_def split_def) lemma partition_filter2: "snd (partition P xs) = filter (Not \ P) xs" by (induct xs) (auto simp add: Let_def split_def) lemma partition_P: assumes "partition P xs = (yes, no)" shows "(\p \ set yes. P p) \ (\p \ set no. \ P p)" proof - from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)" by simp_all then show ?thesis by (simp_all add: partition_filter1 partition_filter2) qed lemma partition_set: assumes "partition P xs = (yes, no)" shows "set yes \ set no = set xs" proof - from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)" by simp_all then show ?thesis by (auto simp add: partition_filter1 partition_filter2) qed lemma partition_filter_conv[simp]: "partition f xs = (filter f xs,filter (Not \ f) xs)" unfolding partition_filter2[symmetric] unfolding partition_filter1[symmetric] by simp declare partition.simps[simp del] subsubsection \\<^const>\nth\\ lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x" by auto lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n" by auto declare nth.simps [simp del] lemma nth_Cons_pos[simp]: "0 < n \ (x#xs) ! n = xs ! (n - 1)" by(auto simp: Nat.gr0_conv_Suc) lemma nth_append: "(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))" proof (induct xs arbitrary: n) case (Cons x xs) then show ?case using less_Suc_eq_0_disj by auto qed simp lemma nth_append_length [simp]: "(xs @ x # ys) ! length xs = x" by (induct xs) auto lemma nth_append_length_plus[simp]: "(xs @ ys) ! (length xs + n) = ys ! n" by (induct xs) auto lemma nth_map [simp]: "n < length xs \ (map f xs)!n = f(xs!n)" proof (induct xs arbitrary: n) case (Cons x xs) then show ?case using less_Suc_eq_0_disj by auto qed simp lemma nth_tl: "n < length (tl xs) \ tl xs ! n = xs ! Suc n" by (induction xs) auto lemma hd_conv_nth: "xs \ [] \ hd xs = xs!0" by(cases xs) simp_all lemma list_eq_iff_nth_eq: "(xs = ys) = (length xs = length ys \ (\i ?R" by force show "?R \ ?L" using less_Suc_eq_0_disj by auto qed with Cons show ?case by simp qed simp lemma in_set_conv_nth: "(x \ set xs) = (\i < length xs. xs!i = x)" by(auto simp:set_conv_nth) lemma nth_equal_first_eq: assumes "x \ set xs" assumes "n \ length xs" shows "(x # xs) ! n = x \ n = 0" (is "?lhs \ ?rhs") proof assume ?lhs show ?rhs proof (rule ccontr) assume "n \ 0" then have "n > 0" by simp with \?lhs\ have "xs ! (n - 1) = x" by simp moreover from \n > 0\ \n \ length xs\ have "n - 1 < length xs" by simp ultimately have "\ix \ set xs\ in_set_conv_nth [of x xs] show False by simp qed next assume ?rhs then show ?lhs by simp qed lemma nth_non_equal_first_eq: assumes "x \ y" shows "(x # xs) ! n = y \ xs ! (n - 1) = y \ n > 0" (is "?lhs \ ?rhs") proof assume "?lhs" with assms have "n > 0" by (cases n) simp_all with \?lhs\ show ?rhs by simp next assume "?rhs" then show "?lhs" by simp qed lemma list_ball_nth: "\n < length xs; \x \ set xs. P x\ \ P(xs!n)" by (auto simp add: set_conv_nth) lemma nth_mem [simp]: "n < length xs \ xs!n \ set xs" by (auto simp add: set_conv_nth) lemma all_nth_imp_all_set: "\\i < length xs. P(xs!i); x \ set xs\ \ P x" by (auto simp add: set_conv_nth) lemma all_set_conv_all_nth: "(\x \ set xs. P x) = (\i. i < length xs \ P (xs ! i))" by (auto simp add: set_conv_nth) lemma rev_nth: "n < size xs \ rev xs ! n = xs ! (length xs - Suc n)" proof (induct xs arbitrary: n) case Nil thus ?case by simp next case (Cons x xs) hence n: "n < Suc (length xs)" by simp moreover { assume "n < length xs" with n obtain n' where n': "length xs - n = Suc n'" by (cases "length xs - n", auto) moreover from n' have "length xs - Suc n = n'" by simp ultimately have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp } ultimately show ?case by (clarsimp simp add: Cons nth_append) qed lemma Skolem_list_nth: "(\ix. P i x) = (\xs. size xs = k \ (\ixs. ?P k xs)") proof(induct k) case 0 show ?case by simp next case (Suc k) show ?case (is "?L = ?R" is "_ = (\xs. ?P' xs)") proof assume "?R" thus "?L" using Suc by auto next assume "?L" with Suc obtain x xs where "?P k xs \ P k x" by (metis less_Suc_eq) hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq) thus "?R" .. qed qed subsubsection \\<^const>\list_update\\ lemma length_list_update [simp]: "length(xs[i:=x]) = length xs" by (induct xs arbitrary: i) (auto split: nat.split) lemma nth_list_update: "i < length xs\ (xs[i:=x])!j = (if i = j then x else xs!j)" by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) lemma nth_list_update_eq [simp]: "i < length xs \ (xs[i:=x])!i = x" by (simp add: nth_list_update) lemma nth_list_update_neq [simp]: "i \ j \ xs[i:=x]!j = xs!j" by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split) lemma list_update_id[simp]: "xs[i := xs!i] = xs" by (induct xs arbitrary: i) (simp_all split:nat.splits) lemma list_update_beyond[simp]: "length xs \ i \ xs[i:=x] = xs" proof (induct xs arbitrary: i) case (Cons x xs i) then show ?case by (metis leD length_list_update list_eq_iff_nth_eq nth_list_update_neq) qed simp lemma list_update_nonempty[simp]: "xs[k:=x] = [] \ xs=[]" by (simp only: length_0_conv[symmetric] length_list_update) lemma list_update_same_conv: "i < length xs \ (xs[i := x] = xs) = (xs!i = x)" by (induct xs arbitrary: i) (auto split: nat.split) lemma list_update_append1: "i < size xs \ (xs @ ys)[i:=x] = xs[i:=x] @ ys" by (induct xs arbitrary: i)(auto split:nat.split) lemma list_update_append: "(xs @ ys) [n:= x] = (if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))" by (induct xs arbitrary: n) (auto split:nat.splits) lemma list_update_length [simp]: "(xs @ x # ys)[length xs := y] = (xs @ y # ys)" by (induct xs, auto) lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]" by(induct xs arbitrary: k)(auto split:nat.splits) lemma rev_update: "k < length xs \ rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]" by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits) lemma update_zip: "(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])" by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split) lemma set_update_subset_insert: "set(xs[i:=x]) \ insert x (set xs)" by (induct xs arbitrary: i) (auto split: nat.split) lemma set_update_subsetI: "\set xs \ A; x \ A\ \ set(xs[i := x]) \ A" by (blast dest!: set_update_subset_insert [THEN subsetD]) lemma set_update_memI: "n < length xs \ x \ set (xs[n := x])" by (induct xs arbitrary: n) (auto split:nat.splits) lemma list_update_overwrite[simp]: "xs [i := x, i := y] = xs [i := y]" by (induct xs arbitrary: i) (simp_all split: nat.split) lemma list_update_swap: "i \ i' \ xs [i := x, i' := x'] = xs [i' := x', i := x]" by (induct xs arbitrary: i i') (simp_all split: nat.split) lemma list_update_code [code]: "[][i := y] = []" "(x # xs)[0 := y] = y # xs" "(x # xs)[Suc i := y] = x # xs[i := y]" by simp_all subsubsection \\<^const>\last\ and \<^const>\butlast\\ lemma last_snoc [simp]: "last (xs @ [x]) = x" by (induct xs) auto lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs" by (induct xs) auto lemma last_ConsL: "xs = [] \ last(x#xs) = x" by simp lemma last_ConsR: "xs \ [] \ last(x#xs) = last xs" by simp lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)" by (induct xs) (auto) lemma last_appendL[simp]: "ys = [] \ last(xs @ ys) = last xs" by(simp add:last_append) lemma last_appendR[simp]: "ys \ [] \ last(xs @ ys) = last ys" by(simp add:last_append) lemma last_tl: "xs = [] \ tl xs \ [] \last (tl xs) = last xs" by (induct xs) simp_all lemma butlast_tl: "butlast (tl xs) = tl (butlast xs)" by (induct xs) simp_all lemma hd_rev: "xs \ [] \ hd(rev xs) = last xs" by(rule rev_exhaust[of xs]) simp_all lemma last_rev: "xs \ [] \ last(rev xs) = hd xs" by(cases xs) simp_all lemma last_in_set[simp]: "as \ [] \ last as \ set as" by (induct as) auto lemma length_butlast [simp]: "length (butlast xs) = length xs - 1" by (induct xs rule: rev_induct) auto lemma butlast_append: "butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)" by (induct xs arbitrary: ys) auto lemma append_butlast_last_id [simp]: "xs \ [] \ butlast xs @ [last xs] = xs" by (induct xs) auto lemma in_set_butlastD: "x \ set (butlast xs) \ x \ set xs" by (induct xs) (auto split: if_split_asm) lemma in_set_butlast_appendI: "x \ set (butlast xs) \ x \ set (butlast ys) \ x \ set (butlast (xs @ ys))" by (auto dest: in_set_butlastD simp add: butlast_append) lemma last_drop[simp]: "n < length xs \ last (drop n xs) = last xs" by (induct xs arbitrary: n)(auto split:nat.split) lemma nth_butlast: assumes "n < length (butlast xs)" shows "butlast xs ! n = xs ! n" proof (cases xs) case (Cons y ys) moreover from assms have "butlast xs ! n = (butlast xs @ [last xs]) ! n" by (simp add: nth_append) ultimately show ?thesis using append_butlast_last_id by simp qed simp lemma last_conv_nth: "xs\[] \ last xs = xs!(length xs - 1)" by(induct xs)(auto simp:neq_Nil_conv) lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs" by (induction xs rule: induct_list012) simp_all lemma last_list_update: "xs \ [] \ last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)" by (auto simp: last_conv_nth) lemma butlast_list_update: "butlast(xs[k:=x]) = (if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])" by(cases xs rule:rev_cases)(auto simp: list_update_append split: nat.splits) lemma last_map: "xs \ [] \ last (map f xs) = f (last xs)" by (cases xs rule: rev_cases) simp_all lemma map_butlast: "map f (butlast xs) = butlast (map f xs)" by (induct xs) simp_all lemma snoc_eq_iff_butlast: "xs @ [x] = ys \ (ys \ [] \ butlast ys = xs \ last ys = x)" by fastforce corollary longest_common_suffix: "\ss xs' ys'. xs = xs' @ ss \ ys = ys' @ ss \ (xs' = [] \ ys' = [] \ last xs' \ last ys')" using longest_common_prefix[of "rev xs" "rev ys"] unfolding rev_swap rev_append by (metis last_rev rev_is_Nil_conv) lemma butlast_rev [simp]: "butlast (rev xs) = rev (tl xs)" by (cases xs) simp_all subsubsection \\<^const>\take\ and \<^const>\drop\\ lemma take_0: "take 0 xs = []" by (induct xs) auto lemma drop_0: "drop 0 xs = xs" by (induct xs) auto lemma take0[simp]: "take 0 = (\xs. [])" by(rule ext) (rule take_0) lemma drop0[simp]: "drop 0 = (\x. x)" by(rule ext) (rule drop_0) lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" by simp lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs" by simp declare take_Cons [simp del] and drop_Cons [simp del] lemma take_Suc: "xs \ [] \ take (Suc n) xs = hd xs # take n (tl xs)" by(clarsimp simp add:neq_Nil_conv) lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" by(cases xs, simp_all) lemma hd_take[simp]: "j > 0 \ hd (take j xs) = hd xs" by (metis gr0_conv_Suc list.sel(1) take.simps(1) take_Suc) lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)" by (induct xs arbitrary: n) simp_all lemma drop_tl: "drop n (tl xs) = tl(drop n xs)" by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split) lemma tl_take: "tl (take n xs) = take (n - 1) (tl xs)" by (cases n, simp, cases xs, auto) lemma tl_drop: "tl (drop n xs) = drop n (tl xs)" by (simp only: drop_tl) lemma nth_via_drop: "drop n xs = y#ys \ xs!n = y" by (induct xs arbitrary: n, simp)(auto simp: drop_Cons nth_Cons split: nat.splits) lemma take_Suc_conv_app_nth: "i < length xs \ take (Suc i) xs = take i xs @ [xs!i]" proof (induct xs arbitrary: i) case Nil then show ?case by simp next case Cons then show ?case by (cases i) auto qed lemma Cons_nth_drop_Suc: "i < length xs \ (xs!i) # (drop (Suc i) xs) = drop i xs" proof (induct xs arbitrary: i) case Nil then show ?case by simp next case Cons then show ?case by (cases i) auto qed lemma length_take [simp]: "length (take n xs) = min (length xs) n" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma length_drop [simp]: "length (drop n xs) = (length xs - n)" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma take_all [simp]: "length xs \ n \ take n xs = xs" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma drop_all [simp]: "length xs \ n \ drop n xs = []" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma take_all_iff [simp]: "take n xs = xs \ length xs \ n" by (metis length_take min.order_iff take_all) lemma drop_all_iff [simp]: "drop n xs = [] \ length xs \ n" by (metis diff_is_0_eq drop_all length_drop list.size(3)) lemma take_append [simp]: "take n (xs @ ys) = (take n xs @ take (n - length xs) ys)" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma drop_append [simp]: "drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys" by (induct n arbitrary: xs) (auto, case_tac xs, auto) lemma take_take [simp]: "take n (take m xs) = take (min n m) xs" proof (induct m arbitrary: xs n) case 0 then show ?case by simp next case Suc then show ?case by (cases xs; cases n) simp_all qed lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs" proof (induct m arbitrary: xs) case 0 then show ?case by simp next case Suc then show ?case by (cases xs) simp_all qed lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)" proof (induct m arbitrary: xs n) case 0 then show ?case by simp next case Suc then show ?case by (cases xs; cases n) simp_all qed lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)" by(induct xs arbitrary: m n)(auto simp: take_Cons drop_Cons split: nat.split) lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs" proof (induct n arbitrary: xs) case 0 then show ?case by simp next case Suc then show ?case by (cases xs) simp_all qed lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \ xs = [])" by(induct xs arbitrary: n)(auto simp: take_Cons split:nat.split) lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs \ n)" by (induct xs arbitrary: n) (auto simp: drop_Cons split:nat.split) lemma take_map: "take n (map f xs) = map f (take n xs)" proof (induct n arbitrary: xs) case 0 then show ?case by simp next case Suc then show ?case by (cases xs) simp_all qed lemma drop_map: "drop n (map f xs) = map f (drop n xs)" proof (induct n arbitrary: xs) case 0 then show ?case by simp next case Suc then show ?case by (cases xs) simp_all qed lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)" proof (induct xs arbitrary: i) case Nil then show ?case by simp next case Cons then show ?case by (cases i) auto qed lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)" proof (induct xs arbitrary: i) case Nil then show ?case by simp next case Cons then show ?case by (cases i) auto qed lemma drop_rev: "drop n (rev xs) = rev (take (length xs - n) xs)" by (cases "length xs < n") (auto simp: rev_take) lemma take_rev: "take n (rev xs) = rev (drop (length xs - n) xs)" by (cases "length xs < n") (auto simp: rev_drop) lemma nth_take [simp]: "i < n \ (take n xs)!i = xs!i" proof (induct xs arbitrary: i n) case Nil then show ?case by simp next case Cons then show ?case by (cases n; cases i) simp_all qed lemma nth_drop [simp]: "n \ length xs \ (drop n xs)!i = xs!(n + i)" proof (induct n arbitrary: xs) case 0 then show ?case by simp next case Suc then show ?case by (cases xs) simp_all qed lemma butlast_take: "n \ length xs \ butlast (take n xs) = take (n - 1) xs" by (simp add: butlast_conv_take min.absorb1 min.absorb2) lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)" by (simp add: butlast_conv_take drop_take ac_simps) lemma take_butlast: "n < length xs \ take n (butlast xs) = take n xs" by (simp add: butlast_conv_take min.absorb1) lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)" by (simp add: butlast_conv_take drop_take ac_simps) lemma butlast_power: "(butlast ^^ n) xs = take (length xs - n) xs" by (induct n) (auto simp: butlast_take) lemma hd_drop_conv_nth: "n < length xs \ hd(drop n xs) = xs!n" by(simp add: hd_conv_nth) lemma set_take_subset_set_take: "m \ n \ set(take m xs) \ set(take n xs)" proof (induct xs arbitrary: m n) case (Cons x xs m n) then show ?case by (cases n) (auto simp: take_Cons) qed simp lemma set_take_subset: "set(take n xs) \ set xs" by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split) lemma set_drop_subset: "set(drop n xs) \ set xs" by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split) lemma set_drop_subset_set_drop: "m \ n \ set(drop m xs) \ set(drop n xs)" proof (induct xs arbitrary: m n) case (Cons x xs m n) then show ?case by (clarsimp simp: drop_Cons split: nat.split) (metis set_drop_subset subset_iff) qed simp lemma in_set_takeD: "x \ set(take n xs) \ x \ set xs" using set_take_subset by fast lemma in_set_dropD: "x \ set(drop n xs) \ x \ set xs" using set_drop_subset by fast lemma append_eq_conv_conj: "(xs @ ys = zs) = (xs = take (length xs) zs \ ys = drop (length xs) zs)" proof (induct xs arbitrary: zs) case (Cons x xs zs) then show ?case by (cases zs, auto) qed auto lemma map_eq_append_conv: "map f xs = ys @ zs \ (\us vs. xs = us @ vs \ ys = map f us \ zs = map f vs)" proof - have "map f xs \ ys @ zs \ map f xs \ ys @ zs \ map f xs \ ys @ zs \ map f xs = ys @ zs \ (\bs bsa. xs = bs @ bsa \ ys = map f bs \ zs = map f bsa)" by (metis append_eq_conv_conj append_take_drop_id drop_map take_map) then show ?thesis using map_append by blast qed lemma append_eq_map_conv: "ys @ zs = map f xs \ (\us vs. xs = us @ vs \ ys = map f us \ zs = map f vs)" by (metis map_eq_append_conv) lemma take_add: "take (i+j) xs = take i xs @ take j (drop i xs)" proof (induct xs arbitrary: i) case (Cons x xs i) then show ?case by (cases i, auto) qed auto lemma append_eq_append_conv_if: "(xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>1 @ ys\<^sub>2) = (if size xs\<^sub>1 \ size ys\<^sub>1 then xs\<^sub>1 = take (size xs\<^sub>1) ys\<^sub>1 \ xs\<^sub>2 = drop (size xs\<^sub>1) ys\<^sub>1 @ ys\<^sub>2 else take (size ys\<^sub>1) xs\<^sub>1 = ys\<^sub>1 \ drop (size ys\<^sub>1) xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>2)" proof (induct xs\<^sub>1 arbitrary: ys\<^sub>1) case (Cons a xs\<^sub>1 ys\<^sub>1) then show ?case by (cases ys\<^sub>1, auto) qed auto lemma take_hd_drop: "n < length xs \ take n xs @ [hd (drop n xs)] = take (Suc n) xs" by (induct xs arbitrary: n) (simp_all add:drop_Cons split:nat.split) lemma id_take_nth_drop: "i < length xs \ xs = take i xs @ xs!i # drop (Suc i) xs" proof - assume si: "i < length xs" hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto moreover from si have "take (Suc i) xs = take i xs @ [xs!i]" using take_Suc_conv_app_nth by blast ultimately show ?thesis by auto qed lemma take_update_cancel[simp]: "n \ m \ take n (xs[m := y]) = take n xs" by(simp add: list_eq_iff_nth_eq) lemma drop_update_cancel[simp]: "n < m \ drop m (xs[n := x]) = drop m xs" by(simp add: list_eq_iff_nth_eq) lemma upd_conv_take_nth_drop: "i < length xs \ xs[i:=a] = take i xs @ a # drop (Suc i) xs" proof - assume i: "i < length xs" have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]" by(rule arg_cong[OF id_take_nth_drop[OF i]]) also have "\ = take i xs @ a # drop (Suc i) xs" using i by (simp add: list_update_append) finally show ?thesis . qed lemma take_update_swap: "take m (xs[n := x]) = (take m xs)[n := x]" proof (cases "n \ length xs") case False then show ?thesis by (simp add: upd_conv_take_nth_drop take_Cons drop_take min_def diff_Suc split: nat.split) qed auto lemma drop_update_swap: assumes "m \ n" shows "drop m (xs[n := x]) = (drop m xs)[n-m := x]" proof (cases "n \ length xs") case False with assms show ?thesis by (simp add: upd_conv_take_nth_drop drop_take) qed auto lemma nth_image: "l \ size xs \ nth xs ` {0..\<^const>\takeWhile\ and \<^const>\dropWhile\\ lemma length_takeWhile_le: "length (takeWhile P xs) \ length xs" by (induct xs) auto lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs" by (induct xs) auto lemma takeWhile_append1 [simp]: "\x \ set xs; \P(x)\ \ takeWhile P (xs @ ys) = takeWhile P xs" by (induct xs) auto lemma takeWhile_append2 [simp]: "(\x. x \ set xs \ P x) \ takeWhile P (xs @ ys) = xs @ takeWhile P ys" by (induct xs) auto lemma takeWhile_append: "takeWhile P (xs @ ys) = (if \x\set xs. P x then xs @ takeWhile P ys else takeWhile P xs)" using takeWhile_append1[of _ xs P ys] takeWhile_append2[of xs P ys] by auto lemma takeWhile_tail: "\ P x \ takeWhile P (xs @ (x#l)) = takeWhile P xs" by (induct xs) auto lemma takeWhile_eq_Nil_iff: "takeWhile P xs = [] \ xs = [] \ \P (hd xs)" by (cases xs) auto lemma takeWhile_nth: "j < length (takeWhile P xs) \ takeWhile P xs ! j = xs ! j" by (metis nth_append takeWhile_dropWhile_id) lemma dropWhile_nth: "j < length (dropWhile P xs) \ dropWhile P xs ! j = xs ! (j + length (takeWhile P xs))" by (metis add.commute nth_append_length_plus takeWhile_dropWhile_id) lemma length_dropWhile_le: "length (dropWhile P xs) \ length xs" by (induct xs) auto lemma dropWhile_append1 [simp]: "\x \ set xs; \P(x)\ \ dropWhile P (xs @ ys) = (dropWhile P xs)@ys" by (induct xs) auto lemma dropWhile_append2 [simp]: "(\x. x \ set xs \ P(x)) \ dropWhile P (xs @ ys) = dropWhile P ys" by (induct xs) auto lemma dropWhile_append3: "\ P y \dropWhile P (xs @ y # ys) = dropWhile P xs @ y # ys" by (induct xs) auto lemma dropWhile_append: "dropWhile P (xs @ ys) = (if \x\set xs. P x then dropWhile P ys else dropWhile P xs @ ys)" using dropWhile_append1[of _ xs P ys] dropWhile_append2[of xs P ys] by auto lemma dropWhile_last: "x \ set xs \ \ P x \ last (dropWhile P xs) = last xs" by (auto simp add: dropWhile_append3 in_set_conv_decomp) lemma set_dropWhileD: "x \ set (dropWhile P xs) \ x \ set xs" by (induct xs) (auto split: if_split_asm) lemma set_takeWhileD: "x \ set (takeWhile P xs) \ x \ set xs \ P x" by (induct xs) (auto split: if_split_asm) lemma takeWhile_eq_all_conv[simp]: "(takeWhile P xs = xs) = (\x \ set xs. P x)" by(induct xs, auto) lemma dropWhile_eq_Nil_conv[simp]: "(dropWhile P xs = []) = (\x \ set xs. P x)" by(induct xs, auto) lemma dropWhile_eq_Cons_conv: "(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys \ \ P y)" by(induct xs, auto) lemma dropWhile_eq_self_iff: "dropWhile P xs = xs \ xs = [] \ \P (hd xs)" by (cases xs) (auto simp: dropWhile_eq_Cons_conv) lemma distinct_takeWhile[simp]: "distinct xs \ distinct (takeWhile P xs)" by (induct xs) (auto dest: set_takeWhileD) lemma distinct_dropWhile[simp]: "distinct xs \ distinct (dropWhile P xs)" by (induct xs) auto lemma takeWhile_map: "takeWhile P (map f xs) = map f (takeWhile (P \ f) xs)" by (induct xs) auto lemma dropWhile_map: "dropWhile P (map f xs) = map f (dropWhile (P \ f) xs)" by (induct xs) auto lemma takeWhile_eq_take: "takeWhile P xs = take (length (takeWhile P xs)) xs" by (induct xs) auto lemma dropWhile_eq_drop: "dropWhile P xs = drop (length (takeWhile P xs)) xs" by (induct xs) auto lemma hd_dropWhile: "dropWhile P xs \ [] \ \ P (hd (dropWhile P xs))" by (induct xs) auto lemma takeWhile_eq_filter: assumes "\ x. x \ set (dropWhile P xs) \ \ P x" shows "takeWhile P xs = filter P xs" proof - have A: "filter P xs = filter P (takeWhile P xs @ dropWhile P xs)" by simp have B: "filter P (dropWhile P xs) = []" unfolding filter_empty_conv using assms by blast have "filter P xs = takeWhile P xs" unfolding A filter_append B by (auto simp add: filter_id_conv dest: set_takeWhileD) thus ?thesis .. qed lemma takeWhile_eq_take_P_nth: "\ \ i. \ i < n ; i < length xs \ \ P (xs ! i) ; n < length xs \ \ P (xs ! n) \ \ takeWhile P xs = take n xs" proof (induct xs arbitrary: n) case Nil thus ?case by simp next case (Cons x xs) show ?case proof (cases n) case 0 with Cons show ?thesis by simp next case [simp]: (Suc n') have "P x" using Cons.prems(1)[of 0] by simp moreover have "takeWhile P xs = take n' xs" proof (rule Cons.hyps) fix i assume "i < n'" "i < length xs" thus "P (xs ! i)" using Cons.prems(1)[of "Suc i"] by simp next assume "n' < length xs" thus "\ P (xs ! n')" using Cons by auto qed ultimately show ?thesis by simp qed qed lemma nth_length_takeWhile: "length (takeWhile P xs) < length xs \ \ P (xs ! length (takeWhile P xs))" by (induct xs) auto lemma length_takeWhile_less_P_nth: assumes all: "\ i. i < j \ P (xs ! i)" and "j \ length xs" shows "j \ length (takeWhile P xs)" proof (rule classical) assume "\ ?thesis" hence "length (takeWhile P xs) < length xs" using assms by simp thus ?thesis using all \\ ?thesis\ nth_length_takeWhile[of P xs] by auto qed lemma takeWhile_neq_rev: "\distinct xs; x \ set xs\ \ takeWhile (\y. y \ x) (rev xs) = rev (tl (dropWhile (\y. y \ x) xs))" by(induct xs) (auto simp: takeWhile_tail[where l="[]"]) lemma dropWhile_neq_rev: "\distinct xs; x \ set xs\ \ dropWhile (\y. y \ x) (rev xs) = x # rev (takeWhile (\y. y \ x) xs)" proof (induct xs) case (Cons a xs) then show ?case by(auto, subst dropWhile_append2, auto) qed simp lemma takeWhile_not_last: "distinct xs \ takeWhile (\y. y \ last xs) xs = butlast xs" by(induction xs rule: induct_list012) auto lemma takeWhile_cong [fundef_cong]: "\l = k; \x. x \ set l \ P x = Q x\ \ takeWhile P l = takeWhile Q k" by (induct k arbitrary: l) (simp_all) lemma dropWhile_cong [fundef_cong]: "\l = k; \x. x \ set l \ P x = Q x\ \ dropWhile P l = dropWhile Q k" by (induct k arbitrary: l, simp_all) lemma takeWhile_idem [simp]: "takeWhile P (takeWhile P xs) = takeWhile P xs" by (induct xs) auto lemma dropWhile_idem [simp]: "dropWhile P (dropWhile P xs) = dropWhile P xs" by (induct xs) auto subsubsection \\<^const>\zip\\ lemma zip_Nil [simp]: "zip [] ys = []" by (induct ys) auto lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys" by simp declare zip_Cons [simp del] lemma [code]: "zip [] ys = []" "zip xs [] = []" "zip (x # xs) (y # ys) = (x, y) # zip xs ys" by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+ lemma zip_Cons1: "zip (x#xs) ys = (case ys of [] \ [] | y#ys \ (x,y)#zip xs ys)" by(auto split:list.split) lemma length_zip [simp]: "length (zip xs ys) = min (length xs) (length ys)" by (induct xs ys rule:list_induct2') auto lemma zip_obtain_same_length: assumes "\zs ws n. length zs = length ws \ n = min (length xs) (length ys) \ zs = take n xs \ ws = take n ys \ P (zip zs ws)" shows "P (zip xs ys)" proof - let ?n = "min (length xs) (length ys)" have "P (zip (take ?n xs) (take ?n ys))" by (rule assms) simp_all moreover have "zip xs ys = zip (take ?n xs) (take ?n ys)" proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case (Cons x xs) then show ?case by (cases ys) simp_all qed ultimately show ?thesis by simp qed lemma zip_append1: "zip (xs @ ys) zs = zip xs (take (length xs) zs) @ zip ys (drop (length xs) zs)" by (induct xs zs rule:list_induct2') auto lemma zip_append2: "zip xs (ys @ zs) = zip (take (length ys) xs) ys @ zip (drop (length ys) xs) zs" by (induct xs ys rule:list_induct2') auto lemma zip_append [simp]: "\length xs = length us\ \ zip (xs@ys) (us@vs) = zip xs us @ zip ys vs" by (simp add: zip_append1) lemma zip_rev: "length xs = length ys \ zip (rev xs) (rev ys) = rev (zip xs ys)" by (induct rule:list_induct2, simp_all) lemma zip_map_map: "zip (map f xs) (map g ys) = map (\ (x, y). (f x, g y)) (zip xs ys)" proof (induct xs arbitrary: ys) case (Cons x xs) note Cons_x_xs = Cons.hyps show ?case proof (cases ys) case (Cons y ys') show ?thesis unfolding Cons using Cons_x_xs by simp qed simp qed simp lemma zip_map1: "zip (map f xs) ys = map (\(x, y). (f x, y)) (zip xs ys)" using zip_map_map[of f xs "\x. x" ys] by simp lemma zip_map2: "zip xs (map f ys) = map (\(x, y). (x, f y)) (zip xs ys)" using zip_map_map[of "\x. x" xs f ys] by simp lemma map_zip_map: "map f (zip (map g xs) ys) = map (%(x,y). f(g x, y)) (zip xs ys)" by (auto simp: zip_map1) lemma map_zip_map2: "map f (zip xs (map g ys)) = map (%(x,y). f(x, g y)) (zip xs ys)" by (auto simp: zip_map2) text\Courtesy of Andreas Lochbihler:\ lemma zip_same_conv_map: "zip xs xs = map (\x. (x, x)) xs" by(induct xs) auto lemma nth_zip [simp]: "\i < length xs; i < length ys\ \ (zip xs ys)!i = (xs!i, ys!i)" proof (induct ys arbitrary: i xs) case (Cons y ys) then show ?case by (cases xs) (simp_all add: nth.simps split: nat.split) qed auto lemma set_zip: "set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}" by(simp add: set_conv_nth cong: rev_conj_cong) lemma zip_same: "((a,b) \ set (zip xs xs)) = (a \ set xs \ a = b)" by(induct xs) auto lemma zip_update: "zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]" by (simp add: update_zip) lemma zip_replicate [simp]: "zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)" proof (induct i arbitrary: j) case (Suc i) then show ?case by (cases j, auto) qed auto lemma zip_replicate1: "zip (replicate n x) ys = map (Pair x) (take n ys)" by(induction ys arbitrary: n)(case_tac [2] n, simp_all) lemma take_zip: "take n (zip xs ys) = zip (take n xs) (take n ys)" proof (induct n arbitrary: xs ys) case 0 then show ?case by simp next case Suc then show ?case by (cases xs; cases ys) simp_all qed lemma drop_zip: "drop n (zip xs ys) = zip (drop n xs) (drop n ys)" proof (induct n arbitrary: xs ys) case 0 then show ?case by simp next case Suc then show ?case by (cases xs; cases ys) simp_all qed lemma zip_takeWhile_fst: "zip (takeWhile P xs) ys = takeWhile (P \ fst) (zip xs ys)" proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case Cons then show ?case by (cases ys) auto qed lemma zip_takeWhile_snd: "zip xs (takeWhile P ys) = takeWhile (P \ snd) (zip xs ys)" proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case Cons then show ?case by (cases ys) auto qed lemma set_zip_leftD: "(x,y)\ set (zip xs ys) \ x \ set xs" by (induct xs ys rule:list_induct2') auto lemma set_zip_rightD: "(x,y)\ set (zip xs ys) \ y \ set ys" by (induct xs ys rule:list_induct2') auto lemma in_set_zipE: "(x,y) \ set(zip xs ys) \ (\ x \ set xs; y \ set ys \ \ R) \ R" by(blast dest: set_zip_leftD set_zip_rightD) lemma zip_map_fst_snd: "zip (map fst zs) (map snd zs) = zs" by (induct zs) simp_all lemma zip_eq_conv: "length xs = length ys \ zip xs ys = zs \ map fst zs = xs \ map snd zs = ys" by (auto simp add: zip_map_fst_snd) lemma in_set_zip: "p \ set (zip xs ys) \ (\n. xs ! n = fst p \ ys ! n = snd p \ n < length xs \ n < length ys)" by (cases p) (auto simp add: set_zip) lemma in_set_impl_in_set_zip1: assumes "length xs = length ys" assumes "x \ set xs" obtains y where "(x, y) \ set (zip xs ys)" proof - from assms have "x \ set (map fst (zip xs ys))" by simp from this that show ?thesis by fastforce qed lemma in_set_impl_in_set_zip2: assumes "length xs = length ys" assumes "y \ set ys" obtains x where "(x, y) \ set (zip xs ys)" proof - from assms have "y \ set (map snd (zip xs ys))" by simp from this that show ?thesis by fastforce qed lemma zip_eq_Nil_iff: "zip xs ys = [] \ xs = [] \ ys = []" by (cases xs; cases ys) simp_all lemma zip_eq_ConsE: assumes "zip xs ys = xy # xys" obtains x xs' y ys' where "xs = x # xs'" and "ys = y # ys'" and "xy = (x, y)" and "xys = zip xs' ys'" proof - from assms have "xs \ []" and "ys \ []" using zip_eq_Nil_iff [of xs ys] by simp_all then obtain x xs' y ys' where xs: "xs = x # xs'" and ys: "ys = y # ys'" by (cases xs; cases ys) auto with assms have "xy = (x, y)" and "xys = zip xs' ys'" by simp_all with xs ys show ?thesis .. qed lemma semilattice_map2: "semilattice (map2 (\<^bold>*))" if "semilattice (\<^bold>*)" for f (infixl "\<^bold>*" 70) proof - from that interpret semilattice f . show ?thesis proof show "map2 (\<^bold>*) (map2 (\<^bold>*) xs ys) zs = map2 (\<^bold>*) xs (map2 (\<^bold>*) ys zs)" for xs ys zs :: "'a list" proof (induction "zip xs (zip ys zs)" arbitrary: xs ys zs) case Nil from Nil [symmetric] show ?case by (auto simp add: zip_eq_Nil_iff) next case (Cons xyz xyzs) from Cons.hyps(2) [symmetric] show ?case by (rule zip_eq_ConsE) (erule zip_eq_ConsE, auto intro: Cons.hyps(1) simp add: ac_simps) qed show "map2 (\<^bold>*) xs ys = map2 (\<^bold>*) ys xs" for xs ys :: "'a list" proof (induction "zip xs ys" arbitrary: xs ys) case Nil then show ?case by (auto simp add: zip_eq_Nil_iff dest: sym) next case (Cons xy xys) from Cons.hyps(2) [symmetric] show ?case by (rule zip_eq_ConsE) (auto intro: Cons.hyps(1) simp add: ac_simps) qed show "map2 (\<^bold>*) xs xs = xs" for xs :: "'a list" by (induction xs) simp_all qed qed lemma pair_list_eqI: assumes "map fst xs = map fst ys" and "map snd xs = map snd ys" shows "xs = ys" proof - from assms(1) have "length xs = length ys" by (rule map_eq_imp_length_eq) from this assms show ?thesis by (induct xs ys rule: list_induct2) (simp_all add: prod_eqI) qed lemma hd_zip: \hd (zip xs ys) = (hd xs, hd ys)\ if \xs \ []\ and \ys \ []\ using that by (cases xs; cases ys) simp_all lemma last_zip: \last (zip xs ys) = (last xs, last ys)\ if \xs \ []\ and \ys \ []\ and \length xs = length ys\ using that by (cases xs rule: rev_cases; cases ys rule: rev_cases) simp_all subsubsection \\<^const>\list_all2\\ lemma list_all2_lengthD [intro?]: "list_all2 P xs ys \ length xs = length ys" by (simp add: list_all2_iff) lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])" by (simp add: list_all2_iff) lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])" by (simp add: list_all2_iff) lemma list_all2_Cons [iff, code]: "list_all2 P (x # xs) (y # ys) = (P x y \ list_all2 P xs ys)" by (auto simp add: list_all2_iff) lemma list_all2_Cons1: "list_all2 P (x # xs) ys = (\z zs. ys = z # zs \ P x z \ list_all2 P xs zs)" by (cases ys) auto lemma list_all2_Cons2: "list_all2 P xs (y # ys) = (\z zs. xs = z # zs \ P z y \ list_all2 P zs ys)" by (cases xs) auto lemma list_all2_induct [consumes 1, case_names Nil Cons, induct set: list_all2]: assumes P: "list_all2 P xs ys" assumes Nil: "R [] []" assumes Cons: "\x xs y ys. \P x y; list_all2 P xs ys; R xs ys\ \ R (x # xs) (y # ys)" shows "R xs ys" using P by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons) lemma list_all2_rev [iff]: "list_all2 P (rev xs) (rev ys) = list_all2 P xs ys" by (simp add: list_all2_iff zip_rev cong: conj_cong) lemma list_all2_rev1: "list_all2 P (rev xs) ys = list_all2 P xs (rev ys)" by (subst list_all2_rev [symmetric]) simp lemma list_all2_append1: "list_all2 P (xs @ ys) zs = (\us vs. zs = us @ vs \ length us = length xs \ length vs = length ys \ list_all2 P xs us \ list_all2 P ys vs)" (is "?lhs = ?rhs") proof assume ?lhs then show ?rhs apply (rule_tac x = "take (length xs) zs" in exI) apply (rule_tac x = "drop (length xs) zs" in exI) apply (force split: nat_diff_split simp add: list_all2_iff zip_append1) done next assume ?rhs then show ?lhs by (auto simp add: list_all2_iff) qed lemma list_all2_append2: "list_all2 P xs (ys @ zs) = (\us vs. xs = us @ vs \ length us = length ys \ length vs = length zs \ list_all2 P us ys \ list_all2 P vs zs)" (is "?lhs = ?rhs") proof assume ?lhs then show ?rhs apply (rule_tac x = "take (length ys) xs" in exI) apply (rule_tac x = "drop (length ys) xs" in exI) apply (force split: nat_diff_split simp add: list_all2_iff zip_append2) done next assume ?rhs then show ?lhs by (auto simp add: list_all2_iff) qed lemma list_all2_append: "length xs = length ys \ list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \ list_all2 P us vs)" by (induct rule:list_induct2, simp_all) lemma list_all2_appendI [intro?, trans]: "\ list_all2 P a b; list_all2 P c d \ \ list_all2 P (a@c) (b@d)" by (simp add: list_all2_append list_all2_lengthD) lemma list_all2_conv_all_nth: "list_all2 P xs ys = (length xs = length ys \ (\i < length xs. P (xs!i) (ys!i)))" by (force simp add: list_all2_iff set_zip) lemma list_all2_trans: assumes tr: "!!a b c. P1 a b \ P2 b c \ P3 a c" shows "!!bs cs. list_all2 P1 as bs \ list_all2 P2 bs cs \ list_all2 P3 as cs" (is "!!bs cs. PROP ?Q as bs cs") proof (induct as) fix x xs bs assume I1: "!!bs cs. PROP ?Q xs bs cs" show "!!cs. PROP ?Q (x # xs) bs cs" proof (induct bs) fix y ys cs assume I2: "!!cs. PROP ?Q (x # xs) ys cs" show "PROP ?Q (x # xs) (y # ys) cs" by (induct cs) (auto intro: tr I1 I2) qed simp qed simp lemma list_all2_all_nthI [intro?]: "length a = length b \ (\n. n < length a \ P (a!n) (b!n)) \ list_all2 P a b" by (simp add: list_all2_conv_all_nth) lemma list_all2I: "\x \ set (zip a b). case_prod P x \ length a = length b \ list_all2 P a b" by (simp add: list_all2_iff) lemma list_all2_nthD: "\ list_all2 P xs ys; p < size xs \ \ P (xs!p) (ys!p)" by (simp add: list_all2_conv_all_nth) lemma list_all2_nthD2: "\list_all2 P xs ys; p < size ys\ \ P (xs!p) (ys!p)" by (frule list_all2_lengthD) (auto intro: list_all2_nthD) lemma list_all2_map1: "list_all2 P (map f as) bs = list_all2 (\x y. P (f x) y) as bs" by (simp add: list_all2_conv_all_nth) lemma list_all2_map2: "list_all2 P as (map f bs) = list_all2 (\x y. P x (f y)) as bs" by (auto simp add: list_all2_conv_all_nth) lemma list_all2_refl [intro?]: "(\x. P x x) \ list_all2 P xs xs" by (simp add: list_all2_conv_all_nth) lemma list_all2_update_cong: "\ list_all2 P xs ys; P x y \ \ list_all2 P (xs[i:=x]) (ys[i:=y])" by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update) lemma list_all2_takeI [simp,intro?]: "list_all2 P xs ys \ list_all2 P (take n xs) (take n ys)" proof (induct xs arbitrary: n ys) case (Cons x xs) then show ?case by (cases n) (auto simp: list_all2_Cons1) qed auto lemma list_all2_dropI [simp,intro?]: "list_all2 P xs ys \ list_all2 P (drop n xs) (drop n ys)" proof (induct xs arbitrary: n ys) case (Cons x xs) then show ?case by (cases n) (auto simp: list_all2_Cons1) qed auto lemma list_all2_mono [intro?]: "list_all2 P xs ys \ (\xs ys. P xs ys \ Q xs ys) \ list_all2 Q xs ys" by (rule list.rel_mono_strong) lemma list_all2_eq: "xs = ys \ list_all2 (=) xs ys" by (induct xs ys rule: list_induct2') auto lemma list_eq_iff_zip_eq: "xs = ys \ length xs = length ys \ (\(x,y) \ set (zip xs ys). x = y)" by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) lemma list_all2_same: "list_all2 P xs xs \ (\x\set xs. P x x)" by(auto simp add: list_all2_conv_all_nth set_conv_nth) lemma zip_assoc: "zip xs (zip ys zs) = map (\((x, y), z). (x, y, z)) (zip (zip xs ys) zs)" by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all lemma zip_commute: "zip xs ys = map (\(x, y). (y, x)) (zip ys xs)" by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all lemma zip_left_commute: "zip xs (zip ys zs) = map (\(y, (x, z)). (x, y, z)) (zip ys (zip xs zs))" by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all lemma zip_replicate2: "zip xs (replicate n y) = map (\x. (x, y)) (take n xs)" by(subst zip_commute)(simp add: zip_replicate1) subsubsection \\<^const>\List.product\ and \<^const>\product_lists\\ lemma product_concat_map: "List.product xs ys = concat (map (\x. map (\y. (x,y)) ys) xs)" by(induction xs) (simp)+ lemma set_product[simp]: "set (List.product xs ys) = set xs \ set ys" by (induct xs) auto lemma length_product [simp]: "length (List.product xs ys) = length xs * length ys" by (induct xs) simp_all lemma product_nth: assumes "n < length xs * length ys" shows "List.product xs ys ! n = (xs ! (n div length ys), ys ! (n mod length ys))" using assms proof (induct xs arbitrary: n) case Nil then show ?case by simp next case (Cons x xs n) then have "length ys > 0" by auto with Cons show ?case by (auto simp add: nth_append not_less le_mod_geq le_div_geq) qed lemma in_set_product_lists_length: "xs \ set (product_lists xss) \ length xs = length xss" by (induct xss arbitrary: xs) auto lemma product_lists_set: "set (product_lists xss) = {xs. list_all2 (\x ys. x \ set ys) xs xss}" (is "?L = Collect ?R") proof (intro equalityI subsetI, unfold mem_Collect_eq) fix xs assume "xs \ ?L" then have "length xs = length xss" by (rule in_set_product_lists_length) from this \xs \ ?L\ show "?R xs" by (induct xs xss rule: list_induct2) auto next fix xs assume "?R xs" then show "xs \ ?L" by induct auto qed subsubsection \\<^const>\fold\ with natural argument order\ lemma fold_simps [code]: \ \eta-expanded variant for generated code -- enables tail-recursion optimisation in Scala\ "fold f [] s = s" "fold f (x # xs) s = fold f xs (f x s)" by simp_all lemma fold_remove1_split: "\ \x y. x \ set xs \ y \ set xs \ f x \ f y = f y \ f x; x \ set xs \ \ fold f xs = fold f (remove1 x xs) \ f x" by (induct xs) (auto simp add: comp_assoc) lemma fold_cong [fundef_cong]: "a = b \ xs = ys \ (\x. x \ set xs \ f x = g x) \ fold f xs a = fold g ys b" by (induct ys arbitrary: a b xs) simp_all lemma fold_id: "(\x. x \ set xs \ f x = id) \ fold f xs = id" by (induct xs) simp_all lemma fold_commute: "(\x. x \ set xs \ h \ g x = f x \ h) \ h \ fold g xs = fold f xs \ h" by (induct xs) (simp_all add: fun_eq_iff) lemma fold_commute_apply: assumes "\x. x \ set xs \ h \ g x = f x \ h" shows "h (fold g xs s) = fold f xs (h s)" proof - from assms have "h \ fold g xs = fold f xs \ h" by (rule fold_commute) then show ?thesis by (simp add: fun_eq_iff) qed lemma fold_invariant: "\ \x. x \ set xs \ Q x; P s; \x s. Q x \ P s \ P (f x s) \ \ P (fold f xs s)" by (induct xs arbitrary: s) simp_all lemma fold_append [simp]: "fold f (xs @ ys) = fold f ys \ fold f xs" by (induct xs) simp_all lemma fold_map [code_unfold]: "fold g (map f xs) = fold (g \ f) xs" by (induct xs) simp_all lemma fold_filter: "fold f (filter P xs) = fold (\x. if P x then f x else id) xs" by (induct xs) simp_all lemma fold_rev: "(\x y. x \ set xs \ y \ set xs \ f y \ f x = f x \ f y) \ fold f (rev xs) = fold f xs" by (induct xs) (simp_all add: fold_commute_apply fun_eq_iff) lemma fold_Cons_rev: "fold Cons xs = append (rev xs)" by (induct xs) simp_all lemma rev_conv_fold [code]: "rev xs = fold Cons xs []" by (simp add: fold_Cons_rev) lemma fold_append_concat_rev: "fold append xss = append (concat (rev xss))" by (induct xss) simp_all text \\<^const>\Finite_Set.fold\ and \<^const>\fold\\ lemma (in comp_fun_commute) fold_set_fold_remdups: "Finite_Set.fold f y (set xs) = fold f (remdups xs) y" by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm insert_absorb) lemma (in comp_fun_idem) fold_set_fold: "Finite_Set.fold f y (set xs) = fold f xs y" by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm) lemma union_set_fold [code]: "set xs \ A = fold Set.insert xs A" proof - interpret comp_fun_idem Set.insert by (fact comp_fun_idem_insert) show ?thesis by (simp add: union_fold_insert fold_set_fold) qed lemma union_coset_filter [code]: "List.coset xs \ A = List.coset (List.filter (\x. x \ A) xs)" by auto lemma minus_set_fold [code]: "A - set xs = fold Set.remove xs A" proof - interpret comp_fun_idem Set.remove by (fact comp_fun_idem_remove) show ?thesis by (simp add: minus_fold_remove [of _ A] fold_set_fold) qed lemma minus_coset_filter [code]: "A - List.coset xs = set (List.filter (\x. x \ A) xs)" by auto lemma inter_set_filter [code]: "A \ set xs = set (List.filter (\x. x \ A) xs)" by auto lemma inter_coset_fold [code]: "A \ List.coset xs = fold Set.remove xs A" by (simp add: Diff_eq [symmetric] minus_set_fold) lemma (in semilattice_set) set_eq_fold [code]: "F (set (x # xs)) = fold f xs x" proof - interpret comp_fun_idem f by standard (simp_all add: fun_eq_iff left_commute) show ?thesis by (simp add: eq_fold fold_set_fold) qed lemma (in complete_lattice) Inf_set_fold: "Inf (set xs) = fold inf xs top" proof - interpret comp_fun_idem "inf :: 'a \ 'a \ 'a" by (fact comp_fun_idem_inf) show ?thesis by (simp add: Inf_fold_inf fold_set_fold inf_commute) qed declare Inf_set_fold [where 'a = "'a set", code] lemma (in complete_lattice) Sup_set_fold: "Sup (set xs) = fold sup xs bot" proof - interpret comp_fun_idem "sup :: 'a \ 'a \ 'a" by (fact comp_fun_idem_sup) show ?thesis by (simp add: Sup_fold_sup fold_set_fold sup_commute) qed declare Sup_set_fold [where 'a = "'a set", code] lemma (in complete_lattice) INF_set_fold: "\(f ` set xs) = fold (inf \ f) xs top" using Inf_set_fold [of "map f xs"] by (simp add: fold_map) lemma (in complete_lattice) SUP_set_fold: "\(f ` set xs) = fold (sup \ f) xs bot" using Sup_set_fold [of "map f xs"] by (simp add: fold_map) subsubsection \Fold variants: \<^const>\foldr\ and \<^const>\foldl\\ text \Correspondence\ lemma foldr_conv_fold [code_abbrev]: "foldr f xs = fold f (rev xs)" by (induct xs) simp_all lemma foldl_conv_fold: "foldl f s xs = fold (\x s. f s x) xs s" by (induct xs arbitrary: s) simp_all lemma foldr_conv_foldl: \ \The ``Third Duality Theorem'' in Bird \& Wadler:\ "foldr f xs a = foldl (\x y. f y x) a (rev xs)" by (simp add: foldr_conv_fold foldl_conv_fold) lemma foldl_conv_foldr: "foldl f a xs = foldr (\x y. f y x) (rev xs) a" by (simp add: foldr_conv_fold foldl_conv_fold) lemma foldr_fold: "(\x y. x \ set xs \ y \ set xs \ f y \ f x = f x \ f y) \ foldr f xs = fold f xs" unfolding foldr_conv_fold by (rule fold_rev) lemma foldr_cong [fundef_cong]: "a = b \ l = k \ (\a x. x \ set l \ f x a = g x a) \ foldr f l a = foldr g k b" by (auto simp add: foldr_conv_fold intro!: fold_cong) lemma foldl_cong [fundef_cong]: "a = b \ l = k \ (\a x. x \ set l \ f a x = g a x) \ foldl f a l = foldl g b k" by (auto simp add: foldl_conv_fold intro!: fold_cong) lemma foldr_append [simp]: "foldr f (xs @ ys) a = foldr f xs (foldr f ys a)" by (simp add: foldr_conv_fold) lemma foldl_append [simp]: "foldl f a (xs @ ys) = foldl f (foldl f a xs) ys" by (simp add: foldl_conv_fold) lemma foldr_map [code_unfold]: "foldr g (map f xs) a = foldr (g \ f) xs a" by (simp add: foldr_conv_fold fold_map rev_map) lemma foldr_filter: "foldr f (filter P xs) = foldr (\x. if P x then f x else id) xs" by (simp add: foldr_conv_fold rev_filter fold_filter) lemma foldl_map [code_unfold]: "foldl g a (map f xs) = foldl (\a x. g a (f x)) a xs" by (simp add: foldl_conv_fold fold_map comp_def) lemma concat_conv_foldr [code]: "concat xss = foldr append xss []" by (simp add: fold_append_concat_rev foldr_conv_fold) subsubsection \\<^const>\upt\\ lemma upt_rec[code]: "[i.. \simp does not terminate!\ by (induct j) auto lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n lemma upt_conv_Nil [simp]: "j \ i \ [i.. j \ i)" by(induct j)simp_all lemma upt_eq_Cons_conv: "([i.. i = x \ [i+1.. j \ [i..<(Suc j)] = [i.. \Only needed if \upt_Suc\ is deleted from the simpset.\ by simp lemma upt_conv_Cons: "i < j \ [i.. \no precondition\ "m # n # ns = [m.. n # ns = [Suc m.. [i.. \LOOPS as a simprule, since \j \ j\.\ by (induct k) auto lemma length_upt [simp]: "length [i.. [i.. hd[i.. last[i.. n \ take m [i..i. i + n) [0.. (map f [m..n. n - Suc 0) [Suc m..i. f (Suc i)) [0 ..< n]" by (induct n arbitrary: f) auto lemma nth_take_lemma: "k \ length xs \ k \ length ys \ (\i. i < k \ xs!i = ys!i) \ take k xs = take k ys" proof (induct k arbitrary: xs ys) case (Suc k) then show ?case apply (simp add: less_Suc_eq_0_disj) by (simp add: Suc.prems(3) take_Suc_conv_app_nth) qed simp lemma nth_equalityI: "\length xs = length ys; \i. i < length xs \ xs!i = ys!i\ \ xs = ys" by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all lemma map_nth: "map (\i. xs ! i) [0.. (\x y. \P x y; Q y x\ \ x = y); list_all2 P xs ys; list_all2 Q ys xs \ \ xs = ys" by (simp add: list_all2_conv_all_nth nth_equalityI) lemma take_equalityI: "(\i. take i xs = take i ys) \ xs = ys" \ \The famous take-lemma.\ by (metis length_take min.commute order_refl take_all) lemma take_Cons': "take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)" by (cases n) simp_all lemma drop_Cons': "drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)" by (cases n) simp_all lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))" by (cases n) simp_all lemma take_Cons_numeral [simp]: "take (numeral v) (x # xs) = x # take (numeral v - 1) xs" by (simp add: take_Cons') lemma drop_Cons_numeral [simp]: "drop (numeral v) (x # xs) = drop (numeral v - 1) xs" by (simp add: drop_Cons') lemma nth_Cons_numeral [simp]: "(x # xs) ! numeral v = xs ! (numeral v - 1)" by (simp add: nth_Cons') lemma map_upt_eqI: \map f [m.. if \length xs = n - m\ \\i. i < length xs \ xs ! i = f (m + i)\ proof (rule nth_equalityI) from \length xs = n - m\ show \length (map f [m.. by simp next fix i assume \i < length (map f [m.. then have \i < n - m\ by simp with that have \xs ! i = f (m + i)\ by simp with \i < n - m\ show \map f [m.. by simp qed subsubsection \\upto\: interval-list on \<^typ>\int\\ function upto :: "int \ int \ int list" ("(1[_../_])") where "upto i j = (if i \ j then i # [i+1..j] else [])" by auto termination by(relation "measure(%(i::int,j). nat(j - i + 1))") auto declare upto.simps[simp del] lemmas upto_rec_numeral [simp] = upto.simps[of "numeral m" "numeral n"] upto.simps[of "numeral m" "- numeral n"] upto.simps[of "- numeral m" "numeral n"] upto.simps[of "- numeral m" "- numeral n"] for m n lemma upto_empty[simp]: "j < i \ [i..j] = []" by(simp add: upto.simps) lemma upto_single[simp]: "[i..i] = [i]" by(simp add: upto.simps) lemma upto_Nil[simp]: "[i..j] = [] \ j < i" by (simp add: upto.simps) lemma upto_Nil2[simp]: "[] = [i..j] \ j < i" by (simp add: upto.simps) lemma upto_rec1: "i \ j \ [i..j] = i#[i+1..j]" by(simp add: upto.simps) lemma upto_rec2: "i \ j \ [i..j] = [i..j - 1]@[j]" proof(induct "nat(j-i)" arbitrary: i j) case 0 thus ?case by(simp add: upto.simps) next case (Suc n) hence "n = nat (j - (i + 1))" "i < j" by linarith+ from this(2) Suc.hyps(1)[OF this(1)] Suc(2,3) upto_rec1 show ?case by simp qed lemma length_upto[simp]: "length [i..j] = nat(j - i + 1)" by(induction i j rule: upto.induct) (auto simp: upto.simps) lemma set_upto[simp]: "set[i..j] = {i..j}" proof(induct i j rule:upto.induct) case (1 i j) from this show ?case unfolding upto.simps[of i j] by auto qed lemma nth_upto[simp]: "i + int k \ j \ [i..j] ! k = i + int k" proof(induction i j arbitrary: k rule: upto.induct) case (1 i j) then show ?case by (auto simp add: upto_rec1 [of i j] nth_Cons') qed lemma upto_split1: "i \ j \ j \ k \ [i..k] = [i..j-1] @ [j..k]" proof (induction j rule: int_ge_induct) case base thus ?case by (simp add: upto_rec1) next case step thus ?case using upto_rec1 upto_rec2 by simp qed lemma upto_split2: "i \ j \ j \ k \ [i..k] = [i..j] @ [j+1..k]" using upto_rec1 upto_rec2 upto_split1 by auto lemma upto_split3: "\ i \ j; j \ k \ \ [i..k] = [i..j-1] @ j # [j+1..k]" using upto_rec1 upto_split1 by auto text\Tail recursive version for code generation:\ definition upto_aux :: "int \ int \ int list \ int list" where "upto_aux i j js = [i..j] @ js" lemma upto_aux_rec [code]: "upto_aux i j js = (if j\<^const>\successively\\ lemma successively_Cons: "successively P (x # xs) \ xs = [] \ P x (hd xs) \ successively P xs" by (cases xs) auto lemma successively_cong [cong]: assumes "\x y. x \ set xs \ y \ set xs \ P x y \ Q x y" "xs = ys" shows "successively P xs \ successively Q ys" unfolding assms(2) [symmetric] using assms(1) by (induction xs) (auto simp: successively_Cons) lemma successively_append_iff: "successively P (xs @ ys) \ successively P xs \ successively P ys \ (xs = [] \ ys = [] \ P (last xs) (hd ys))" by (induction xs) (auto simp: successively_Cons) lemma successively_if_sorted_wrt: "sorted_wrt P xs \ successively P xs" by (induction xs rule: induct_list012) auto lemma successively_iff_sorted_wrt_strong: assumes "\x y z. x \ set xs \ y \ set xs \ z \ set xs \ P x y \ P y z \ P x z" shows "successively P xs \ sorted_wrt P xs" proof assume "successively P xs" from this and assms show "sorted_wrt P xs" proof (induction xs rule: induct_list012) case (3 x y xs) from "3.prems" have "P x y" by auto have IH: "sorted_wrt P (y # xs)" using "3.prems" by(intro "3.IH"(2) list.set_intros(2))(simp, blast intro: list.set_intros(2)) have "P x z" if asm: "z \ set xs" for z proof - from IH and asm have "P y z" by auto with \P x y\ show "P x z" using "3.prems" asm by auto qed with IH and \P x y\ show ?case by auto qed auto qed (use successively_if_sorted_wrt in blast) lemma successively_conv_sorted_wrt: assumes "transp P" shows "successively P xs \ sorted_wrt P xs" using assms unfolding transp_def by (intro successively_iff_sorted_wrt_strong) blast lemma successively_rev [simp]: "successively P (rev xs) \ successively (\x y. P y x) xs" by (induction xs rule: remdups_adj.induct) (auto simp: successively_append_iff successively_Cons) lemma successively_map: "successively P (map f xs) \ successively (\x y. P (f x) (f y)) xs" by (induction xs rule: induct_list012) auto lemma successively_mono: assumes "successively P xs" assumes "\x y. x \ set xs \ y \ set xs \ P x y \ Q x y" shows "successively Q xs" using assms by (induction Q xs rule: successively.induct) auto lemma successively_altdef: "successively = (\P. rec_list True (\x xs b. case xs of [] \ True | y # _ \ P x y \ b))" proof (intro ext) fix P and xs :: "'a list" show "successively P xs = rec_list True (\x xs b. case xs of [] \ True | y # _ \ P x y \ b) xs" by (induction xs) (auto simp: successively_Cons split: list.splits) qed subsubsection \\<^const>\distinct\ and \<^const>\remdups\ and \<^const>\remdups_adj\\ lemma distinct_tl: "distinct xs \ distinct (tl xs)" by (cases xs) simp_all lemma distinct_append [simp]: "distinct (xs @ ys) = (distinct xs \ distinct ys \ set xs \ set ys = {})" by (induct xs) auto lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs" by(induct xs) auto lemma set_remdups [simp]: "set (remdups xs) = set xs" by (induct xs) (auto simp add: insert_absorb) lemma distinct_remdups [iff]: "distinct (remdups xs)" by (induct xs) auto lemma distinct_remdups_id: "distinct xs \ remdups xs = xs" by (induct xs, auto) lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \ distinct xs" by (metis distinct_remdups distinct_remdups_id) lemma finite_distinct_list: "finite A \ \xs. set xs = A \ distinct xs" by (metis distinct_remdups finite_list set_remdups) lemma remdups_eq_nil_iff [simp]: "(remdups x = []) = (x = [])" by (induct x, auto) lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])" by (induct x, auto) lemma length_remdups_leq[iff]: "length(remdups xs) \ length xs" by (induct xs) auto lemma length_remdups_eq[iff]: "(length (remdups xs) = length xs) = (remdups xs = xs)" proof (induct xs) case (Cons a xs) then show ?case by simp (metis Suc_n_not_le_n impossible_Cons length_remdups_leq) qed auto lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)" by (induct xs) auto lemma distinct_map: "distinct(map f xs) = (distinct xs \ inj_on f (set xs))" by (induct xs) auto lemma distinct_map_filter: "distinct (map f xs) \ distinct (map f (filter P xs))" by (induct xs) auto lemma distinct_filter [simp]: "distinct xs \ distinct (filter P xs)" by (induct xs) auto lemma distinct_upt[simp]: "distinct[i.. distinct (take i xs)" proof (induct xs arbitrary: i) case (Cons a xs) then show ?case by (metis Cons.prems append_take_drop_id distinct_append) qed auto lemma distinct_drop[simp]: "distinct xs \ distinct (drop i xs)" proof (induct xs arbitrary: i) case (Cons a xs) then show ?case by (metis Cons.prems append_take_drop_id distinct_append) qed auto lemma distinct_list_update: assumes d: "distinct xs" and a: "a \ set xs - {xs!i}" shows "distinct (xs[i:=a])" proof (cases "i < length xs") case True with a have anot: "a \ set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}" by simp (metis in_set_dropD in_set_takeD) show ?thesis proof (cases "a = xs!i") case True with d show ?thesis by auto next case False have "set (take i xs) \ set (drop (Suc i) xs) = {}" by (metis True d disjoint_insert(1) distinct_append id_take_nth_drop list.set(2)) then show ?thesis using d False anot \i < length xs\ by (simp add: upd_conv_take_nth_drop) qed next case False with d show ?thesis by auto qed lemma distinct_concat: "\ distinct xs; \ ys. ys \ set xs \ distinct ys; \ ys zs. \ ys \ set xs ; zs \ set xs ; ys \ zs \ \ set ys \ set zs = {} \ \ distinct (concat xs)" by (induct xs) auto text \An iff-version of @{thm distinct_concat} is available further down as \distinct_concat_iff\.\ text \It is best to avoid the following indexed version of distinct, but sometimes it is useful.\ lemma distinct_conv_nth: "distinct xs = (\i < size xs. \j < size xs. i \ j \ xs!i \ xs!j)" proof (induct xs) case (Cons x xs) show ?case apply (auto simp add: Cons nth_Cons split: nat.split_asm) apply (metis Suc_less_eq2 in_set_conv_nth less_not_refl zero_less_Suc)+ done qed auto lemma nth_eq_iff_index_eq: "\ distinct xs; i < length xs; j < length xs \ \ (xs!i = xs!j) = (i = j)" by(auto simp: distinct_conv_nth) lemma distinct_Ex1: "distinct xs \ x \ set xs \ (\!i. i < length xs \ xs ! i = x)" by (auto simp: in_set_conv_nth nth_eq_iff_index_eq) lemma inj_on_nth: "distinct xs \ \i \ I. i < length xs \ inj_on (nth xs) I" by (rule inj_onI) (simp add: nth_eq_iff_index_eq) lemma bij_betw_nth: assumes "distinct xs" "A = {.. distinct xs; n < length xs \ \ set(xs[n := x]) = insert x (set xs - {xs!n})" by(auto simp: set_eq_iff in_set_conv_nth nth_list_update nth_eq_iff_index_eq) lemma distinct_swap[simp]: "\ i < size xs; j < size xs\ \ distinct(xs[i := xs!j, j := xs!i]) = distinct xs" apply (simp add: distinct_conv_nth nth_list_update) apply (safe; metis) done lemma set_swap[simp]: "\ i < size xs; j < size xs \ \ set(xs[i := xs!j, j := xs!i]) = set xs" by(simp add: set_conv_nth nth_list_update) metis lemma distinct_card: "distinct xs \ card (set xs) = size xs" by (induct xs) auto lemma card_distinct: "card (set xs) = size xs \ distinct xs" proof (induct xs) case (Cons x xs) show ?case proof (cases "x \ set xs") case False with Cons show ?thesis by simp next case True with Cons.prems have "card (set xs) = Suc (length xs)" by (simp add: card_insert_if split: if_split_asm) moreover have "card (set xs) \ length xs" by (rule card_length) ultimately have False by simp thus ?thesis .. qed qed simp lemma distinct_length_filter: "distinct xs \ length (filter P xs) = card ({x. P x} Int set xs)" by (induct xs) (auto) lemma not_distinct_decomp: "\ distinct ws \ \xs ys zs y. ws = xs@[y]@ys@[y]@zs" proof (induct n == "length ws" arbitrary:ws) case (Suc n ws) then show ?case using length_Suc_conv [of ws n] apply (auto simp: eq_commute) apply (metis append_Nil in_set_conv_decomp_first) by (metis append_Cons) qed simp lemma not_distinct_conv_prefix: defines "dec as xs y ys \ y \ set xs \ distinct xs \ as = xs @ y # ys" shows "\distinct as \ (\xs y ys. dec as xs y ys)" (is "?L = ?R") proof assume "?L" then show "?R" proof (induct "length as" arbitrary: as rule: less_induct) case less obtain xs ys zs y where decomp: "as = (xs @ y # ys) @ y # zs" using not_distinct_decomp[OF less.prems] by auto show ?case proof (cases "distinct (xs @ y # ys)") case True with decomp have "dec as (xs @ y # ys) y zs" by (simp add: dec_def) then show ?thesis by blast next case False with less decomp obtain xs' y' ys' where "dec (xs @ y # ys) xs' y' ys'" by atomize_elim auto with decomp have "dec as xs' y' (ys' @ y # zs)" by (simp add: dec_def) then show ?thesis by blast qed qed qed (auto simp: dec_def) lemma distinct_product: "distinct xs \ distinct ys \ distinct (List.product xs ys)" by (induct xs) (auto intro: inj_onI simp add: distinct_map) lemma distinct_product_lists: assumes "\xs \ set xss. distinct xs" shows "distinct (product_lists xss)" using assms proof (induction xss) case (Cons xs xss) note * = this then show ?case proof (cases "product_lists xss") case Nil then show ?thesis by (induct xs) simp_all next case (Cons ps pss) with * show ?thesis by (auto intro!: inj_onI distinct_concat simp add: distinct_map) qed qed simp lemma length_remdups_concat: "length (remdups (concat xss)) = card (\xs\set xss. set xs)" by (simp add: distinct_card [symmetric]) lemma remdups_append2: "remdups (xs @ remdups ys) = remdups (xs @ ys)" by(induction xs) auto lemma length_remdups_card_conv: "length(remdups xs) = card(set xs)" proof - have xs: "concat[xs] = xs" by simp from length_remdups_concat[of "[xs]"] show ?thesis unfolding xs by simp qed lemma remdups_remdups: "remdups (remdups xs) = remdups xs" by (induct xs) simp_all lemma distinct_butlast: assumes "distinct xs" shows "distinct (butlast xs)" proof (cases "xs = []") case False from \xs \ []\ obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto with \distinct xs\ show ?thesis by simp qed (auto) lemma remdups_map_remdups: "remdups (map f (remdups xs)) = remdups (map f xs)" by (induct xs) simp_all lemma distinct_zipI1: assumes "distinct xs" shows "distinct (zip xs ys)" proof (rule zip_obtain_same_length) fix xs' :: "'a list" and ys' :: "'b list" and n assume "length xs' = length ys'" assume "xs' = take n xs" with assms have "distinct xs'" by simp with \length xs' = length ys'\ show "distinct (zip xs' ys')" by (induct xs' ys' rule: list_induct2) (auto elim: in_set_zipE) qed lemma distinct_zipI2: assumes "distinct ys" shows "distinct (zip xs ys)" proof (rule zip_obtain_same_length) fix xs' :: "'b list" and ys' :: "'a list" and n assume "length xs' = length ys'" assume "ys' = take n ys" with assms have "distinct ys'" by simp with \length xs' = length ys'\ show "distinct (zip xs' ys')" by (induct xs' ys' rule: list_induct2) (auto elim: in_set_zipE) qed lemma set_take_disj_set_drop_if_distinct: "distinct vs \ i \ j \ set (take i vs) \ set (drop j vs) = {}" by (auto simp: in_set_conv_nth distinct_conv_nth) (* The next two lemmas help Sledgehammer. *) lemma distinct_singleton: "distinct [x]" by simp lemma distinct_length_2_or_more: "distinct (a # b # xs) \ (a \ b \ distinct (a # xs) \ distinct (b # xs))" by force lemma remdups_adj_altdef: "(remdups_adj xs = ys) \ (\f::nat => nat. mono f \ f ` {0 ..< size xs} = {0 ..< size ys} \ (\i < size xs. xs!i = ys!(f i)) \ (\i. i + 1 < size xs \ (xs!i = xs!(i+1) \ f i = f(i+1))))" (is "?L \ (\f. ?p f xs ys)") proof assume ?L then show "\f. ?p f xs ys" proof (induct xs arbitrary: ys rule: remdups_adj.induct) case (1 ys) thus ?case by (intro exI[of _ id]) (auto simp: mono_def) next case (2 x ys) thus ?case by (intro exI[of _ id]) (auto simp: mono_def) next case (3 x1 x2 xs ys) let ?xs = "x1 # x2 # xs" let ?cond = "x1 = x2" define zs where "zs = remdups_adj (x2 # xs)" from 3(1-2)[of zs] obtain f where p: "?p f (x2 # xs) zs" unfolding zs_def by (cases ?cond) auto then have f0: "f 0 = 0" by (intro mono_image_least[where f=f]) blast+ from p have mono: "mono f" and f_xs_zs: "f ` {0.. []" unfolding zs_def by (induct xs) auto let ?Succ = "if ?cond then id else Suc" let ?x1 = "if ?cond then id else Cons x1" let ?f = "\ i. if i = 0 then 0 else ?Succ (f (i - 1))" have ys: "ys = ?x1 zs" unfolding ys by (cases ?cond, auto) have mono: "mono ?f" using \mono f\ unfolding mono_def by auto show ?case unfolding ys proof (intro exI[of _ ?f] conjI allI impI) show "mono ?f" by fact next fix i assume i: "i < length ?xs" with p show "?xs ! i = ?x1 zs ! (?f i)" using zs0 by auto next fix i assume i: "i + 1 < length ?xs" with p show "(?xs ! i = ?xs ! (i + 1)) = (?f i = ?f (i + 1))" by (cases i) (auto simp: f0) next have id: "{0 ..< length (?x1 zs)} = insert 0 (?Succ ` {0 ..< length zs})" using zsne by (cases ?cond, auto) { fix i assume "i < Suc (length xs)" hence "Suc i \ {0.. Collect ((<) 0)" by auto from imageI[OF this, of "\i. ?Succ (f (i - Suc 0))"] have "?Succ (f i) \ (\i. ?Succ (f (i - Suc 0))) ` ({0.. Collect ((<) 0))" by auto } then show "?f ` {0 ..< length ?xs} = {0 ..< length (?x1 zs)}" unfolding id f_xs_zs[symmetric] by auto qed qed next assume "\ f. ?p f xs ys" then show ?L proof (induct xs arbitrary: ys rule: remdups_adj.induct) case 1 then show ?case by auto next case (2 x) then obtain f where f_img: "f ` {0 ..< size [x]} = {0 ..< size ys}" and f_nth: "\i. i < size [x] \ [x]!i = ys!(f i)" by blast have "length ys = card (f ` {0 ..< size [x]})" using f_img by auto then have *: "length ys = 1" by auto then have "f 0 = 0" using f_img by auto with * show ?case using f_nth by (cases ys) auto next case (3 x1 x2 xs) from "3.prems" obtain f where f_mono: "mono f" and f_img: "f ` {0..i. i < length (x1 # x2 # xs) \ (x1 # x2 # xs) ! i = ys ! f i" "\i. i + 1 < length (x1 # x2 #xs) \ ((x1 # x2 # xs) ! i = (x1 # x2 # xs) ! (i + 1)) = (f i = f (i + 1))" by blast show ?case proof cases assume "x1 = x2" let ?f' = "f \ Suc" have "remdups_adj (x1 # xs) = ys" proof (intro "3.hyps" exI conjI impI allI) show "mono ?f'" using f_mono by (simp add: mono_iff_le_Suc) next have "?f' ` {0 ..< length (x1 # xs)} = f ` {Suc 0 ..< length (x1 # x2 # xs)}" using less_Suc_eq_0_disj by auto also have "\ = f ` {0 ..< length (x1 # x2 # xs)}" proof - have "f 0 = f (Suc 0)" using \x1 = x2\ f_nth[of 0] by simp then show ?thesis using less_Suc_eq_0_disj by auto qed also have "\ = {0 ..< length ys}" by fact finally show "?f' ` {0 ..< length (x1 # xs)} = {0 ..< length ys}" . qed (insert f_nth[of "Suc i" for i], auto simp: \x1 = x2\) then show ?thesis using \x1 = x2\ by simp next assume "x1 \ x2" have two: "Suc (Suc 0) \ length ys" proof - have "2 = card {f 0, f 1}" using \x1 \ x2\ f_nth[of 0] by auto also have "\ \ card (f ` {0..< length (x1 # x2 # xs)})" by (rule card_mono) auto finally show ?thesis using f_img by simp qed have "f 0 = 0" using f_mono f_img by (rule mono_image_least) simp have "f (Suc 0) = Suc 0" proof (rule ccontr) assume "f (Suc 0) \ Suc 0" then have "Suc 0 < f (Suc 0)" using f_nth[of 0] \x1 \ x2\ \f 0 = 0\ by auto then have "\i. Suc 0 < f (Suc i)" using f_mono by (meson Suc_le_mono le0 less_le_trans monoD) then have "Suc 0 \ f i" for i using \f 0 = 0\ by (cases i) fastforce+ then have "Suc 0 \ f ` {0 ..< length (x1 # x2 # xs)}" by auto then show False using f_img two by auto qed obtain ys' where "ys = x1 # x2 # ys'" using two f_nth[of 0] f_nth[of 1] by (auto simp: Suc_le_length_iff \f 0 = 0\ \f (Suc 0) = Suc 0\) have Suc0_le_f_Suc: "Suc 0 \ f (Suc i)" for i by (metis Suc_le_mono \f (Suc 0) = Suc 0\ f_mono le0 mono_def) define f' where "f' x = f (Suc x) - 1" for x have f_Suc: "f (Suc i) = Suc (f' i)" for i using Suc0_le_f_Suc[of i] by (auto simp: f'_def) have "remdups_adj (x2 # xs) = (x2 # ys')" proof (intro "3.hyps" exI conjI impI allI) show "mono f'" using Suc0_le_f_Suc f_mono by (auto simp: f'_def mono_iff_le_Suc le_diff_iff) next have "f' ` {0 ..< length (x2 # xs)} = (\x. f x - 1) ` {0 ..< length (x1 # x2 #xs)}" by (auto simp: f'_def \f 0 = 0\ \f (Suc 0) = Suc 0\ image_def Bex_def less_Suc_eq_0_disj) also have "\ = (\x. x - 1) ` f ` {0 ..< length (x1 # x2 #xs)}" by (auto simp: image_comp) also have "\ = (\x. x - 1) ` {0 ..< length ys}" by (simp only: f_img) also have "\ = {0 ..< length (x2 # ys')}" using \ys = _\ by (fastforce intro: rev_image_eqI) finally show "f' ` {0 ..< length (x2 # xs)} = {0 ..< length (x2 # ys')}" . qed (insert f_nth[of "Suc i" for i] \x1 \ x2\, auto simp add: f_Suc \ys = _\) then show ?case using \ys = _\ \x1 \ x2\ by simp qed qed qed lemma hd_remdups_adj[simp]: "hd (remdups_adj xs) = hd xs" by (induction xs rule: remdups_adj.induct) simp_all lemma remdups_adj_Cons: "remdups_adj (x # xs) = (case remdups_adj xs of [] \ [x] | y # xs \ if x = y then y # xs else x # y # xs)" by (induct xs arbitrary: x) (auto split: list.splits) lemma remdups_adj_append_two: "remdups_adj (xs @ [x,y]) = remdups_adj (xs @ [x]) @ (if x = y then [] else [y])" by (induct xs rule: remdups_adj.induct, simp_all) lemma remdups_adj_adjacent: "Suc i < length (remdups_adj xs) \ remdups_adj xs ! i \ remdups_adj xs ! Suc i" proof (induction xs arbitrary: i rule: remdups_adj.induct) case (3 x y xs i) thus ?case by (cases i, cases "x = y") (simp, auto simp: hd_conv_nth[symmetric]) qed simp_all lemma remdups_adj_rev[simp]: "remdups_adj (rev xs) = rev (remdups_adj xs)" by (induct xs rule: remdups_adj.induct, simp_all add: remdups_adj_append_two) lemma remdups_adj_length[simp]: "length (remdups_adj xs) \ length xs" by (induct xs rule: remdups_adj.induct, auto) lemma remdups_adj_length_ge1[simp]: "xs \ [] \ length (remdups_adj xs) \ Suc 0" by (induct xs rule: remdups_adj.induct, simp_all) lemma remdups_adj_Nil_iff[simp]: "remdups_adj xs = [] \ xs = []" by (induct xs rule: remdups_adj.induct, simp_all) lemma remdups_adj_set[simp]: "set (remdups_adj xs) = set xs" by (induct xs rule: remdups_adj.induct, simp_all) lemma last_remdups_adj [simp]: "last (remdups_adj xs) = last xs" by (induction xs rule: remdups_adj.induct) auto lemma remdups_adj_Cons_alt[simp]: "x # tl (remdups_adj (x # xs)) = remdups_adj (x # xs)" by (induct xs rule: remdups_adj.induct, auto) lemma remdups_adj_distinct: "distinct xs \ remdups_adj xs = xs" by (induct xs rule: remdups_adj.induct, simp_all) lemma remdups_adj_append: "remdups_adj (xs\<^sub>1 @ x # xs\<^sub>2) = remdups_adj (xs\<^sub>1 @ [x]) @ tl (remdups_adj (x # xs\<^sub>2))" by (induct xs\<^sub>1 rule: remdups_adj.induct, simp_all) lemma remdups_adj_singleton: "remdups_adj xs = [x] \ xs = replicate (length xs) x" by (induct xs rule: remdups_adj.induct, auto split: if_split_asm) lemma remdups_adj_map_injective: assumes "inj f" shows "remdups_adj (map f xs) = map f (remdups_adj xs)" by (induct xs rule: remdups_adj.induct) (auto simp add: injD[OF assms]) lemma remdups_adj_replicate: "remdups_adj (replicate n x) = (if n = 0 then [] else [x])" by (induction n) (auto simp: remdups_adj_Cons) lemma remdups_upt [simp]: "remdups [m.. n") case False then show ?thesis by simp next case True then obtain q where "n = m + q" by (auto simp add: le_iff_add) moreover have "remdups [m.. successively P (remdups_adj xs)" by (induction xs rule: remdups_adj.induct) (auto simp: successively_Cons) lemma successively_remdups_adj_iff: "(\x. x \ set xs \ P x x) \ successively P (remdups_adj xs) \ successively P xs" by (induction xs rule: remdups_adj.induct)(auto simp: successively_Cons) lemma remdups_adj_Cons': "remdups_adj (x # xs) = x # remdups_adj (dropWhile (\y. y = x) xs)" by (induction xs) auto lemma remdups_adj_singleton_iff: "length (remdups_adj xs) = Suc 0 \ xs \ [] \ xs = replicate (length xs) (hd xs)" proof safe assume *: "xs = replicate (length xs) (hd xs)" and [simp]: "xs \ []" show "length (remdups_adj xs) = Suc 0" by (subst *) (auto simp: remdups_adj_replicate) next assume "length (remdups_adj xs) = Suc 0" thus "xs = replicate (length xs) (hd xs)" by (induction xs rule: remdups_adj.induct) (auto split: if_splits) qed auto lemma tl_remdups_adj: "ys \ [] \ tl (remdups_adj ys) = remdups_adj (dropWhile (\x. x = hd ys) (tl ys))" by (cases ys) (simp_all add: remdups_adj_Cons') lemma remdups_adj_append_dropWhile: "remdups_adj (xs @ y # ys) = remdups_adj (xs @ [y]) @ remdups_adj (dropWhile (\x. x = y) ys)" by (subst remdups_adj_append) (simp add: tl_remdups_adj) lemma remdups_adj_append': assumes "xs = [] \ ys = [] \ last xs \ hd ys" shows "remdups_adj (xs @ ys) = remdups_adj xs @ remdups_adj ys" proof - have ?thesis if [simp]: "xs \ []" "ys \ []" and "last xs \ hd ys" proof - obtain x xs' where xs: "xs = xs' @ [x]" by (cases xs rule: rev_cases) auto have "remdups_adj (xs' @ x # ys) = remdups_adj (xs' @ [x]) @ remdups_adj ys" using \last xs \ hd ys\ unfolding xs by (metis (full_types) dropWhile_eq_self_iff last_snoc remdups_adj_append_dropWhile) thus ?thesis by (simp add: xs) qed thus ?thesis using assms by (cases "xs = []"; cases "ys = []") auto qed lemma remdups_adj_append'': "xs \ [] \ remdups_adj (xs @ ys) = remdups_adj xs @ remdups_adj (dropWhile (\y. y = last xs) ys)" by (induction xs rule: remdups_adj.induct) (auto simp: remdups_adj_Cons') subsection \@{const distinct_adj}\ lemma distinct_adj_Nil [simp]: "distinct_adj []" and distinct_adj_singleton [simp]: "distinct_adj [x]" and distinct_adj_Cons_Cons [simp]: "distinct_adj (x # y # xs) \ x \ y \ distinct_adj (y # xs)" by (auto simp: distinct_adj_def) lemma distinct_adj_Cons: "distinct_adj (x # xs) \ xs = [] \ x \ hd xs \ distinct_adj xs" by (cases xs) auto lemma distinct_adj_ConsD: "distinct_adj (x # xs) \ distinct_adj xs" by (cases xs) auto lemma distinct_adj_remdups_adj[simp]: "distinct_adj (remdups_adj xs)" by (induction xs rule: remdups_adj.induct) (auto simp: distinct_adj_Cons) lemma distinct_adj_altdef: "distinct_adj xs \ remdups_adj xs = xs" proof assume "remdups_adj xs = xs" with distinct_adj_remdups_adj[of xs] show "distinct_adj xs" by simp next assume "distinct_adj xs" thus "remdups_adj xs = xs" by (induction xs rule: induct_list012) auto qed lemma distinct_adj_rev [simp]: "distinct_adj (rev xs) \ distinct_adj xs" by (simp add: distinct_adj_def eq_commute) lemma distinct_adj_append_iff: "distinct_adj (xs @ ys) \ distinct_adj xs \ distinct_adj ys \ (xs = [] \ ys = [] \ last xs \ hd ys)" by (auto simp: distinct_adj_def successively_append_iff) lemma distinct_adj_appendD1 [dest]: "distinct_adj (xs @ ys) \ distinct_adj xs" and distinct_adj_appendD2 [dest]: "distinct_adj (xs @ ys) \ distinct_adj ys" by (auto simp: distinct_adj_append_iff) lemma distinct_adj_mapI: "distinct_adj xs \ inj_on f (set xs) \ distinct_adj (map f xs)" unfolding distinct_adj_def successively_map by (erule successively_mono) (auto simp: inj_on_def) lemma distinct_adj_mapD: "distinct_adj (map f xs) \ distinct_adj xs" unfolding distinct_adj_def successively_map by (erule successively_mono) auto lemma distinct_adj_map_iff: "inj_on f (set xs) \ distinct_adj (map f xs) \ distinct_adj xs" using distinct_adj_mapD distinct_adj_mapI by blast subsubsection \\<^const>\insert\\ lemma in_set_insert [simp]: "x \ set xs \ List.insert x xs = xs" by (simp add: List.insert_def) lemma not_in_set_insert [simp]: "x \ set xs \ List.insert x xs = x # xs" by (simp add: List.insert_def) lemma insert_Nil [simp]: "List.insert x [] = [x]" by simp lemma set_insert [simp]: "set (List.insert x xs) = insert x (set xs)" by (auto simp add: List.insert_def) lemma distinct_insert [simp]: "distinct (List.insert x xs) = distinct xs" by (simp add: List.insert_def) lemma insert_remdups: "List.insert x (remdups xs) = remdups (List.insert x xs)" by (simp add: List.insert_def) subsubsection \\<^const>\List.union\\ text\This is all one should need to know about union:\ lemma set_union[simp]: "set (List.union xs ys) = set xs \ set ys" unfolding List.union_def by(induct xs arbitrary: ys) simp_all lemma distinct_union[simp]: "distinct(List.union xs ys) = distinct ys" unfolding List.union_def by(induct xs arbitrary: ys) simp_all subsubsection \\<^const>\List.find\\ lemma find_None_iff: "List.find P xs = None \ \ (\x. x \ set xs \ P x)" proof (induction xs) case Nil thus ?case by simp next case (Cons x xs) thus ?case by (fastforce split: if_splits) qed lemma find_Some_iff: "List.find P xs = Some x \ (\i x = xs!i \ (\j P (xs!j)))" proof (induction xs) case Nil thus ?case by simp next case (Cons x xs) thus ?case apply(auto simp: nth_Cons' split: if_splits) using diff_Suc_1[unfolded One_nat_def] less_Suc_eq_0_disj by fastforce qed lemma find_cong[fundef_cong]: assumes "xs = ys" and "\x. x \ set ys \ P x = Q x" shows "List.find P xs = List.find Q ys" proof (cases "List.find P xs") case None thus ?thesis by (metis find_None_iff assms) next case (Some x) hence "List.find Q ys = Some x" using assms by (auto simp add: find_Some_iff) thus ?thesis using Some by auto qed lemma find_dropWhile: "List.find P xs = (case dropWhile (Not \ P) xs of [] \ None | x # _ \ Some x)" by (induct xs) simp_all subsubsection \\<^const>\count_list\\ lemma count_notin[simp]: "x \ set xs \ count_list xs x = 0" by (induction xs) auto lemma count_le_length: "count_list xs x \ length xs" by (induction xs) auto lemma sum_count_set: "set xs \ X \ finite X \ sum (count_list xs) X = length xs" proof (induction xs arbitrary: X) case (Cons x xs) then show ?case using sum.remove [of X x "count_list xs"] by (auto simp: sum.If_cases simp flip: diff_eq) qed simp subsubsection \\<^const>\List.extract\\ lemma extract_None_iff: "List.extract P xs = None \ \ (\ x\set xs. P x)" by(auto simp: extract_def dropWhile_eq_Cons_conv split: list.splits) (metis in_set_conv_decomp) lemma extract_SomeE: "List.extract P xs = Some (ys, y, zs) \ xs = ys @ y # zs \ P y \ \ (\ y \ set ys. P y)" by(auto simp: extract_def dropWhile_eq_Cons_conv split: list.splits) lemma extract_Some_iff: "List.extract P xs = Some (ys, y, zs) \ xs = ys @ y # zs \ P y \ \ (\ y \ set ys. P y)" by(auto simp: extract_def dropWhile_eq_Cons_conv dest: set_takeWhileD split: list.splits) lemma extract_Nil_code[code]: "List.extract P [] = None" by(simp add: extract_def) lemma extract_Cons_code[code]: "List.extract P (x # xs) = (if P x then Some ([], x, xs) else (case List.extract P xs of None \ None | Some (ys, y, zs) \ Some (x#ys, y, zs)))" by(auto simp add: extract_def comp_def split: list.splits) (metis dropWhile_eq_Nil_conv list.distinct(1)) subsubsection \\<^const>\remove1\\ lemma remove1_append: "remove1 x (xs @ ys) = (if x \ set xs then remove1 x xs @ ys else xs @ remove1 x ys)" by (induct xs) auto lemma remove1_commute: "remove1 x (remove1 y zs) = remove1 y (remove1 x zs)" by (induct zs) auto lemma in_set_remove1[simp]: "a \ b \ a \ set(remove1 b xs) = (a \ set xs)" by (induct xs) auto lemma set_remove1_subset: "set(remove1 x xs) \ set xs" by (induct xs) auto lemma set_remove1_eq [simp]: "distinct xs \ set(remove1 x xs) = set xs - {x}" by (induct xs) auto lemma length_remove1: "length(remove1 x xs) = (if x \ set xs then length xs - 1 else length xs)" by (induct xs) (auto dest!:length_pos_if_in_set) lemma remove1_filter_not[simp]: "\ P x \ remove1 x (filter P xs) = filter P xs" by(induct xs) auto lemma filter_remove1: "filter Q (remove1 x xs) = remove1 x (filter Q xs)" by (induct xs) auto lemma notin_set_remove1[simp]: "x \ set xs \ x \ set(remove1 y xs)" by(insert set_remove1_subset) fast lemma distinct_remove1[simp]: "distinct xs \ distinct(remove1 x xs)" by (induct xs) simp_all lemma remove1_remdups: "distinct xs \ remove1 x (remdups xs) = remdups (remove1 x xs)" by (induct xs) simp_all lemma remove1_idem: "x \ set xs \ remove1 x xs = xs" by (induct xs) simp_all subsubsection \\<^const>\removeAll\\ lemma removeAll_filter_not_eq: "removeAll x = filter (\y. x \ y)" proof fix xs show "removeAll x xs = filter (\y. x \ y) xs" by (induct xs) auto qed lemma removeAll_append[simp]: "removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys" by (induct xs) auto lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}" by (induct xs) auto lemma removeAll_id[simp]: "x \ set xs \ removeAll x xs = xs" by (induct xs) auto (* Needs count:: 'a \ 'a list \ nat lemma length_removeAll: "length(removeAll x xs) = length xs - count x xs" *) lemma removeAll_filter_not[simp]: "\ P x \ removeAll x (filter P xs) = filter P xs" by(induct xs) auto lemma distinct_removeAll: "distinct xs \ distinct (removeAll x xs)" by (simp add: removeAll_filter_not_eq) lemma distinct_remove1_removeAll: "distinct xs \ remove1 x xs = removeAll x xs" by (induct xs) simp_all lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \ map f (removeAll x xs) = removeAll (f x) (map f xs)" by (induct xs) (simp_all add:inj_on_def) lemma map_removeAll_inj: "inj f \ map f (removeAll x xs) = removeAll (f x) (map f xs)" by (rule map_removeAll_inj_on, erule subset_inj_on, rule subset_UNIV) lemma length_removeAll_less_eq [simp]: "length (removeAll x xs) \ length xs" by (simp add: removeAll_filter_not_eq) lemma length_removeAll_less [termination_simp]: "x \ set xs \ length (removeAll x xs) < length xs" by (auto dest: length_filter_less simp add: removeAll_filter_not_eq) lemma distinct_concat_iff: "distinct (concat xs) \ distinct (removeAll [] xs) \ (\ys. ys \ set xs \ distinct ys) \ (\ys zs. ys \ set xs \ zs \ set xs \ ys \ zs \ set ys \ set zs = {})" apply (induct xs) apply(simp_all, safe, auto) by (metis Int_iff UN_I empty_iff equals0I set_empty) subsubsection \\<^const>\replicate\\ lemma length_replicate [simp]: "length (replicate n x) = n" by (induct n) auto lemma replicate_eqI: assumes "length xs = n" and "\y. y \ set xs \ y = x" shows "xs = replicate n x" using assms proof (induct xs arbitrary: n) case Nil then show ?case by simp next case (Cons x xs) then show ?case by (cases n) simp_all qed lemma Ex_list_of_length: "\xs. length xs = n" by (rule exI[of _ "replicate n undefined"]) simp lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" by (induct n) auto lemma map_replicate_const: "map (\ x. k) lst = replicate (length lst) k" by (induct lst) auto lemma replicate_app_Cons_same: "(replicate n x) @ (x # xs) = x # replicate n x @ xs" by (induct n) auto lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" by (induct n) (auto simp: replicate_app_Cons_same) lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" by (induct n) auto text\Courtesy of Matthias Daum:\ lemma append_replicate_commute: "replicate n x @ replicate k x = replicate k x @ replicate n x" by (metis add.commute replicate_add) text\Courtesy of Andreas Lochbihler:\ lemma filter_replicate: "filter P (replicate n x) = (if P x then replicate n x else [])" by(induct n) auto lemma hd_replicate [simp]: "n \ 0 \ hd (replicate n x) = x" by (induct n) auto lemma tl_replicate [simp]: "tl (replicate n x) = replicate (n - 1) x" by (induct n) auto lemma last_replicate [simp]: "n \ 0 \ last (replicate n x) = x" by (atomize (full), induct n) auto lemma nth_replicate[simp]: "i < n \ (replicate n x)!i = x" by (induct n arbitrary: i)(auto simp: nth_Cons split: nat.split) text\Courtesy of Matthias Daum (2 lemmas):\ lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x" proof (cases "k \ i") case True then show ?thesis by (simp add: min_def) next case False then have "replicate k x = replicate i x @ replicate (k - i) x" by (simp add: replicate_add [symmetric]) then show ?thesis by (simp add: min_def) qed lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x" proof (induct k arbitrary: i) case (Suc k) then show ?case by (simp add: drop_Cons') qed simp lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}" by (induct n) auto lemma set_replicate [simp]: "n \ 0 \ set (replicate n x) = {x}" by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc) lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})" by auto lemma in_set_replicate[simp]: "(x \ set (replicate n y)) = (x = y \ n \ 0)" by (simp add: set_replicate_conv_if) lemma Ball_set_replicate[simp]: "(\x \ set(replicate n a). P x) = (P a \ n=0)" by(simp add: set_replicate_conv_if) lemma Bex_set_replicate[simp]: "(\x \ set(replicate n a). P x) = (P a \ n\0)" by(simp add: set_replicate_conv_if) lemma replicate_append_same: "replicate i x @ [x] = x # replicate i x" by (induct i) simp_all lemma map_replicate_trivial: "map (\i. x) [0.. n=0" by (induct n) auto lemma empty_replicate[simp]: "([] = replicate n x) \ n=0" by (induct n) auto lemma replicate_eq_replicate[simp]: "(replicate m x = replicate n y) \ (m=n \ (m\0 \ x=y))" proof (induct m arbitrary: n) case (Suc m n) then show ?case by (induct n) auto qed simp lemma takeWhile_replicate[simp]: "takeWhile P (replicate n x) = (if P x then replicate n x else [])" using takeWhile_eq_Nil_iff by fastforce lemma dropWhile_replicate[simp]: "dropWhile P (replicate n x) = (if P x then [] else replicate n x)" using dropWhile_eq_self_iff by fastforce lemma replicate_length_filter: "replicate (length (filter (\y. x = y) xs)) x = filter (\y. x = y) xs" by (induct xs) auto lemma comm_append_are_replicate: "xs @ ys = ys @ xs \ \m n zs. concat (replicate m zs) = xs \ concat (replicate n zs) = ys" proof (induction "length (xs @ ys) + length xs" arbitrary: xs ys rule: less_induct) case less consider (1) "length ys < length xs" | (2) "xs = []" | (3) "length xs \ length ys \ xs \ []" by linarith then show ?case proof (cases) case 1 then show ?thesis using less.hyps[OF _ less.prems[symmetric]] nat_add_left_cancel_less by auto next case 2 then have "concat (replicate 0 ys) = xs \ concat (replicate 1 ys) = ys" by simp then show ?thesis by blast next case 3 then have "length xs \ length ys" and "xs \ []" by blast+ from \length xs \ length ys\ and \xs @ ys = ys @ xs\ obtain ws where "ys = xs @ ws" by (auto simp: append_eq_append_conv2) from this and \xs \ []\ have "length ws < length ys" by simp from \xs @ ys = ys @ xs\[unfolded \ys = xs @ ws\] have "xs @ ws = ws @ xs" by simp from less.hyps[OF _ this] \length ws < length ys\ obtain m n' zs where "concat (replicate m zs) = xs" and "concat (replicate n' zs) = ws" by auto then have "concat (replicate (m+n') zs) = ys" using \ys = xs @ ws\ by (simp add: replicate_add) then show ?thesis using \concat (replicate m zs) = xs\ by blast qed qed lemma comm_append_is_replicate: fixes xs ys :: "'a list" assumes "xs \ []" "ys \ []" assumes "xs @ ys = ys @ xs" shows "\n zs. n > 1 \ concat (replicate n zs) = xs @ ys" proof - obtain m n zs where "concat (replicate m zs) = xs" and "concat (replicate n zs) = ys" using comm_append_are_replicate[OF assms(3)] by blast then have "m + n > 1" and "concat (replicate (m+n) zs) = xs @ ys" using \xs \ []\ and \ys \ []\ by (auto simp: replicate_add) then show ?thesis by blast qed lemma Cons_replicate_eq: "x # xs = replicate n y \ x = y \ n > 0 \ xs = replicate (n - 1) x" by (induct n) auto lemma replicate_length_same: "(\y\set xs. y = x) \ replicate (length xs) x = xs" by (induct xs) simp_all lemma foldr_replicate [simp]: "foldr f (replicate n x) = f x ^^ n" by (induct n) (simp_all) lemma fold_replicate [simp]: "fold f (replicate n x) = f x ^^ n" by (subst foldr_fold [symmetric]) simp_all subsubsection \\<^const>\enumerate\\ lemma enumerate_simps [simp, code]: "enumerate n [] = []" "enumerate n (x # xs) = (n, x) # enumerate (Suc n) xs" by (simp_all add: enumerate_eq_zip upt_rec) lemma length_enumerate [simp]: "length (enumerate n xs) = length xs" by (simp add: enumerate_eq_zip) lemma map_fst_enumerate [simp]: "map fst (enumerate n xs) = [n.. set (enumerate n xs) \ n \ fst p \ fst p < length xs + n \ nth xs (fst p - n) = snd p" proof - { fix m assume "n \ m" moreover assume "m < length xs + n" ultimately have "[n.. xs ! (m - n) = xs ! (m - n) \ m - n < length xs" by auto then have "\q. [n.. xs ! q = xs ! (m - n) \ q < length xs" .. } then show ?thesis by (cases p) (auto simp add: enumerate_eq_zip in_set_zip) qed lemma nth_enumerate_eq: "m < length xs \ enumerate n xs ! m = (n + m, xs ! m)" by (simp add: enumerate_eq_zip) lemma enumerate_replicate_eq: "enumerate n (replicate m a) = map (\q. (q, a)) [n..k. (k, f k)) [n.. m") (simp_all add: zip_map2 zip_same_conv_map enumerate_eq_zip) subsubsection \\<^const>\rotate1\ and \<^const>\rotate\\ lemma rotate0[simp]: "rotate 0 = id" by(simp add:rotate_def) lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)" by(simp add:rotate_def) lemma rotate_add: "rotate (m+n) = rotate m \ rotate n" by(simp add:rotate_def funpow_add) lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs" by(simp add:rotate_add) lemma rotate1_map: "rotate1 (map f xs) = map f (rotate1 xs)" by(cases xs) simp_all lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)" by(simp add:rotate_def funpow_swap1) lemma rotate1_length01[simp]: "length xs \ 1 \ rotate1 xs = xs" by(cases xs) simp_all lemma rotate_length01[simp]: "length xs \ 1 \ rotate n xs = xs" by (induct n) (simp_all add:rotate_def) lemma rotate1_hd_tl: "xs \ [] \ rotate1 xs = tl xs @ [hd xs]" by (cases xs) simp_all lemma rotate_drop_take: "rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs" proof (induct n) case (Suc n) show ?case proof (cases "xs = []") case False then show ?thesis proof (cases "n mod length xs = 0") case True then show ?thesis by (auto simp add: mod_Suc False Suc.hyps drop_Suc rotate1_hd_tl take_Suc Suc_length_conv) next case False with \xs \ []\ Suc show ?thesis by (simp add: rotate_def mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric] take_hd_drop linorder_not_le) qed qed simp qed simp lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs" by(simp add:rotate_drop_take) lemma rotate_id[simp]: "n mod length xs = 0 \ rotate n xs = xs" by(simp add:rotate_drop_take) lemma length_rotate1[simp]: "length(rotate1 xs) = length xs" by (cases xs) simp_all lemma length_rotate[simp]: "length(rotate n xs) = length xs" by (induct n arbitrary: xs) (simp_all add:rotate_def) lemma distinct1_rotate[simp]: "distinct(rotate1 xs) = distinct xs" by (cases xs) auto lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs" by (induct n) (simp_all add:rotate_def) lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)" by(simp add:rotate_drop_take take_map drop_map) lemma set_rotate1[simp]: "set(rotate1 xs) = set xs" by (cases xs) auto lemma set_rotate[simp]: "set(rotate n xs) = set xs" by (induct n) (simp_all add:rotate_def) lemma rotate1_is_Nil_conv[simp]: "(rotate1 xs = []) = (xs = [])" by (cases xs) auto lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])" by (induct n) (simp_all add:rotate_def) lemma rotate_rev: "rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)" proof (cases "length xs = 0 \ n mod length xs = 0") case False then show ?thesis by(simp add:rotate_drop_take rev_drop rev_take) qed force lemma hd_rotate_conv_nth: assumes "xs \ []" shows "hd(rotate n xs) = xs!(n mod length xs)" proof - have "n mod length xs < length xs" using assms by simp then show ?thesis by (metis drop_eq_Nil hd_append2 hd_drop_conv_nth leD rotate_drop_take) qed lemma rotate_append: "rotate (length l) (l @ q) = q @ l" by (induct l arbitrary: q) (auto simp add: rotate1_rotate_swap) lemma nth_rotate: \rotate m xs ! n = xs ! ((m + n) mod length xs)\ if \n < length xs\ using that apply (auto simp add: rotate_drop_take nth_append not_less less_diff_conv ac_simps dest!: le_Suc_ex) apply (metis add.commute mod_add_right_eq mod_less) apply (metis (no_types, lifting) Nat.diff_diff_right add.commute add_diff_cancel_right' diff_le_self dual_order.strict_trans2 length_greater_0_conv less_nat_zero_code list.size(3) mod_add_right_eq mod_add_self2 mod_le_divisor mod_less) done lemma nth_rotate1: \rotate1 xs ! n = xs ! (Suc n mod length xs)\ if \n < length xs\ using that nth_rotate [of n xs 1] by simp subsubsection \\<^const>\nths\ --- a generalization of \<^const>\nth\ to sets\ lemma nths_empty [simp]: "nths xs {} = []" by (auto simp add: nths_def) lemma nths_nil [simp]: "nths [] A = []" by (auto simp add: nths_def) lemma nths_all: "\i < length xs. i \ I \ nths xs I = xs" apply (simp add: nths_def) apply (subst filter_True) apply (auto simp: in_set_zip subset_iff) done lemma length_nths: "length (nths xs I) = card{i. i < length xs \ i \ I}" by(simp add: nths_def length_filter_conv_card cong:conj_cong) lemma nths_shift_lemma_Suc: "map fst (filter (\p. P(Suc(snd p))) (zip xs is)) = map fst (filter (\p. P(snd p)) (zip xs (map Suc is)))" proof (induct xs arbitrary: "is") case (Cons x xs "is") show ?case by (cases "is") (auto simp add: Cons.hyps) qed simp lemma nths_shift_lemma: "map fst (filter (\p. snd p \ A) (zip xs [i..p. snd p + i \ A) (zip xs [0.. A}" unfolding nths_def proof (induct l' rule: rev_induct) case (snoc x xs) then show ?case by (simp add: upt_add_eq_append[of 0] nths_shift_lemma add.commute) qed auto lemma nths_Cons: "nths (x # l) A = (if 0 \ A then [x] else []) @ nths l {j. Suc j \ A}" proof (induct l rule: rev_induct) case (snoc x xs) then show ?case by (simp flip: append_Cons add: nths_append) qed (auto simp: nths_def) lemma nths_map: "nths (map f xs) I = map f (nths xs I)" by(induction xs arbitrary: I) (simp_all add: nths_Cons) lemma set_nths: "set(nths xs I) = {xs!i|i. i i \ I}" by (induct xs arbitrary: I) (auto simp: nths_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc) lemma set_nths_subset: "set(nths xs I) \ set xs" by(auto simp add:set_nths) lemma notin_set_nthsI[simp]: "x \ set xs \ x \ set(nths xs I)" by(auto simp add:set_nths) lemma in_set_nthsD: "x \ set(nths xs I) \ x \ set xs" by(auto simp add:set_nths) lemma nths_singleton [simp]: "nths [x] A = (if 0 \ A then [x] else [])" by (simp add: nths_Cons) lemma distinct_nthsI[simp]: "distinct xs \ distinct (nths xs I)" by (induct xs arbitrary: I) (auto simp: nths_Cons) lemma nths_upt_eq_take [simp]: "nths l {.. A. \j \ B. card {i' \ A. i' < i} = j}" by (induction xs arbitrary: A B) (auto simp add: nths_Cons card_less_Suc card_less_Suc2) lemma drop_eq_nths: "drop n xs = nths xs {i. i \ n}" by (induction xs arbitrary: n) (auto simp add: nths_Cons nths_all drop_Cons' intro: arg_cong2[where f=nths, OF refl]) lemma nths_drop: "nths (drop n xs) I = nths xs ((+) n ` I)" by(force simp: drop_eq_nths nths_nths simp flip: atLeastLessThan_iff intro: arg_cong2[where f=nths, OF refl]) lemma filter_eq_nths: "filter P xs = nths xs {i. i P(xs!i)}" by(induction xs) (auto simp: nths_Cons) lemma filter_in_nths: "distinct xs \ filter (%x. x \ set (nths xs s)) xs = nths xs s" proof (induct xs arbitrary: s) case Nil thus ?case by simp next case (Cons a xs) then have "\x. x \ set xs \ x \ a" by auto with Cons show ?case by(simp add: nths_Cons cong:filter_cong) qed subsubsection \\<^const>\subseqs\ and \<^const>\List.n_lists\\ lemma length_subseqs: "length (subseqs xs) = 2 ^ length xs" by (induct xs) (simp_all add: Let_def) lemma subseqs_powset: "set ` set (subseqs xs) = Pow (set xs)" proof - have aux: "\x A. set ` Cons x ` A = insert x ` set ` A" by (auto simp add: image_def) have "set (map set (subseqs xs)) = Pow (set xs)" by (induct xs) (simp_all add: aux Let_def Pow_insert Un_commute comp_def del: map_map) then show ?thesis by simp qed lemma distinct_set_subseqs: assumes "distinct xs" shows "distinct (map set (subseqs xs))" proof (rule card_distinct) have "finite (set xs)" .. then have "card (Pow (set xs)) = 2 ^ card (set xs)" by (rule card_Pow) with assms distinct_card [of xs] have "card (Pow (set xs)) = 2 ^ length xs" by simp then show "card (set (map set (subseqs xs))) = length (map set (subseqs xs))" by (simp add: subseqs_powset length_subseqs) qed lemma n_lists_Nil [simp]: "List.n_lists n [] = (if n = 0 then [[]] else [])" by (induct n) simp_all lemma length_n_lists_elem: "ys \ set (List.n_lists n xs) \ length ys = n" by (induct n arbitrary: ys) auto lemma set_n_lists: "set (List.n_lists n xs) = {ys. length ys = n \ set ys \ set xs}" proof (rule set_eqI) fix ys :: "'a list" show "ys \ set (List.n_lists n xs) \ ys \ {ys. length ys = n \ set ys \ set xs}" proof - have "ys \ set (List.n_lists n xs) \ length ys = n" by (induct n arbitrary: ys) auto moreover have "\x. ys \ set (List.n_lists n xs) \ x \ set ys \ x \ set xs" by (induct n arbitrary: ys) auto moreover have "set ys \ set xs \ ys \ set (List.n_lists (length ys) xs)" by (induct ys) auto ultimately show ?thesis by auto qed qed lemma subseqs_refl: "xs \ set (subseqs xs)" by (induct xs) (simp_all add: Let_def) lemma subset_subseqs: "X \ set xs \ X \ set ` set (subseqs xs)" unfolding subseqs_powset by simp lemma Cons_in_subseqsD: "y # ys \ set (subseqs xs) \ ys \ set (subseqs xs)" by (induct xs) (auto simp: Let_def) lemma subseqs_distinctD: "\ ys \ set (subseqs xs); distinct xs \ \ distinct ys" proof (induct xs arbitrary: ys) case (Cons x xs ys) then show ?case by (auto simp: Let_def) (metis Pow_iff contra_subsetD image_eqI subseqs_powset) qed simp subsubsection \\<^const>\splice\\ lemma splice_Nil2 [simp]: "splice xs [] = xs" by (cases xs) simp_all lemma length_splice[simp]: "length(splice xs ys) = length xs + length ys" by (induct xs ys rule: splice.induct) auto lemma split_Nil_iff[simp]: "splice xs ys = [] \ xs = [] \ ys = []" by (induct xs ys rule: splice.induct) auto lemma splice_replicate[simp]: "splice (replicate m x) (replicate n x) = replicate (m+n) x" proof (induction "replicate m x" "replicate n x" arbitrary: m n rule: splice.induct) case (2 x xs) then show ?case by (auto simp add: Cons_replicate_eq dest: gr0_implies_Suc) qed auto subsubsection \\<^const>\shuffles\\ lemma shuffles_commutes: "shuffles xs ys = shuffles ys xs" by (induction xs ys rule: shuffles.induct) (simp_all add: Un_commute) lemma Nil_in_shuffles[simp]: "[] \ shuffles xs ys \ xs = [] \ ys = []" by (induct xs ys rule: shuffles.induct) auto lemma shufflesE: "zs \ shuffles xs ys \ (zs = xs \ ys = [] \ P) \ (zs = ys \ xs = [] \ P) \ (\x xs' z zs'. xs = x # xs' \ zs = z # zs' \ x = z \ zs' \ shuffles xs' ys \ P) \ (\y ys' z zs'. ys = y # ys' \ zs = z # zs' \ y = z \ zs' \ shuffles xs ys' \ P) \ P" by (induct xs ys rule: shuffles.induct) auto lemma Cons_in_shuffles_iff: "z # zs \ shuffles xs ys \ (xs \ [] \ hd xs = z \ zs \ shuffles (tl xs) ys \ ys \ [] \ hd ys = z \ zs \ shuffles xs (tl ys))" by (induct xs ys rule: shuffles.induct) auto lemma splice_in_shuffles [simp, intro]: "splice xs ys \ shuffles xs ys" by (induction xs ys rule: splice.induct) (simp_all add: Cons_in_shuffles_iff shuffles_commutes) lemma Nil_in_shufflesI: "xs = [] \ ys = [] \ [] \ shuffles xs ys" by simp lemma Cons_in_shuffles_leftI: "zs \ shuffles xs ys \ z # zs \ shuffles (z # xs) ys" by (cases ys) auto lemma Cons_in_shuffles_rightI: "zs \ shuffles xs ys \ z # zs \ shuffles xs (z # ys)" by (cases xs) auto lemma finite_shuffles [simp, intro]: "finite (shuffles xs ys)" by (induction xs ys rule: shuffles.induct) simp_all lemma length_shuffles: "zs \ shuffles xs ys \ length zs = length xs + length ys" by (induction xs ys arbitrary: zs rule: shuffles.induct) auto lemma set_shuffles: "zs \ shuffles xs ys \ set zs = set xs \ set ys" by (induction xs ys arbitrary: zs rule: shuffles.induct) auto lemma distinct_disjoint_shuffles: assumes "distinct xs" "distinct ys" "set xs \ set ys = {}" "zs \ shuffles xs ys" shows "distinct zs" using assms proof (induction xs ys arbitrary: zs rule: shuffles.induct) case (3 x xs y ys) show ?case proof (cases zs) case (Cons z zs') with "3.prems" and "3.IH"[of zs'] show ?thesis by (force dest: set_shuffles) qed simp_all qed simp_all lemma Cons_shuffles_subset1: "(#) x ` shuffles xs ys \ shuffles (x # xs) ys" by (cases ys) auto lemma Cons_shuffles_subset2: "(#) y ` shuffles xs ys \ shuffles xs (y # ys)" by (cases xs) auto lemma filter_shuffles: "filter P ` shuffles xs ys = shuffles (filter P xs) (filter P ys)" proof - have *: "filter P ` (#) x ` A = (if P x then (#) x ` filter P ` A else filter P ` A)" for x A by (auto simp: image_image) show ?thesis by (induction xs ys rule: shuffles.induct) (simp_all split: if_splits add: image_Un * Un_absorb1 Un_absorb2 Cons_shuffles_subset1 Cons_shuffles_subset2) qed lemma filter_shuffles_disjoint1: assumes "set xs \ set ys = {}" "zs \ shuffles xs ys" shows "filter (\x. x \ set xs) zs = xs" (is "filter ?P _ = _") and "filter (\x. x \ set xs) zs = ys" (is "filter ?Q _ = _") using assms proof - from assms have "filter ?P zs \ filter ?P ` shuffles xs ys" by blast also have "filter ?P ` shuffles xs ys = shuffles (filter ?P xs) (filter ?P ys)" by (rule filter_shuffles) also have "filter ?P xs = xs" by (rule filter_True) simp_all also have "filter ?P ys = []" by (rule filter_False) (insert assms(1), auto) also have "shuffles xs [] = {xs}" by simp finally show "filter ?P zs = xs" by simp next from assms have "filter ?Q zs \ filter ?Q ` shuffles xs ys" by blast also have "filter ?Q ` shuffles xs ys = shuffles (filter ?Q xs) (filter ?Q ys)" by (rule filter_shuffles) also have "filter ?Q ys = ys" by (rule filter_True) (insert assms(1), auto) also have "filter ?Q xs = []" by (rule filter_False) (insert assms(1), auto) also have "shuffles [] ys = {ys}" by simp finally show "filter ?Q zs = ys" by simp qed lemma filter_shuffles_disjoint2: assumes "set xs \ set ys = {}" "zs \ shuffles xs ys" shows "filter (\x. x \ set ys) zs = ys" "filter (\x. x \ set ys) zs = xs" using filter_shuffles_disjoint1[of ys xs zs] assms by (simp_all add: shuffles_commutes Int_commute) lemma partition_in_shuffles: "xs \ shuffles (filter P xs) (filter (\x. \P x) xs)" proof (induction xs) case (Cons x xs) show ?case proof (cases "P x") case True hence "x # xs \ (#) x ` shuffles (filter P xs) (filter (\x. \P x) xs)" by (intro imageI Cons.IH) also have "\ \ shuffles (filter P (x # xs)) (filter (\x. \P x) (x # xs))" by (simp add: True Cons_shuffles_subset1) finally show ?thesis . next case False hence "x # xs \ (#) x ` shuffles (filter P xs) (filter (\x. \P x) xs)" by (intro imageI Cons.IH) also have "\ \ shuffles (filter P (x # xs)) (filter (\x. \P x) (x # xs))" by (simp add: False Cons_shuffles_subset2) finally show ?thesis . qed qed auto lemma inv_image_partition: assumes "\x. x \ set xs \ P x" "\y. y \ set ys \ \P y" shows "partition P -` {(xs, ys)} = shuffles xs ys" proof (intro equalityI subsetI) fix zs assume zs: "zs \ shuffles xs ys" hence [simp]: "set zs = set xs \ set ys" by (rule set_shuffles) from assms have "filter P zs = filter (\x. x \ set xs) zs" "filter (\x. \P x) zs = filter (\x. x \ set ys) zs" by (intro filter_cong refl; force)+ moreover from assms have "set xs \ set ys = {}" by auto ultimately show "zs \ partition P -` {(xs, ys)}" using zs by (simp add: o_def filter_shuffles_disjoint1 filter_shuffles_disjoint2) next fix zs assume "zs \ partition P -` {(xs, ys)}" thus "zs \ shuffles xs ys" using partition_in_shuffles[of zs] by (auto simp: o_def) qed subsubsection \Transpose\ function transpose where "transpose [] = []" | "transpose ([] # xss) = transpose xss" | "transpose ((x#xs) # xss) = (x # [h. (h#t) \ xss]) # transpose (xs # [t. (h#t) \ xss])" by pat_completeness auto lemma transpose_aux_filter_head: "concat (map (case_list [] (\h t. [h])) xss) = map (\xs. hd xs) (filter (\ys. ys \ []) xss)" by (induct xss) (auto split: list.split) lemma transpose_aux_filter_tail: "concat (map (case_list [] (\h t. [t])) xss) = map (\xs. tl xs) (filter (\ys. ys \ []) xss)" by (induct xss) (auto split: list.split) lemma transpose_aux_max: "max (Suc (length xs)) (foldr (\xs. max (length xs)) xss 0) = Suc (max (length xs) (foldr (\x. max (length x - Suc 0)) (filter (\ys. ys \ []) xss) 0))" (is "max _ ?foldB = Suc (max _ ?foldA)") proof (cases "(filter (\ys. ys \ []) xss) = []") case True hence "foldr (\xs. max (length xs)) xss 0 = 0" proof (induct xss) case (Cons x xs) then have "x = []" by (cases x) auto with Cons show ?case by auto qed simp thus ?thesis using True by simp next case False have foldA: "?foldA = foldr (\x. max (length x)) (filter (\ys. ys \ []) xss) 0 - 1" by (induct xss) auto have foldB: "?foldB = foldr (\x. max (length x)) (filter (\ys. ys \ []) xss) 0" by (induct xss) auto have "0 < ?foldB" proof - from False obtain z zs where zs: "(filter (\ys. ys \ []) xss) = z#zs" by (auto simp: neq_Nil_conv) hence "z \ set (filter (\ys. ys \ []) xss)" by auto hence "z \ []" by auto thus ?thesis unfolding foldB zs by (auto simp: max_def intro: less_le_trans) qed thus ?thesis unfolding foldA foldB max_Suc_Suc[symmetric] by simp qed termination transpose by (relation "measure (\xs. foldr (\xs. max (length xs)) xs 0 + length xs)") (auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le) lemma transpose_empty: "(transpose xs = []) \ (\x \ set xs. x = [])" by (induct rule: transpose.induct) simp_all lemma length_transpose: fixes xs :: "'a list list" shows "length (transpose xs) = foldr (\xs. max (length xs)) xs 0" by (induct rule: transpose.induct) (auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max max_Suc_Suc[symmetric] simp del: max_Suc_Suc) lemma nth_transpose: fixes xs :: "'a list list" assumes "i < length (transpose xs)" shows "transpose xs ! i = map (\xs. xs ! i) (filter (\ys. i < length ys) xs)" using assms proof (induct arbitrary: i rule: transpose.induct) case (3 x xs xss) define XS where "XS = (x # xs) # xss" hence [simp]: "XS \ []" by auto thus ?case proof (cases i) case 0 thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth) next case (Suc j) have *: "\xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp have **: "\xss. (x#xs) # filter (\ys. ys \ []) xss = filter (\ys. ys \ []) ((x#xs)#xss)" by simp { fix x have "Suc j < length x \ x \ [] \ j < length x - Suc 0" by (cases x) simp_all } note *** = this have j_less: "j < length (transpose (xs # concat (map (case_list [] (\h t. [t])) xss)))" using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc) show ?thesis unfolding transpose.simps \i = Suc j\ nth_Cons_Suc "3.hyps"[OF j_less] apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) by (simp add: nth_tl) qed qed simp_all lemma transpose_map_map: "transpose (map (map f) xs) = map (map f) (transpose xs)" proof (rule nth_equalityI) have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)" by (simp add: length_transpose foldr_map comp_def) show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp fix i assume "i < length (transpose (map (map f) xs))" thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i" by (simp add: nth_transpose filter_map comp_def) qed subsubsection \\<^const>\min\ and \<^const>\arg_min\\ lemma min_list_Min: "xs \ [] \ min_list xs = Min (set xs)" by (induction xs rule: induct_list012)(auto) lemma f_arg_min_list_f: "xs \ [] \ f (arg_min_list f xs) = Min (f ` (set xs))" by(induction f xs rule: arg_min_list.induct) (auto simp: min_def intro!: antisym) lemma arg_min_list_in: "xs \ [] \ arg_min_list f xs \ set xs" by(induction xs rule: induct_list012) (auto simp: Let_def) subsubsection \(In)finiteness\ lemma finite_maxlen: "finite (M::'a list set) \ \n. \s\M. size s < n" proof (induct rule: finite.induct) case emptyI show ?case by simp next case (insertI M xs) then obtain n where "\s\M. length s < n" by blast hence "\s\insert xs M. size s < max n (size xs) + 1" by auto thus ?case .. qed lemma lists_length_Suc_eq: "{xs. set xs \ A \ length xs = Suc n} = (\(xs, n). n#xs) ` ({xs. set xs \ A \ length xs = n} \ A)" by (auto simp: length_Suc_conv) lemma assumes "finite A" shows finite_lists_length_eq: "finite {xs. set xs \ A \ length xs = n}" and card_lists_length_eq: "card {xs. set xs \ A \ length xs = n} = (card A)^n" using \finite A\ by (induct n) (auto simp: card_image inj_split_Cons lists_length_Suc_eq cong: conj_cong) lemma finite_lists_length_le: assumes "finite A" shows "finite {xs. set xs \ A \ length xs \ n}" (is "finite ?S") proof- have "?S = (\n\{0..n}. {xs. set xs \ A \ length xs = n})" by auto thus ?thesis by (auto intro!: finite_lists_length_eq[OF \finite A\] simp only:) qed lemma card_lists_length_le: assumes "finite A" shows "card {xs. set xs \ A \ length xs \ n} = (\i\n. card A^i)" proof - have "(\i\n. card A^i) = card (\i\n. {xs. set xs \ A \ length xs = i})" using \finite A\ by (subst card_UN_disjoint) (auto simp add: card_lists_length_eq finite_lists_length_eq) also have "(\i\n. {xs. set xs \ A \ length xs = i}) = {xs. set xs \ A \ length xs \ n}" by auto finally show ?thesis by simp qed lemma finite_lists_distinct_length_eq [intro]: assumes "finite A" shows "finite {xs. length xs = n \ distinct xs \ set xs \ A}" (is "finite ?S") proof - have "finite {xs. set xs \ A \ length xs = n}" using \finite A\ by (rule finite_lists_length_eq) moreover have "?S \ {xs. set xs \ A \ length xs = n}" by auto ultimately show ?thesis using finite_subset by auto qed lemma card_lists_distinct_length_eq: assumes "finite A" "k \ card A" shows "card {xs. length xs = k \ distinct xs \ set xs \ A} = \{card A - k + 1 .. card A}" using assms proof (induct k) case 0 then have "{xs. length xs = 0 \ distinct xs \ set xs \ A} = {[]}" by auto then show ?case by simp next case (Suc k) let "?k_list" = "\k xs. length xs = k \ distinct xs \ set xs \ A" have inj_Cons: "\A. inj_on (\(xs, n). n # xs) A" by (rule inj_onI) auto from Suc have "k \ card A" by simp moreover note \finite A\ moreover have "finite {xs. ?k_list k xs}" by (rule finite_subset) (use finite_lists_length_eq[OF \finite A\, of k] in auto) moreover have "\i j. i \ j \ {i} \ (A - set i) \ {j} \ (A - set j) = {}" by auto moreover have "\i. i \ {xs. ?k_list k xs} \ card (A - set i) = card A - k" by (simp add: card_Diff_subset distinct_card) moreover have "{xs. ?k_list (Suc k) xs} = (\(xs, n). n#xs) ` \((\xs. {xs} \ (A - set xs)) ` {xs. ?k_list k xs})" by (auto simp: length_Suc_conv) moreover have "Suc (card A - Suc k) = card A - k" using Suc.prems by simp then have "(card A - k) * \{Suc (card A - k)..card A} = \{Suc (card A - Suc k)..card A}" by (subst prod.insert[symmetric]) (simp add: atLeastAtMost_insertL)+ ultimately show ?case by (simp add: card_image inj_Cons card_UN_disjoint Suc.hyps algebra_simps) qed lemma card_lists_distinct_length_eq': assumes "k < card A" shows "card {xs. length xs = k \ distinct xs \ set xs \ A} = \{card A - k + 1 .. card A}" proof - from \k < card A\ have "finite A" and "k \ card A" using card.infinite by force+ from this show ?thesis by (rule card_lists_distinct_length_eq) qed lemma infinite_UNIV_listI: "\ finite(UNIV::'a list set)" by (metis UNIV_I finite_maxlen length_replicate less_irrefl) lemma same_length_different: assumes "xs \ ys" and "length xs = length ys" shows "\pre x xs' y ys'. x\y \ xs = pre @ [x] @ xs' \ ys = pre @ [y] @ ys'" using assms proof (induction xs arbitrary: ys) case Nil then show ?case by auto next case (Cons x xs) then obtain z zs where ys: "ys = Cons z zs" by (metis length_Suc_conv) show ?case proof (cases "x=z") case True then have "xs \ zs" "length xs = length zs" using Cons.prems ys by auto then obtain pre u xs' v ys' where "u\v" and xs: "xs = pre @ [u] @ xs'" and zs: "zs = pre @ [v] @ys'" using Cons.IH by meson then have "x # xs = (z#pre) @ [u] @ xs' \ ys = (z#pre) @ [v] @ ys'" by (simp add: True ys) with \u\v\ show ?thesis by blast next case False then have "x # xs = [] @ [x] @ xs \ ys = [] @ [z] @ zs" by (simp add: ys) then show ?thesis using False by blast qed qed subsection \Sorting\ subsubsection \\<^const>\sorted_wrt\\ text \Sometimes the second equation in the definition of \<^const>\sorted_wrt\ is too aggressive because it relates each list element to \emph{all} its successors. Then this equation should be removed and \sorted_wrt2_simps\ should be added instead.\ lemma sorted_wrt1: "sorted_wrt P [x] = True" by(simp) lemma sorted_wrt2: "transp P \ sorted_wrt P (x # y # zs) = (P x y \ sorted_wrt P (y # zs))" proof (induction zs arbitrary: x y) case (Cons z zs) then show ?case by simp (meson transpD)+ qed auto lemmas sorted_wrt2_simps = sorted_wrt1 sorted_wrt2 lemma sorted_wrt_true [simp]: "sorted_wrt (\_ _. True) xs" by (induction xs) simp_all lemma sorted_wrt_append: "sorted_wrt P (xs @ ys) \ sorted_wrt P xs \ sorted_wrt P ys \ (\x\set xs. \y\set ys. P x y)" by (induction xs) auto lemma sorted_wrt_map: "sorted_wrt R (map f xs) = sorted_wrt (\x y. R (f x) (f y)) xs" by (induction xs) simp_all lemma assumes "sorted_wrt f xs" shows sorted_wrt_take: "sorted_wrt f (take n xs)" and sorted_wrt_drop: "sorted_wrt f (drop n xs)" proof - from assms have "sorted_wrt f (take n xs @ drop n xs)" by simp thus "sorted_wrt f (take n xs)" and "sorted_wrt f (drop n xs)" unfolding sorted_wrt_append by simp_all qed lemma sorted_wrt_filter: "sorted_wrt f xs \ sorted_wrt f (filter P xs)" by (induction xs) auto lemma sorted_wrt_rev: "sorted_wrt P (rev xs) = sorted_wrt (\x y. P y x) xs" by (induction xs) (auto simp add: sorted_wrt_append) lemma sorted_wrt_mono_rel: "(\x y. \ x \ set xs; y \ set xs; P x y \ \ Q x y) \ sorted_wrt P xs \ sorted_wrt Q xs" by(induction xs)(auto) lemma sorted_wrt01: "length xs \ 1 \ sorted_wrt P xs" by(auto simp: le_Suc_eq length_Suc_conv) lemma sorted_wrt_iff_nth_less: "sorted_wrt P xs = (\i j. i < j \ j < length xs \ P (xs ! i) (xs ! j))" by (induction xs) (auto simp add: in_set_conv_nth Ball_def nth_Cons split: nat.split) lemma sorted_wrt_nth_less: "\ sorted_wrt P xs; i < j; j < length xs \ \ P (xs ! i) (xs ! j)" by(auto simp: sorted_wrt_iff_nth_less) lemma sorted_wrt_iff_nth_Suc_transp: assumes "transp P" shows "sorted_wrt P xs \ (\i. Suc i < length xs \ P (xs!i) (xs!(Suc i)))" (is "?L = ?R") proof assume ?L thus ?R by (simp add: sorted_wrt_iff_nth_less) next assume ?R have "i < j \ j < length xs \ P (xs ! i) (xs ! j)" for i j by(induct i j rule: less_Suc_induct)(simp add: \?R\, meson assms transpE transp_less) thus ?L by (simp add: sorted_wrt_iff_nth_less) qed lemma sorted_wrt_upt[simp]: "sorted_wrt (<) [m..Each element is greater or equal to its index:\ lemma sorted_wrt_less_idx: "sorted_wrt (<) ns \ i < length ns \ i \ ns!i" proof (induction ns arbitrary: i rule: rev_induct) case Nil thus ?case by simp next case snoc thus ?case by (auto simp: nth_append sorted_wrt_append) (metis less_antisym not_less nth_mem) qed subsubsection \\<^const>\sorted\\ context linorder begin text \Sometimes the second equation in the definition of \<^const>\sorted\ is too aggressive because it relates each list element to \emph{all} its successors. Then this equation should be removed and \sorted2_simps\ should be added instead. Executable code is one such use case.\ lemma sorted1: "sorted [x] = True" by simp lemma sorted2: "sorted (x # y # zs) = (x \ y \ sorted (y # zs))" by(induction zs) auto lemmas sorted2_simps = sorted1 sorted2 lemmas [code] = sorted.simps(1) sorted2_simps lemma sorted_append: "sorted (xs@ys) = (sorted xs \ sorted ys \ (\x \ set xs. \y \ set ys. x\y))" by (simp add: sorted_sorted_wrt sorted_wrt_append) lemma sorted_map: "sorted (map f xs) = sorted_wrt (\x y. f x \ f y) xs" by (simp add: sorted_sorted_wrt sorted_wrt_map) lemma sorted01: "length xs \ 1 \ sorted xs" by (simp add: sorted_sorted_wrt sorted_wrt01) lemma sorted_tl: "sorted xs \ sorted (tl xs)" by (cases xs) (simp_all) lemma sorted_iff_nth_mono_less: "sorted xs = (\i j. i < j \ j < length xs \ xs ! i \ xs ! j)" by (simp add: sorted_sorted_wrt sorted_wrt_iff_nth_less) lemma sorted_iff_nth_mono: "sorted xs = (\i j. i \ j \ j < length xs \ xs ! i \ xs ! j)" by (auto simp: sorted_iff_nth_mono_less nat_less_le) lemma sorted_nth_mono: "sorted xs \ i \ j \ j < length xs \ xs!i \ xs!j" by (auto simp: sorted_iff_nth_mono) lemma sorted_iff_nth_Suc: "sorted xs \ (\i. Suc i < length xs \ xs!i \ xs!(Suc i))" by(simp add: sorted_sorted_wrt sorted_wrt_iff_nth_Suc_transp) lemma sorted_rev_nth_mono: "sorted (rev xs) \ i \ j \ j < length xs \ xs!j \ xs!i" using sorted_nth_mono[ of "rev xs" "length xs - j - 1" "length xs - i - 1"] rev_nth[of "length xs - i - 1" "xs"] rev_nth[of "length xs - j - 1" "xs"] by auto lemma sorted_rev_iff_nth_mono: "sorted (rev xs) \ (\ i j. i \ j \ j < length xs \ xs!j \ xs!i)" (is "?L = ?R") proof assume ?L thus ?R by (blast intro: sorted_rev_nth_mono) next assume ?R have "rev xs ! k \ rev xs ! l" if asms: "k \ l" "l < length(rev xs)" for k l proof - have "k < length xs" "l < length xs" "length xs - Suc l \ length xs - Suc k" "length xs - Suc k < length xs" using asms by auto thus "rev xs ! k \ rev xs ! l" using \?R\ \k \ l\ unfolding rev_nth[OF \k < length xs\] rev_nth[OF \l < length xs\] by blast qed thus ?L by (simp add: sorted_iff_nth_mono) qed lemma sorted_rev_iff_nth_Suc: "sorted (rev xs) \ (\i. Suc i < length xs \ xs!(Suc i) \ xs!i)" proof- interpret dual: linorder "(\x y. y \ x)" "(\x y. y < x)" using dual_linorder . show ?thesis using dual_linorder dual.sorted_iff_nth_Suc dual.sorted_iff_nth_mono unfolding sorted_rev_iff_nth_mono by simp qed lemma sorted_map_remove1: "sorted (map f xs) \ sorted (map f (remove1 x xs))" by (induct xs) (auto) lemma sorted_remove1: "sorted xs \ sorted (remove1 a xs)" using sorted_map_remove1 [of "\x. x"] by simp lemma sorted_butlast: assumes "xs \ []" and "sorted xs" shows "sorted (butlast xs)" proof - from \xs \ []\ obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto with \sorted xs\ show ?thesis by (simp add: sorted_append) qed lemma sorted_replicate [simp]: "sorted(replicate n x)" by(induction n) (auto) lemma sorted_remdups[simp]: "sorted xs \ sorted (remdups xs)" by (induct xs) (auto) lemma sorted_remdups_adj[simp]: "sorted xs \ sorted (remdups_adj xs)" by (induct xs rule: remdups_adj.induct, simp_all split: if_split_asm) lemma sorted_nths: "sorted xs \ sorted (nths xs I)" by(induction xs arbitrary: I)(auto simp: nths_Cons) lemma sorted_distinct_set_unique: assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" shows "xs = ys" proof - from assms have 1: "length xs = length ys" by (auto dest!: distinct_card) from assms show ?thesis proof(induct rule:list_induct2[OF 1]) case 1 show ?case by simp next - case 2 thus ?case by simp (metis Diff_insert_absorb antisym insertE insert_iff) + case (2 x xs y ys) + then show ?case + by (cases \x = y\) (auto simp add: insert_eq_iff) qed qed lemma map_sorted_distinct_set_unique: assumes "inj_on f (set xs \ set ys)" assumes "sorted (map f xs)" "distinct (map f xs)" "sorted (map f ys)" "distinct (map f ys)" assumes "set xs = set ys" shows "xs = ys" proof - from assms have "map f xs = map f ys" by (simp add: sorted_distinct_set_unique) with \inj_on f (set xs \ set ys)\ show "xs = ys" by (blast intro: map_inj_on) qed lemma assumes "sorted xs" shows sorted_take: "sorted (take n xs)" and sorted_drop: "sorted (drop n xs)" proof - from assms have "sorted (take n xs @ drop n xs)" by simp then show "sorted (take n xs)" and "sorted (drop n xs)" unfolding sorted_append by simp_all qed lemma sorted_dropWhile: "sorted xs \ sorted (dropWhile P xs)" by (auto dest: sorted_drop simp add: dropWhile_eq_drop) lemma sorted_takeWhile: "sorted xs \ sorted (takeWhile P xs)" by (subst takeWhile_eq_take) (auto dest: sorted_take) lemma sorted_filter: "sorted (map f xs) \ sorted (map f (filter P xs))" by (induct xs) simp_all lemma foldr_max_sorted: assumes "sorted (rev xs)" shows "foldr max xs y = (if xs = [] then y else max (xs ! 0) y)" using assms proof (induct xs) case (Cons x xs) then have "sorted (rev xs)" using sorted_append by auto with Cons show ?case by (cases xs) (auto simp add: sorted_append max_def) qed simp lemma filter_equals_takeWhile_sorted_rev: assumes sorted: "sorted (rev (map f xs))" shows "filter (\x. t < f x) xs = takeWhile (\ x. t < f x) xs" (is "filter ?P xs = ?tW") proof (rule takeWhile_eq_filter[symmetric]) let "?dW" = "dropWhile ?P xs" fix x assume "x \ set ?dW" then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i" unfolding in_set_conv_nth by auto hence "length ?tW + i < length (?tW @ ?dW)" unfolding length_append by simp hence i': "length (map f ?tW) + i < length (map f xs)" by simp have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \ (map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)" using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"] unfolding map_append[symmetric] by simp hence "f x \ f (?dW ! 0)" unfolding nth_append_length_plus nth_i using i preorder_class.le_less_trans[OF le0 i] by simp also have "... \ t" using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i] using hd_conv_nth[of "?dW"] by simp finally show "\ t < f x" by simp qed lemma sorted_map_same: "sorted (map f (filter (\x. f x = g xs) xs))" proof (induct xs arbitrary: g) case Nil then show ?case by simp next case (Cons x xs) then have "sorted (map f (filter (\y. f y = (\xs. f x) xs) xs))" . moreover from Cons have "sorted (map f (filter (\y. f y = (g \ Cons x) xs) xs))" . ultimately show ?case by simp_all qed lemma sorted_same: "sorted (filter (\x. x = g xs) xs)" using sorted_map_same [of "\x. x"] by simp end lemma sorted_upt[simp]: "sorted [m..Sorting functions\ text\Currently it is not shown that \<^const>\sort\ returns a permutation of its input because the nicest proof is via multisets, which are not part of Main. Alternatively one could define a function that counts the number of occurrences of an element in a list and use that instead of multisets to state the correctness property.\ context linorder begin lemma set_insort_key: "set (insort_key f x xs) = insert x (set xs)" by (induct xs) auto lemma length_insort [simp]: "length (insort_key f x xs) = Suc (length xs)" by (induct xs) simp_all lemma insort_key_left_comm: assumes "f x \ f y" shows "insort_key f y (insort_key f x xs) = insort_key f x (insort_key f y xs)" -by (induct xs) (auto simp add: assms dest: antisym) +by (induct xs) (auto simp add: assms dest: order.antisym) lemma insort_left_comm: "insort x (insort y xs) = insort y (insort x xs)" by (cases "x = y") (auto intro: insort_key_left_comm) lemma comp_fun_commute_insort: "comp_fun_commute insort" proof qed (simp add: insort_left_comm fun_eq_iff) lemma sort_key_simps [simp]: "sort_key f [] = []" "sort_key f (x#xs) = insort_key f x (sort_key f xs)" by (simp_all add: sort_key_def) lemma sort_key_conv_fold: assumes "inj_on f (set xs)" shows "sort_key f xs = fold (insort_key f) xs []" proof - have "fold (insort_key f) (rev xs) = fold (insort_key f) xs" proof (rule fold_rev, rule ext) fix zs fix x y assume "x \ set xs" "y \ set xs" with assms have *: "f y = f x \ y = x" by (auto dest: inj_onD) have **: "x = y \ y = x" by auto show "(insort_key f y \ insort_key f x) zs = (insort_key f x \ insort_key f y) zs" by (induct zs) (auto intro: * simp add: **) qed then show ?thesis by (simp add: sort_key_def foldr_conv_fold) qed lemma sort_conv_fold: "sort xs = fold insort xs []" by (rule sort_key_conv_fold) simp lemma length_sort[simp]: "length (sort_key f xs) = length xs" by (induct xs, auto) lemma set_sort[simp]: "set(sort_key f xs) = set xs" by (induct xs) (simp_all add: set_insort_key) lemma distinct_insort: "distinct (insort_key f x xs) = (x \ set xs \ distinct xs)" by(induct xs)(auto simp: set_insort_key) lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs" by (induct xs) (simp_all add: distinct_insort) lemma sorted_insort_key: "sorted (map f (insort_key f x xs)) = sorted (map f xs)" by (induct xs) (auto simp: set_insort_key) lemma sorted_insort: "sorted (insort x xs) = sorted xs" using sorted_insort_key [where f="\x. x"] by simp theorem sorted_sort_key [simp]: "sorted (map f (sort_key f xs))" by (induct xs) (auto simp:sorted_insort_key) theorem sorted_sort [simp]: "sorted (sort xs)" using sorted_sort_key [where f="\x. x"] by simp lemma insort_not_Nil [simp]: "insort_key f a xs \ []" by (induction xs) simp_all lemma insort_is_Cons: "\x\set xs. f a \ f x \ insort_key f a xs = a # xs" by (cases xs) auto lemma sorted_sort_id: "sorted xs \ sort xs = xs" by (induct xs) (auto simp add: insort_is_Cons) lemma insort_key_remove1: assumes "a \ set xs" and "sorted (map f xs)" and "hd (filter (\x. f a = f x) xs) = a" shows "insort_key f a (remove1 a xs) = xs" using assms proof (induct xs) case (Cons x xs) then show ?case proof (cases "x = a") case False then have "f x \ f a" using Cons.prems by auto then have "f x < f a" using Cons.prems by auto with \f x \ f a\ show ?thesis using Cons by (auto simp: insort_is_Cons) qed (auto simp: insort_is_Cons) qed simp lemma insort_remove1: assumes "a \ set xs" and "sorted xs" shows "insort a (remove1 a xs) = xs" proof (rule insort_key_remove1) define n where "n = length (filter ((=) a) xs) - 1" from \a \ set xs\ show "a \ set xs" . from \sorted xs\ show "sorted (map (\x. x) xs)" by simp from \a \ set xs\ have "a \ set (filter ((=) a) xs)" by auto then have "set (filter ((=) a) xs) \ {}" by auto then have "filter ((=) a) xs \ []" by (auto simp only: set_empty) then have "length (filter ((=) a) xs) > 0" by simp then have n: "Suc n = length (filter ((=) a) xs)" by (simp add: n_def) moreover have "replicate (Suc n) a = a # replicate n a" by simp ultimately show "hd (filter ((=) a) xs) = a" by (simp add: replicate_length_filter) qed lemma finite_sorted_distinct_unique: assumes "finite A" shows "\!xs. set xs = A \ sorted xs \ distinct xs" proof - obtain xs where "distinct xs" "A = set xs" using finite_distinct_list [OF assms] by metis then show ?thesis by (rule_tac a="sort xs" in ex1I) (auto simp: sorted_distinct_set_unique) qed lemma insort_insert_key_triv: "f x \ f ` set xs \ insort_insert_key f x xs = xs" by (simp add: insort_insert_key_def) lemma insort_insert_triv: "x \ set xs \ insort_insert x xs = xs" using insort_insert_key_triv [of "\x. x"] by simp lemma insort_insert_insort_key: "f x \ f ` set xs \ insort_insert_key f x xs = insort_key f x xs" by (simp add: insort_insert_key_def) lemma insort_insert_insort: "x \ set xs \ insort_insert x xs = insort x xs" using insort_insert_insort_key [of "\x. x"] by simp lemma set_insort_insert: "set (insort_insert x xs) = insert x (set xs)" by (auto simp add: insort_insert_key_def set_insort_key) lemma distinct_insort_insert: assumes "distinct xs" shows "distinct (insort_insert_key f x xs)" using assms by (induct xs) (auto simp add: insort_insert_key_def set_insort_key) lemma sorted_insort_insert_key: assumes "sorted (map f xs)" shows "sorted (map f (insort_insert_key f x xs))" using assms by (simp add: insort_insert_key_def sorted_insort_key) lemma sorted_insort_insert: assumes "sorted xs" shows "sorted (insort_insert x xs)" using assms sorted_insort_insert_key [of "\x. x"] by simp lemma filter_insort_triv: "\ P x \ filter P (insort_key f x xs) = filter P xs" by (induct xs) simp_all lemma filter_insort: "sorted (map f xs) \ P x \ filter P (insort_key f x xs) = insort_key f x (filter P xs)" by (induct xs) (auto, subst insort_is_Cons, auto) lemma filter_sort: "filter P (sort_key f xs) = sort_key f (filter P xs)" by (induct xs) (simp_all add: filter_insort_triv filter_insort) lemma remove1_insort [simp]: "remove1 x (insort x xs) = xs" by (induct xs) simp_all end lemma sort_upt [simp]: "sort [m.. \x \ set xs. P x \ List.find P xs = Some (Min {x\set xs. P x})" proof (induct xs) case Nil then show ?case by simp next case (Cons x xs) show ?case proof (cases "P x") case True with Cons show ?thesis by (auto intro: Min_eqI [symmetric]) next case False then have "{y. (y = x \ y \ set xs) \ P y} = {y \ set xs. P y}" by auto with Cons False show ?thesis by (simp_all) qed qed lemma sorted_enumerate [simp]: "sorted (map fst (enumerate n xs))" by (simp add: enumerate_eq_zip) text \Stability of \<^const>\sort_key\:\ lemma sort_key_stable: "filter (\y. f y = k) (sort_key f xs) = filter (\y. f y = k) xs" by (induction xs) (auto simp: filter_insort insort_is_Cons filter_insort_triv) corollary stable_sort_key_sort_key: "stable_sort_key sort_key" by(simp add: stable_sort_key_def sort_key_stable) lemma sort_key_const: "sort_key (\x. c) xs = xs" by (metis (mono_tags) filter_True sort_key_stable) subsubsection \\<^const>\transpose\ on sorted lists\ lemma sorted_transpose[simp]: "sorted (rev (map length (transpose xs)))" by (auto simp: sorted_iff_nth_mono rev_nth nth_transpose length_filter_conv_card intro: card_mono) lemma transpose_max_length: "foldr (\xs. max (length xs)) (transpose xs) 0 = length (filter (\x. x \ []) xs)" (is "?L = ?R") proof (cases "transpose xs = []") case False have "?L = foldr max (map length (transpose xs)) 0" by (simp add: foldr_map comp_def) also have "... = length (transpose xs ! 0)" using False sorted_transpose by (simp add: foldr_max_sorted) finally show ?thesis using False by (simp add: nth_transpose) next case True hence "filter (\x. x \ []) xs = []" by (auto intro!: filter_False simp: transpose_empty) thus ?thesis by (simp add: transpose_empty True) qed lemma length_transpose_sorted: fixes xs :: "'a list list" assumes sorted: "sorted (rev (map length xs))" shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))" proof (cases "xs = []") case False thus ?thesis using foldr_max_sorted[OF sorted] False unfolding length_transpose foldr_map comp_def by simp qed simp lemma nth_nth_transpose_sorted[simp]: fixes xs :: "'a list list" assumes sorted: "sorted (rev (map length xs))" and i: "i < length (transpose xs)" and j: "j < length (filter (\ys. i < length ys) xs)" shows "transpose xs ! i ! j = xs ! j ! i" using j filter_equals_takeWhile_sorted_rev[OF sorted, of i] nth_transpose[OF i] nth_map[OF j] by (simp add: takeWhile_nth) lemma transpose_column_length: fixes xs :: "'a list list" assumes sorted: "sorted (rev (map length xs))" and "i < length xs" shows "length (filter (\ys. i < length ys) (transpose xs)) = length (xs ! i)" proof - have "xs \ []" using \i < length xs\ by auto note filter_equals_takeWhile_sorted_rev[OF sorted, simp] { fix j assume "j \ i" note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this \i < length xs\] } note sortedE = this[consumes 1] have "{j. j < length (transpose xs) \ i < length (transpose xs ! j)} = {..< length (xs ! i)}" proof safe fix j assume "j < length (transpose xs)" and "i < length (transpose xs ! j)" with this(2) nth_transpose[OF this(1)] have "i < length (takeWhile (\ys. j < length ys) xs)" by simp from nth_mem[OF this] takeWhile_nth[OF this] show "j < length (xs ! i)" by (auto dest: set_takeWhileD) next fix j assume "j < length (xs ! i)" thus "j < length (transpose xs)" using foldr_max_sorted[OF sorted] \xs \ []\ sortedE[OF le0] by (auto simp: length_transpose comp_def foldr_map) have "Suc i \ length (takeWhile (\ys. j < length ys) xs)" using \i < length xs\ \j < length (xs ! i)\ less_Suc_eq_le by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE) with nth_transpose[OF \j < length (transpose xs)\] show "i < length (transpose xs ! j)" by simp qed thus ?thesis by (simp add: length_filter_conv_card) qed lemma transpose_column: fixes xs :: "'a list list" assumes sorted: "sorted (rev (map length xs))" and "i < length xs" shows "map (\ys. ys ! i) (filter (\ys. i < length ys) (transpose xs)) = xs ! i" (is "?R = _") proof (rule nth_equalityI) show length: "length ?R = length (xs ! i)" using transpose_column_length[OF assms] by simp fix j assume j: "j < length ?R" note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le] from j have j_less: "j < length (xs ! i)" using length by simp have i_less_tW: "Suc i \ length (takeWhile (\ys. Suc j \ length ys) xs)" proof (rule length_takeWhile_less_P_nth) show "Suc i \ length xs" using \i < length xs\ by simp fix k assume "k < Suc i" hence "k \ i" by auto with sorted_rev_nth_mono[OF sorted this] \i < length xs\ have "length (xs ! i) \ length (xs ! k)" by simp thus "Suc j \ length (xs ! k)" using j_less by simp qed have i_less_filter: "i < length (filter (\ys. j < length ys) xs) " unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j] using i_less_tW by (simp_all add: Suc_le_eq) from j show "?R ! j = xs ! i ! j" unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i] by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter]) qed lemma transpose_transpose: fixes xs :: "'a list list" assumes sorted: "sorted (rev (map length xs))" shows "transpose (transpose xs) = takeWhile (\x. x \ []) xs" (is "?L = ?R") proof - have len: "length ?L = length ?R" unfolding length_transpose transpose_max_length using filter_equals_takeWhile_sorted_rev[OF sorted, of 0] by simp { fix i assume "i < length ?R" with less_le_trans[OF _ length_takeWhile_le[of _ xs]] have "i < length xs" by simp } note * = this show ?thesis by (rule nth_equalityI) (simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth) qed theorem transpose_rectangle: assumes "xs = [] \ n = 0" assumes rect: "\ i. i < length xs \ length (xs ! i) = n" shows "transpose xs = map (\ i. map (\ j. xs ! j ! i) [0..ys. i < length ys) xs = xs" using rect by (auto simp: in_set_conv_nth intro!: filter_True) } ultimately show "\i. i < length (transpose xs) \ ?trans ! i = ?map ! i" by (auto simp: nth_transpose intro: nth_equalityI) qed subsubsection \\sorted_list_of_set\\ text\This function maps (finite) linearly ordered sets to sorted lists. Warning: in most cases it is not a good idea to convert from sets to lists but one should convert in the other direction (via \<^const>\set\).\ context linorder begin definition sorted_list_of_set :: "'a set \ 'a list" where "sorted_list_of_set = folding.F insort []" sublocale sorted_list_of_set: folding insort Nil rewrites "folding.F insort [] = sorted_list_of_set" proof - interpret comp_fun_commute insort by (fact comp_fun_commute_insort) show "folding insort" by standard (fact comp_fun_commute) show "folding.F insort [] = sorted_list_of_set" by (simp only: sorted_list_of_set_def) qed lemma sorted_list_of_set_empty: "sorted_list_of_set {} = []" by (fact sorted_list_of_set.empty) lemma sorted_list_of_set_insert [simp]: "finite A \ sorted_list_of_set (insert x A) = insort x (sorted_list_of_set (A - {x}))" by (fact sorted_list_of_set.insert_remove) lemma sorted_list_of_set_eq_Nil_iff [simp]: "finite A \ sorted_list_of_set A = [] \ A = {}" by (auto simp: sorted_list_of_set.remove) lemma set_sorted_list_of_set [simp]: "finite A \ set (sorted_list_of_set A) = A" by(induct A rule: finite_induct) (simp_all add: set_insort_key) lemma sorted_sorted_list_of_set [simp]: "sorted (sorted_list_of_set A)" proof (cases "finite A") case True thus ?thesis by(induction A) (simp_all add: sorted_insort) next case False thus ?thesis by simp qed lemma distinct_sorted_list_of_set [simp]: "distinct (sorted_list_of_set A)" proof (cases "finite A") case True thus ?thesis by(induction A) (simp_all add: distinct_insort) next case False thus ?thesis by simp qed lemma length_sorted_list_of_set [simp]: "length (sorted_list_of_set A) = card A" proof (cases "finite A") case True then show ?thesis by(metis distinct_card distinct_sorted_list_of_set set_sorted_list_of_set) qed auto lemmas sorted_list_of_set = set_sorted_list_of_set sorted_sorted_list_of_set distinct_sorted_list_of_set lemma sorted_list_of_set_sort_remdups [code]: "sorted_list_of_set (set xs) = sort (remdups xs)" proof - interpret comp_fun_commute insort by (fact comp_fun_commute_insort) show ?thesis by (simp add: sorted_list_of_set.eq_fold sort_conv_fold fold_set_fold_remdups) qed lemma sorted_list_of_set_remove: assumes "finite A" shows "sorted_list_of_set (A - {x}) = remove1 x (sorted_list_of_set A)" proof (cases "x \ A") case False with assms have "x \ set (sorted_list_of_set A)" by simp with False show ?thesis by (simp add: remove1_idem) next case True then obtain B where A: "A = insert x B" by (rule Set.set_insert) with assms show ?thesis by simp qed lemma strict_sorted_list_of_set [simp]: "strict_sorted (sorted_list_of_set A)" by (simp add: strict_sorted_iff) lemma finite_set_strict_sorted: assumes "finite A" obtains l where "strict_sorted l" "set l = A" "length l = card A" by (metis assms distinct_card distinct_sorted_list_of_set set_sorted_list_of_set strict_sorted_list_of_set) lemma strict_sorted_equal: assumes "strict_sorted xs" and "strict_sorted ys" and "set ys = set xs" shows "ys = xs" using assms proof (induction xs arbitrary: ys) case (Cons x xs) show ?case proof (cases ys) case Nil then show ?thesis using Cons.prems by auto next case (Cons y ys') then have "xs = ys'" by (metis Cons.prems list.inject sorted_distinct_set_unique strict_sorted_iff) moreover have "x = y" using Cons.prems \xs = ys'\ local.Cons by fastforce ultimately show ?thesis using local.Cons by blast qed qed auto lemma strict_sorted_equal_Uniq: "\\<^sub>\\<^sub>1xs. strict_sorted xs \ set xs = A" by (simp add: Uniq_def strict_sorted_equal) lemma sorted_list_of_set_inject: assumes "sorted_list_of_set A = sorted_list_of_set B" "finite A" "finite B" shows "A = B" using assms set_sorted_list_of_set by fastforce lemma sorted_list_of_set_unique: assumes "finite A" shows "strict_sorted l \ set l = A \ length l = card A \ sorted_list_of_set A = l" using assms strict_sorted_equal by force end lemma sorted_list_of_set_range [simp]: "sorted_list_of_set {m.. {}" shows "sorted_list_of_set A = Min A # sorted_list_of_set (A - {Min A})" using assms by (auto simp: less_le simp flip: sorted_list_of_set_unique intro: Min_in) lemma sorted_list_of_set_greaterThanLessThan: assumes "Suc i < j" shows "sorted_list_of_set {i<.. j" shows "sorted_list_of_set {i<..j} = Suc i # sorted_list_of_set {Suc i<..j}" using sorted_list_of_set_greaterThanLessThan [of i "Suc j"] by (metis assms greaterThanAtMost_def greaterThanLessThan_eq le_imp_less_Suc lessThan_Suc_atMost) lemma nth_sorted_list_of_set_greaterThanLessThan: "n < j - Suc i \ sorted_list_of_set {i<.. sorted_list_of_set {i<..j} ! n = Suc (i+n)" using nth_sorted_list_of_set_greaterThanLessThan [of n "Suc j" i] by (simp add: greaterThanAtMost_def greaterThanLessThan_eq lessThan_Suc_atMost) subsubsection \\lists\: the list-forming operator over sets\ inductive_set lists :: "'a set => 'a list set" for A :: "'a set" where Nil [intro!, simp]: "[] \ lists A" | Cons [intro!, simp]: "\a \ A; l \ lists A\ \ a#l \ lists A" inductive_cases listsE [elim!]: "x#l \ lists A" inductive_cases listspE [elim!]: "listsp A (x # l)" inductive_simps listsp_simps[code]: "listsp A []" "listsp A (x # xs)" lemma listsp_mono [mono]: "A \ B \ listsp A \ listsp B" by (rule predicate1I, erule listsp.induct, blast+) lemmas lists_mono = listsp_mono [to_set] lemma listsp_infI: assumes l: "listsp A l" shows "listsp B l \ listsp (inf A B) l" using l by induct blast+ lemmas lists_IntI = listsp_infI [to_set] lemma listsp_inf_eq [simp]: "listsp (inf A B) = inf (listsp A) (listsp B)" proof (rule mono_inf [where f=listsp, THEN order_antisym]) show "mono listsp" by (simp add: mono_def listsp_mono) show "inf (listsp A) (listsp B) \ listsp (inf A B)" by (blast intro!: listsp_infI) qed lemmas listsp_conj_eq [simp] = listsp_inf_eq [simplified inf_fun_def inf_bool_def] lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set] lemma Cons_in_lists_iff[simp]: "x#xs \ lists A \ x \ A \ xs \ lists A" by auto lemma append_in_listsp_conv [iff]: "(listsp A (xs @ ys)) = (listsp A xs \ listsp A ys)" by (induct xs) auto lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set] lemma in_listsp_conv_set: "(listsp A xs) = (\x \ set xs. A x)" \ \eliminate \listsp\ in favour of \set\\ by (induct xs) auto lemmas in_lists_conv_set [code_unfold] = in_listsp_conv_set [to_set] lemma in_listspD [dest!]: "listsp A xs \ \x\set xs. A x" by (rule in_listsp_conv_set [THEN iffD1]) lemmas in_listsD [dest!] = in_listspD [to_set] lemma in_listspI [intro!]: "\x\set xs. A x \ listsp A xs" by (rule in_listsp_conv_set [THEN iffD2]) lemmas in_listsI [intro!] = in_listspI [to_set] lemma lists_eq_set: "lists A = {xs. set xs \ A}" by auto lemma lists_empty [simp]: "lists {} = {[]}" by auto lemma lists_UNIV [simp]: "lists UNIV = UNIV" by auto lemma lists_image: "lists (f`A) = map f ` lists A" proof - { fix xs have "\x\set xs. x \ f ` A \ xs \ map f ` lists A" by (induct xs) (auto simp del: list.map simp add: list.map[symmetric] intro!: imageI) } then show ?thesis by auto qed subsubsection \Inductive definition for membership\ inductive ListMem :: "'a \ 'a list \ bool" where elem: "ListMem x (x # xs)" | insert: "ListMem x xs \ ListMem x (y # xs)" lemma ListMem_iff: "(ListMem x xs) = (x \ set xs)" proof show "ListMem x xs \ x \ set xs" by (induct set: ListMem) auto show "x \ set xs \ ListMem x xs" by (induct xs) (auto intro: ListMem.intros) qed subsubsection \Lists as Cartesian products\ text\\set_Cons A Xs\: the set of lists with head drawn from \<^term>\A\ and tail drawn from \<^term>\Xs\.\ definition set_Cons :: "'a set \ 'a list set \ 'a list set" where "set_Cons A XS = {z. \x xs. z = x # xs \ x \ A \ xs \ XS}" lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A" by (auto simp add: set_Cons_def) text\Yields the set of lists, all of the same length as the argument and with elements drawn from the corresponding element of the argument.\ primrec listset :: "'a set list \ 'a list set" where "listset [] = {[]}" | "listset (A # As) = set_Cons A (listset As)" subsection \Relations on Lists\ subsubsection \Length Lexicographic Ordering\ text\These orderings preserve well-foundedness: shorter lists precede longer lists. These ordering are not used in dictionaries.\ primrec \ \The lexicographic ordering for lists of the specified length\ lexn :: "('a \ 'a) set \ nat \ ('a list \ 'a list) set" where "lexn r 0 = {}" | "lexn r (Suc n) = (map_prod (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int {(xs, ys). length xs = Suc n \ length ys = Suc n}" definition lex :: "('a \ 'a) set \ ('a list \ 'a list) set" where "lex r = (\n. lexn r n)" \ \Holds only between lists of the same length\ definition lenlex :: "('a \ 'a) set => ('a list \ 'a list) set" where "lenlex r = inv_image (less_than <*lex*> lex r) (\xs. (length xs, xs))" \ \Compares lists by their length and then lexicographically\ lemma wf_lexn: assumes "wf r" shows "wf (lexn r n)" proof (induct n) case (Suc n) have inj: "inj (\(x, xs). x # xs)" using assms by (auto simp: inj_on_def) have wf: "wf (map_prod (\(x, xs). x # xs) (\(x, xs). x # xs) ` (r <*lex*> lexn r n))" by (simp add: Suc.hyps assms wf_lex_prod wf_map_prod_image [OF _ inj]) then show ?case by (rule wf_subset) auto qed auto lemma lexn_length: "(xs, ys) \ lexn r n \ length xs = n \ length ys = n" by (induct n arbitrary: xs ys) auto lemma wf_lex [intro!]: assumes "wf r" shows "wf (lex r)" unfolding lex_def proof (rule wf_UN) show "wf (lexn r i)" for i by (simp add: assms wf_lexn) show "\i j. lexn r i \ lexn r j \ Domain (lexn r i) \ Range (lexn r j) = {}" by (metis DomainE Int_emptyI RangeE lexn_length) qed lemma lexn_conv: "lexn r n = {(xs,ys). length xs = n \ length ys = n \ (\xys x y xs' ys'. xs= xys @ x#xs' \ ys= xys @ y # ys' \ (x, y) \ r)}" proof (induction n) case (Suc n) then show ?case apply (simp add: image_Collect lex_prod_def, safe, blast) apply (rule_tac x = "ab # xys" in exI, simp) apply (case_tac xys; force) done qed auto text\By Mathias Fleury:\ proposition lexn_transI: assumes "trans r" shows "trans (lexn r n)" unfolding trans_def proof (intro allI impI) fix as bs cs assume asbs: "(as, bs) \ lexn r n" and bscs: "(bs, cs) \ lexn r n" obtain abs a b as' bs' where n: "length as = n" and "length bs = n" and as: "as = abs @ a # as'" and bs: "bs = abs @ b # bs'" and abr: "(a, b) \ r" using asbs unfolding lexn_conv by blast obtain bcs b' c' cs' bs' where n': "length cs = n" and "length bs = n" and bs': "bs = bcs @ b' # bs'" and cs: "cs = bcs @ c' # cs'" and b'c'r: "(b', c') \ r" using bscs unfolding lexn_conv by blast consider (le) "length bcs < length abs" | (eq) "length bcs = length abs" | (ge) "length bcs > length abs" by linarith thus "(as, cs) \ lexn r n" proof cases let ?k = "length bcs" case le hence "as ! ?k = bs ! ?k" unfolding as bs by (simp add: nth_append) hence "(as ! ?k, cs ! ?k) \ r" using b'c'r unfolding bs' cs by auto moreover have "length bcs < length as" using le unfolding as by simp from id_take_nth_drop[OF this] have "as = take ?k as @ as ! ?k # drop (Suc ?k) as" . moreover have "length bcs < length cs" unfolding cs by simp from id_take_nth_drop[OF this] have "cs = take ?k cs @ cs ! ?k # drop (Suc ?k) cs" . moreover have "take ?k as = take ?k cs" using le arg_cong[OF bs, of "take (length bcs)"] unfolding cs as bs' by auto ultimately show ?thesis using n n' unfolding lexn_conv by auto next let ?k = "length abs" case ge hence "bs ! ?k = cs ! ?k" unfolding bs' cs by (simp add: nth_append) hence "(as ! ?k, cs ! ?k) \ r" using abr unfolding as bs by auto moreover have "length abs < length as" using ge unfolding as by simp from id_take_nth_drop[OF this] have "as = take ?k as @ as ! ?k # drop (Suc ?k) as" . moreover have "length abs < length cs" using n n' unfolding as by simp from id_take_nth_drop[OF this] have "cs = take ?k cs @ cs ! ?k # drop (Suc ?k) cs" . moreover have "take ?k as = take ?k cs" using ge arg_cong[OF bs', of "take (length abs)"] unfolding cs as bs by auto ultimately show ?thesis using n n' unfolding lexn_conv by auto next let ?k = "length abs" case eq hence *: "abs = bcs" "b = b'" using bs bs' by auto hence "(a, c') \ r" using abr b'c'r assms unfolding trans_def by blast with * show ?thesis using n n' unfolding lexn_conv as bs cs by auto qed qed corollary lex_transI: assumes "trans r" shows "trans (lex r)" using lexn_transI [OF assms] by (clarsimp simp add: lex_def trans_def) (metis lexn_length) lemma lex_conv: "lex r = {(xs,ys). length xs = length ys \ (\xys x y xs' ys'. xs = xys @ x # xs' \ ys = xys @ y # ys' \ (x, y) \ r)}" by (force simp add: lex_def lexn_conv) lemma wf_lenlex [intro!]: "wf r \ wf (lenlex r)" by (unfold lenlex_def) blast lemma lenlex_conv: "lenlex r = {(xs,ys). length xs < length ys \ length xs = length ys \ (xs, ys) \ lex r}" by (auto simp add: lenlex_def Id_on_def lex_prod_def inv_image_def) lemma total_lenlex: assumes "total r" shows "total (lenlex r)" proof - have "(xs,ys) \ lexn r (length xs) \ (ys,xs) \ lexn r (length xs)" if "xs \ ys" and len: "length xs = length ys" for xs ys proof - obtain pre x xs' y ys' where "x\y" and xs: "xs = pre @ [x] @ xs'" and ys: "ys = pre @ [y] @ys'" by (meson len \xs \ ys\ same_length_different) then consider "(x,y) \ r" | "(y,x) \ r" by (meson UNIV_I assms total_on_def) then show ?thesis by cases (use len in \(force simp add: lexn_conv xs ys)+\) qed then show ?thesis by (fastforce simp: lenlex_def total_on_def lex_def) qed lemma lenlex_transI [intro]: "trans r \ trans (lenlex r)" unfolding lenlex_def by (meson lex_transI trans_inv_image trans_less_than trans_lex_prod) lemma Nil_notin_lex [iff]: "([], ys) \ lex r" by (simp add: lex_conv) lemma Nil2_notin_lex [iff]: "(xs, []) \ lex r" by (simp add:lex_conv) lemma Cons_in_lex [simp]: "(x # xs, y # ys) \ lex r \ (x, y) \ r \ length xs = length ys \ x = y \ (xs, ys) \ lex r" (is "?lhs = ?rhs") proof assume ?lhs then show ?rhs by (simp add: lex_conv) (metis hd_append list.sel(1) list.sel(3) tl_append2) next assume ?rhs then show ?lhs by (simp add: lex_conv) (blast intro: Cons_eq_appendI) qed lemma Nil_lenlex_iff1 [simp]: "([], ns) \ lenlex r \ ns \ []" and Nil_lenlex_iff2 [simp]: "(ns,[]) \ lenlex r" by (auto simp: lenlex_def) lemma Cons_lenlex_iff: "((m # ms, n # ns) \ lenlex r) \ length ms < length ns \ length ms = length ns \ (m,n) \ r \ (m = n \ (ms,ns) \ lenlex r)" by (auto simp: lenlex_def) lemma lenlex_irreflexive: "(\x. (x,x) \ r) \ (xs,xs) \ lenlex r" by (induction xs) (auto simp add: Cons_lenlex_iff) lemma lenlex_trans: "\(x,y) \ lenlex r; (y,z) \ lenlex r; trans r\ \ (x,z) \ lenlex r" by (meson lenlex_transI transD) lemma lenlex_length: "(ms, ns) \ lenlex r \ length ms \ length ns" by (auto simp: lenlex_def) lemma lex_append_rightI: "(xs, ys) \ lex r \ length vs = length us \ (xs @ us, ys @ vs) \ lex r" by (fastforce simp: lex_def lexn_conv) lemma lex_append_leftI: "(ys, zs) \ lex r \ (xs @ ys, xs @ zs) \ lex r" by (induct xs) auto lemma lex_append_leftD: "\x. (x,x) \ r \ (xs @ ys, xs @ zs) \ lex r \ (ys, zs) \ lex r" by (induct xs) auto lemma lex_append_left_iff: "\x. (x,x) \ r \ (xs @ ys, xs @ zs) \ lex r \ (ys, zs) \ lex r" by(metis lex_append_leftD lex_append_leftI) lemma lex_take_index: assumes "(xs, ys) \ lex r" obtains i where "i < length xs" and "i < length ys" and "take i xs = take i ys" and "(xs ! i, ys ! i) \ r" proof - obtain n us x xs' y ys' where "(xs, ys) \ lexn r n" and "length xs = n" and "length ys = n" and "xs = us @ x # xs'" and "ys = us @ y # ys'" and "(x, y) \ r" using assms by (fastforce simp: lex_def lexn_conv) then show ?thesis by (intro that [of "length us"]) auto qed lemma irrefl_lex: "irrefl r \ irrefl (lex r)" by (meson irrefl_def lex_take_index) lemma lexl_not_refl [simp]: "irrefl r \ (x,x) \ lex r" by (meson irrefl_def lex_take_index) subsubsection \Lexicographic Ordering\ text \Classical lexicographic ordering on lists, ie. "a" < "ab" < "b". This ordering does \emph{not} preserve well-foundedness. Author: N. Voelker, March 2005.\ definition lexord :: "('a \ 'a) set \ ('a list \ 'a list) set" where "lexord r = {(x,y). \ a v. y = x @ a # v \ (\ u a b v w. (a,b) \ r \ x = u @ (a # v) \ y = u @ (b # w))}" lemma lexord_Nil_left[simp]: "([],y) \ lexord r = (\ a x. y = a # x)" by (unfold lexord_def, induct_tac y, auto) lemma lexord_Nil_right[simp]: "(x,[]) \ lexord r" by (unfold lexord_def, induct_tac x, auto) lemma lexord_cons_cons[simp]: "(a # x, b # y) \ lexord r \ (a,b)\ r \ (a = b \ (x,y)\ lexord r)" (is "?lhs = ?rhs") proof assume ?lhs then show ?rhs apply (simp add: lexord_def) apply (metis hd_append list.sel(1) list.sel(3) tl_append2) done qed (auto simp add: lexord_def; (blast | meson Cons_eq_appendI)) lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons lemma lexord_same_pref_iff: "(xs @ ys, xs @ zs) \ lexord r \ (\x \ set xs. (x,x) \ r) \ (ys, zs) \ lexord r" by(induction xs) auto lemma lexord_same_pref_if_irrefl[simp]: "irrefl r \ (xs @ ys, xs @ zs) \ lexord r \ (ys, zs) \ lexord r" by (simp add: irrefl_def lexord_same_pref_iff) lemma lexord_append_rightI: "\ b z. y = b # z \ (x, x @ y) \ lexord r" by (metis append_Nil2 lexord_Nil_left lexord_same_pref_iff) lemma lexord_append_left_rightI: "(a,b) \ r \ (u @ a # x, u @ b # y) \ lexord r" by (simp add: lexord_same_pref_iff) lemma lexord_append_leftI: "(u,v) \ lexord r \ (x @ u, x @ v) \ lexord r" by (simp add: lexord_same_pref_iff) lemma lexord_append_leftD: "\(x @ u, x @ v) \ lexord r; (\a. (a,a) \ r) \ \ (u,v) \ lexord r" by (simp add: lexord_same_pref_iff) lemma lexord_take_index_conv: "((x,y) \ lexord r) = ((length x < length y \ take (length x) y = x) \ (\i. i < min(length x)(length y) \ take i x = take i y \ (x!i,y!i) \ r))" proof - have "(\a v. y = x @ a # v) = (length x < length y \ take (length x) y = x)" by (metis Cons_nth_drop_Suc append_eq_conv_conj drop_all list.simps(3) not_le) moreover have "(\u a b. (a, b) \ r \ (\v. x = u @ a # v) \ (\w. y = u @ b # w)) = (\i take i x = take i y \ (x ! i, y ! i) \ r)" apply safe using less_iff_Suc_add apply auto[1] by (metis id_take_nth_drop) ultimately show ?thesis by (auto simp: lexord_def Let_def) qed \ \lexord is extension of partial ordering List.lex\ lemma lexord_lex: "(x,y) \ lex r = ((x,y) \ lexord r \ length x = length y)" proof (induction x arbitrary: y) case (Cons a x y) then show ?case by (cases y) (force+) qed auto lemma lexord_sufI: assumes "(u,w) \ lexord r" "length w \ length u" shows "(u@v,w@z) \ lexord r" proof- from leD[OF assms(2)] assms(1)[unfolded lexord_take_index_conv[of u w r] min_absorb2[OF assms(2)]] obtain i where "take i u = take i w" and "(u!i,w!i) \ r" and "i < length w" by blast hence "((u@v)!i, (w@z)!i) \ r" unfolding nth_append using less_le_trans[OF \i < length w\ assms(2)] \(u!i,w!i) \ r\ by presburger moreover have "i < min (length (u@v)) (length (w@z))" using assms(2) \i < length w\ by simp moreover have "take i (u@v) = take i (w@z)" using assms(2) \i < length w\ \take i u = take i w\ by simp ultimately show ?thesis using lexord_take_index_conv by blast qed lemma lexord_sufE: assumes "(xs@zs,ys@qs) \ lexord r" "xs \ ys" "length xs = length ys" "length zs = length qs" shows "(xs,ys) \ lexord r" proof- obtain i where "i < length (xs@zs)" and "i < length (ys@qs)" and "take i (xs@zs) = take i (ys@qs)" and "((xs@zs) ! i, (ys@qs) ! i) \ r" using assms(1) lex_take_index[unfolded lexord_lex,of "xs @ zs" "ys @ qs" r] length_append[of xs zs, unfolded assms(3,4), folded length_append[of ys qs]] by blast have "length (take i xs) = length (take i ys)" by (simp add: assms(3)) have "i < length xs" using assms(2,3) le_less_linear take_all[of xs i] take_all[of ys i] \take i (xs @ zs) = take i (ys @ qs)\ append_eq_append_conv take_append by metis hence "(xs ! i, ys ! i) \ r" using \((xs @ zs) ! i, (ys @ qs) ! i) \ r\ assms(3) by (simp add: nth_append) moreover have "take i xs = take i ys" using assms(3) \take i (xs @ zs) = take i (ys @ qs)\ by auto ultimately show ?thesis unfolding lexord_take_index_conv using \i < length xs\ assms(3) by fastforce qed lemma lexord_irreflexive: "\x. (x,x) \ r \ (xs,xs) \ lexord r" by (induct xs) auto text\By Ren\'e Thiemann:\ lemma lexord_partial_trans: "(\x y z. x \ set xs \ (x,y) \ r \ (y,z) \ r \ (x,z) \ r) \ (xs,ys) \ lexord r \ (ys,zs) \ lexord r \ (xs,zs) \ lexord r" proof (induct xs arbitrary: ys zs) case Nil from Nil(3) show ?case unfolding lexord_def by (cases zs, auto) next case (Cons x xs yys zzs) from Cons(3) obtain y ys where yys: "yys = y # ys" unfolding lexord_def by (cases yys, auto) note Cons = Cons[unfolded yys] from Cons(3) have one: "(x,y) \ r \ x = y \ (xs,ys) \ lexord r" by auto from Cons(4) obtain z zs where zzs: "zzs = z # zs" unfolding lexord_def by (cases zzs, auto) note Cons = Cons[unfolded zzs] from Cons(4) have two: "(y,z) \ r \ y = z \ (ys,zs) \ lexord r" by auto { assume "(xs,ys) \ lexord r" and "(ys,zs) \ lexord r" from Cons(1)[OF _ this] Cons(2) have "(xs,zs) \ lexord r" by auto } note ind1 = this { assume "(x,y) \ r" and "(y,z) \ r" from Cons(2)[OF _ this] have "(x,z) \ r" by auto } note ind2 = this from one two ind1 ind2 have "(x,z) \ r \ x = z \ (xs,zs) \ lexord r" by blast thus ?case unfolding zzs by auto qed lemma lexord_trans: "\ (x, y) \ lexord r; (y, z) \ lexord r; trans r \ \ (x, z) \ lexord r" by(auto simp: trans_def intro:lexord_partial_trans) lemma lexord_transI: "trans r \ trans (lexord r)" by (meson lexord_trans transI) lemma total_lexord: "total r \ total (lexord r)" unfolding total_on_def proof clarsimp fix x y assume "\x y. x \ y \ (x, y) \ r \ (y, x) \ r" and "(x::'a list) \ y" and "(y, x) \ lexord r" then show "(x, y) \ lexord r" proof (induction x arbitrary: y) case Nil then show ?case by (metis lexord_Nil_left list.exhaust) next case (Cons a x y) then show ?case by (cases y) (force+) qed qed corollary lexord_linear: "(\a b. (a,b) \ r \ a = b \ (b,a) \ r) \ (x,y) \ lexord r \ x = y \ (y,x) \ lexord r" using total_lexord by (metis UNIV_I total_on_def) lemma lexord_irrefl: "irrefl R \ irrefl (lexord R)" by (simp add: irrefl_def lexord_irreflexive) lemma lexord_asym: assumes "asym R" shows "asym (lexord R)" proof fix xs ys assume "(xs, ys) \ lexord R" then show "(ys, xs) \ lexord R" proof (induct xs arbitrary: ys) case Nil then show ?case by simp next case (Cons x xs) then obtain z zs where ys: "ys = z # zs" by (cases ys) auto with assms Cons show ?case by (auto elim: asym.cases) qed qed lemma lexord_asymmetric: assumes "asym R" assumes hyp: "(a, b) \ lexord R" shows "(b, a) \ lexord R" proof - from \asym R\ have "asym (lexord R)" by (rule lexord_asym) then show ?thesis by (rule asym.cases) (auto simp add: hyp) qed lemma asym_lex: "asym R \ asym (lex R)" by (meson asym.simps irrefl_lex lexord_asym lexord_lex) lemma asym_lenlex: "asym R \ asym (lenlex R)" by (simp add: lenlex_def asym_inv_image asym_less_than asym_lex asym_lex_prod) lemma lenlex_append1: assumes len: "(us,xs) \ lenlex R" and eq: "length vs = length ys" shows "(us @ vs, xs @ ys) \ lenlex R" using len proof (induction us) case Nil then show ?case by (simp add: lenlex_def eq) next case (Cons u us) with lex_append_rightI show ?case by (fastforce simp add: lenlex_def eq) qed lemma lenlex_append2 [simp]: assumes "irrefl R" shows "(us @ xs, us @ ys) \ lenlex R \ (xs, ys) \ lenlex R" proof (induction us) case Nil then show ?case by (simp add: lenlex_def) next case (Cons u us) with assms show ?case by (auto simp: lenlex_def irrefl_def) qed text \ Predicate version of lexicographic order integrated with Isabelle's order type classes. Author: Andreas Lochbihler \ context ord begin context notes [[inductive_internals]] begin inductive lexordp :: "'a list \ 'a list \ bool" where Nil: "lexordp [] (y # ys)" | Cons: "x < y \ lexordp (x # xs) (y # ys)" | Cons_eq: "\ \ x < y; \ y < x; lexordp xs ys \ \ lexordp (x # xs) (y # ys)" end lemma lexordp_simps [simp]: "lexordp [] ys = (ys \ [])" "lexordp xs [] = False" "lexordp (x # xs) (y # ys) \ x < y \ \ y < x \ lexordp xs ys" by(subst lexordp.simps, fastforce simp add: neq_Nil_conv)+ inductive lexordp_eq :: "'a list \ 'a list \ bool" where Nil: "lexordp_eq [] ys" | Cons: "x < y \ lexordp_eq (x # xs) (y # ys)" | Cons_eq: "\ \ x < y; \ y < x; lexordp_eq xs ys \ \ lexordp_eq (x # xs) (y # ys)" lemma lexordp_eq_simps [simp]: "lexordp_eq [] ys = True" "lexordp_eq xs [] \ xs = []" "lexordp_eq (x # xs) [] = False" "lexordp_eq (x # xs) (y # ys) \ x < y \ \ y < x \ lexordp_eq xs ys" by(subst lexordp_eq.simps, fastforce)+ lemma lexordp_append_rightI: "ys \ Nil \ lexordp xs (xs @ ys)" by(induct xs)(auto simp add: neq_Nil_conv) lemma lexordp_append_left_rightI: "x < y \ lexordp (us @ x # xs) (us @ y # ys)" by(induct us) auto lemma lexordp_eq_refl: "lexordp_eq xs xs" by(induct xs) simp_all lemma lexordp_append_leftI: "lexordp us vs \ lexordp (xs @ us) (xs @ vs)" by(induct xs) auto lemma lexordp_append_leftD: "\ lexordp (xs @ us) (xs @ vs); \a. \ a < a \ \ lexordp us vs" by(induct xs) auto lemma lexordp_irreflexive: assumes irrefl: "\x. \ x < x" shows "\ lexordp xs xs" proof assume "lexordp xs xs" thus False by(induct xs ys\xs)(simp_all add: irrefl) qed lemma lexordp_into_lexordp_eq: "lexordp xs ys \ lexordp_eq xs ys" by (induction rule: lexordp.induct) simp_all lemma lexordp_eq_pref: "lexordp_eq u (u @ v)" by (metis append_Nil2 lexordp_append_rightI lexordp_eq_refl lexordp_into_lexordp_eq) end declare ord.lexordp_simps [simp, code] declare ord.lexordp_eq_simps [code, simp] context order begin lemma lexordp_antisym: assumes "lexordp xs ys" "lexordp ys xs" shows False using assms by induct auto lemma lexordp_irreflexive': "\ lexordp xs xs" by(rule lexordp_irreflexive) simp end context linorder begin lemma lexordp_cases [consumes 1, case_names Nil Cons Cons_eq, cases pred: lexordp]: assumes "lexordp xs ys" obtains (Nil) y ys' where "xs = []" "ys = y # ys'" | (Cons) x xs' y ys' where "xs = x # xs'" "ys = y # ys'" "x < y" | (Cons_eq) x xs' ys' where "xs = x # xs'" "ys = x # ys'" "lexordp xs' ys'" using assms by cases (fastforce simp add: not_less_iff_gr_or_eq)+ lemma lexordp_induct [consumes 1, case_names Nil Cons Cons_eq, induct pred: lexordp]: assumes major: "lexordp xs ys" and Nil: "\y ys. P [] (y # ys)" and Cons: "\x xs y ys. x < y \ P (x # xs) (y # ys)" and Cons_eq: "\x xs ys. \ lexordp xs ys; P xs ys \ \ P (x # xs) (x # ys)" shows "P xs ys" using major by induct (simp_all add: Nil Cons not_less_iff_gr_or_eq Cons_eq) lemma lexordp_iff: "lexordp xs ys \ (\x vs. ys = xs @ x # vs) \ (\us a b vs ws. a < b \ xs = us @ a # vs \ ys = us @ b # ws)" (is "?lhs = ?rhs") proof assume ?lhs thus ?rhs proof induct case Cons_eq thus ?case by simp (metis append.simps(2)) qed(fastforce intro: disjI2 del: disjCI intro: exI[where x="[]"])+ next assume ?rhs thus ?lhs by(auto intro: lexordp_append_leftI[where us="[]", simplified] lexordp_append_leftI) qed lemma lexordp_conv_lexord: "lexordp xs ys \ (xs, ys) \ lexord {(x, y). x < y}" by(simp add: lexordp_iff lexord_def) lemma lexordp_eq_antisym: assumes "lexordp_eq xs ys" "lexordp_eq ys xs" shows "xs = ys" using assms by induct simp_all lemma lexordp_eq_trans: assumes "lexordp_eq xs ys" and "lexordp_eq ys zs" shows "lexordp_eq xs zs" using assms by (induct arbitrary: zs) (case_tac zs; auto)+ lemma lexordp_trans: assumes "lexordp xs ys" "lexordp ys zs" shows "lexordp xs zs" using assms by (induct arbitrary: zs) (case_tac zs; auto)+ lemma lexordp_linear: "lexordp xs ys \ xs = ys \ lexordp ys xs" by(induct xs arbitrary: ys; case_tac ys; fastforce) lemma lexordp_conv_lexordp_eq: "lexordp xs ys \ lexordp_eq xs ys \ \ lexordp_eq ys xs" (is "?lhs \ ?rhs") proof assume ?lhs hence "\ lexordp_eq ys xs" by induct simp_all with \?lhs\ show ?rhs by (simp add: lexordp_into_lexordp_eq) next assume ?rhs hence "lexordp_eq xs ys" "\ lexordp_eq ys xs" by simp_all thus ?lhs by induct simp_all qed lemma lexordp_eq_conv_lexord: "lexordp_eq xs ys \ xs = ys \ lexordp xs ys" by(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl dest: lexordp_eq_antisym) lemma lexordp_eq_linear: "lexordp_eq xs ys \ lexordp_eq ys xs" by (induct xs arbitrary: ys) (case_tac ys; auto)+ lemma lexordp_linorder: "class.linorder lexordp_eq lexordp" by unfold_locales (auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl lexordp_eq_antisym intro: lexordp_eq_trans del: disjCI intro: lexordp_eq_linear) end lemma sorted_insort_is_snoc: "sorted xs \ \x \ set xs. a \ x \ insort a xs = xs @ [a]" by (induct xs) (auto dest!: insort_is_Cons) subsubsection \Lexicographic combination of measure functions\ text \These are useful for termination proofs\ definition "measures fs = inv_image (lex less_than) (%a. map (%f. f a) fs)" lemma wf_measures[simp]: "wf (measures fs)" unfolding measures_def by blast lemma in_measures[simp]: "(x, y) \ measures [] = False" "(x, y) \ measures (f # fs) = (f x < f y \ (f x = f y \ (x, y) \ measures fs))" unfolding measures_def by auto lemma measures_less: "f x < f y \ (x, y) \ measures (f#fs)" by simp lemma measures_lesseq: "f x \ f y \ (x, y) \ measures fs \ (x, y) \ measures (f#fs)" by auto subsubsection \Lifting Relations to Lists: one element\ definition listrel1 :: "('a \ 'a) set \ ('a list \ 'a list) set" where "listrel1 r = {(xs,ys). \us z z' vs. xs = us @ z # vs \ (z,z') \ r \ ys = us @ z' # vs}" lemma listrel1I: "\ (x, y) \ r; xs = us @ x # vs; ys = us @ y # vs \ \ (xs, ys) \ listrel1 r" unfolding listrel1_def by auto lemma listrel1E: "\ (xs, ys) \ listrel1 r; !!x y us vs. \ (x, y) \ r; xs = us @ x # vs; ys = us @ y # vs \ \ P \ \ P" unfolding listrel1_def by auto lemma not_Nil_listrel1 [iff]: "([], xs) \ listrel1 r" unfolding listrel1_def by blast lemma not_listrel1_Nil [iff]: "(xs, []) \ listrel1 r" unfolding listrel1_def by blast lemma Cons_listrel1_Cons [iff]: "(x # xs, y # ys) \ listrel1 r \ (x,y) \ r \ xs = ys \ x = y \ (xs, ys) \ listrel1 r" by (simp add: listrel1_def Cons_eq_append_conv) (blast) lemma listrel1I1: "(x,y) \ r \ (x # xs, y # xs) \ listrel1 r" by fast lemma listrel1I2: "(xs, ys) \ listrel1 r \ (x # xs, x # ys) \ listrel1 r" by fast lemma append_listrel1I: "(xs, ys) \ listrel1 r \ us = vs \ xs = ys \ (us, vs) \ listrel1 r \ (xs @ us, ys @ vs) \ listrel1 r" unfolding listrel1_def by auto (blast intro: append_eq_appendI)+ lemma Cons_listrel1E1[elim!]: assumes "(x # xs, ys) \ listrel1 r" and "\y. ys = y # xs \ (x, y) \ r \ R" and "\zs. ys = x # zs \ (xs, zs) \ listrel1 r \ R" shows R using assms by (cases ys) blast+ lemma Cons_listrel1E2[elim!]: assumes "(xs, y # ys) \ listrel1 r" and "\x. xs = x # ys \ (x, y) \ r \ R" and "\zs. xs = y # zs \ (zs, ys) \ listrel1 r \ R" shows R using assms by (cases xs) blast+ lemma snoc_listrel1_snoc_iff: "(xs @ [x], ys @ [y]) \ listrel1 r \ (xs, ys) \ listrel1 r \ x = y \ xs = ys \ (x,y) \ r" (is "?L \ ?R") proof assume ?L thus ?R by (fastforce simp: listrel1_def snoc_eq_iff_butlast butlast_append) next assume ?R then show ?L unfolding listrel1_def by force qed lemma listrel1_eq_len: "(xs,ys) \ listrel1 r \ length xs = length ys" unfolding listrel1_def by auto lemma listrel1_mono: "r \ s \ listrel1 r \ listrel1 s" unfolding listrel1_def by blast lemma listrel1_converse: "listrel1 (r\) = (listrel1 r)\" unfolding listrel1_def by blast lemma in_listrel1_converse: "(x,y) \ listrel1 (r\) \ (x,y) \ (listrel1 r)\" unfolding listrel1_def by blast lemma listrel1_iff_update: "(xs,ys) \ (listrel1 r) \ (\y n. (xs ! n, y) \ r \ n < length xs \ ys = xs[n:=y])" (is "?L \ ?R") proof assume "?L" then obtain x y u v where "xs = u @ x # v" "ys = u @ y # v" "(x,y) \ r" unfolding listrel1_def by auto then have "ys = xs[length u := y]" and "length u < length xs" and "(xs ! length u, y) \ r" by auto then show "?R" by auto next assume "?R" then obtain x y n where "(xs!n, y) \ r" "n < size xs" "ys = xs[n:=y]" "x = xs!n" by auto then obtain u v where "xs = u @ x # v" and "ys = u @ y # v" and "(x, y) \ r" by (auto intro: upd_conv_take_nth_drop id_take_nth_drop) then show "?L" by (auto simp: listrel1_def) qed text\Accessible part and wellfoundedness:\ lemma Cons_acc_listrel1I [intro!]: "x \ Wellfounded.acc r \ xs \ Wellfounded.acc (listrel1 r) \ (x # xs) \ Wellfounded.acc (listrel1 r)" apply (induct arbitrary: xs set: Wellfounded.acc) apply (erule thin_rl) apply (erule acc_induct) apply (rule accI) apply (blast) done lemma lists_accD: "xs \ lists (Wellfounded.acc r) \ xs \ Wellfounded.acc (listrel1 r)" proof (induct set: lists) case Nil then show ?case by (meson acc.intros not_listrel1_Nil) next case (Cons a l) then show ?case by blast qed lemma lists_accI: "xs \ Wellfounded.acc (listrel1 r) \ xs \ lists (Wellfounded.acc r)" apply (induct set: Wellfounded.acc) apply clarify apply (rule accI) apply (fastforce dest!: in_set_conv_decomp[THEN iffD1] simp: listrel1_def) done lemma wf_listrel1_iff[simp]: "wf(listrel1 r) = wf r" by (auto simp: wf_acc_iff intro: lists_accD lists_accI[THEN Cons_in_lists_iff[THEN iffD1, THEN conjunct1]]) subsubsection \Lifting Relations to Lists: all elements\ inductive_set listrel :: "('a \ 'b) set \ ('a list \ 'b list) set" for r :: "('a \ 'b) set" where Nil: "([],[]) \ listrel r" | Cons: "\(x,y) \ r; (xs,ys) \ listrel r\ \ (x#xs, y#ys) \ listrel r" inductive_cases listrel_Nil1 [elim!]: "([],xs) \ listrel r" inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \ listrel r" inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \ listrel r" inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \ listrel r" lemma listrel_eq_len: "(xs, ys) \ listrel r \ length xs = length ys" by(induct rule: listrel.induct) auto lemma listrel_iff_zip [code_unfold]: "(xs,ys) \ listrel r \ length xs = length ys \ (\(x,y) \ set(zip xs ys). (x,y) \ r)" (is "?L \ ?R") proof assume ?L thus ?R by induct (auto intro: listrel_eq_len) next assume ?R thus ?L apply (clarify) by (induct rule: list_induct2) (auto intro: listrel.intros) qed lemma listrel_iff_nth: "(xs,ys) \ listrel r \ length xs = length ys \ (\n < length xs. (xs!n, ys!n) \ r)" (is "?L \ ?R") by (auto simp add: all_set_conv_all_nth listrel_iff_zip) lemma listrel_mono: "r \ s \ listrel r \ listrel s" by (meson listrel_iff_nth subrelI subset_eq) lemma listrel_subset: assumes "r \ A \ A" shows "listrel r \ lists A \ lists A" proof clarify show "a \ lists A \ b \ lists A" if "(a, b) \ listrel r" for a b using that assms by (induction rule: listrel.induct, auto) qed lemma listrel_refl_on: assumes "refl_on A r" shows "refl_on (lists A) (listrel r)" proof - have "l \ lists A \ (l, l) \ listrel r" for l using assms unfolding refl_on_def by (induction l, auto intro: listrel.intros) then show ?thesis by (meson assms listrel_subset refl_on_def) qed lemma listrel_sym: "sym r \ sym (listrel r)" by (simp add: listrel_iff_nth sym_def) lemma listrel_trans: assumes "trans r" shows "trans (listrel r)" proof - have "(x, z) \ listrel r" if "(x, y) \ listrel r" "(y, z) \ listrel r" for x y z using that proof induction case (Cons x y xs ys) then show ?case by clarsimp (metis assms listrel.Cons listrel_iff_nth transD) qed auto then show ?thesis using transI by blast qed theorem equiv_listrel: "equiv A r \ equiv (lists A) (listrel r)" by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) lemma listrel_rtrancl_refl[iff]: "(xs,xs) \ listrel(r\<^sup>*)" using listrel_refl_on[of UNIV, OF refl_rtrancl] by(auto simp: refl_on_def) lemma listrel_rtrancl_trans: "\(xs,ys) \ listrel(r\<^sup>*); (ys,zs) \ listrel(r\<^sup>*)\ \ (xs,zs) \ listrel(r\<^sup>*)" by (metis listrel_trans trans_def trans_rtrancl) lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}" by (blast intro: listrel.intros) lemma listrel_Cons: "listrel r `` {x#xs} = set_Cons (r``{x}) (listrel r `` {xs})" by (auto simp add: set_Cons_def intro: listrel.intros) text \Relating \<^term>\listrel1\, \<^term>\listrel\ and closures:\ lemma listrel1_rtrancl_subset_rtrancl_listrel1: "listrel1 (r\<^sup>*) \ (listrel1 r)\<^sup>*" proof (rule subrelI) fix xs ys assume 1: "(xs,ys) \ listrel1 (r\<^sup>*)" { fix x y us vs have "(x,y) \ r\<^sup>* \ (us @ x # vs, us @ y # vs) \ (listrel1 r)\<^sup>*" proof(induct rule: rtrancl.induct) case rtrancl_refl show ?case by simp next case rtrancl_into_rtrancl thus ?case by (metis listrel1I rtrancl.rtrancl_into_rtrancl) qed } thus "(xs,ys) \ (listrel1 r)\<^sup>*" using 1 by(blast elim: listrel1E) qed lemma rtrancl_listrel1_eq_len: "(x,y) \ (listrel1 r)\<^sup>* \ length x = length y" by (induct rule: rtrancl.induct) (auto intro: listrel1_eq_len) lemma rtrancl_listrel1_ConsI1: "(xs,ys) \ (listrel1 r)\<^sup>* \ (x#xs,x#ys) \ (listrel1 r)\<^sup>*" proof (induction rule: rtrancl.induct) case (rtrancl_into_rtrancl a b c) then show ?case by (metis listrel1I2 rtrancl.rtrancl_into_rtrancl) qed auto lemma rtrancl_listrel1_ConsI2: "(x,y) \ r\<^sup>* \ (xs, ys) \ (listrel1 r)\<^sup>* \ (x # xs, y # ys) \ (listrel1 r)\<^sup>*" by (meson in_mono listrel1I1 listrel1_rtrancl_subset_rtrancl_listrel1 rtrancl_listrel1_ConsI1 rtrancl_trans) lemma listrel1_subset_listrel: "r \ r' \ refl r' \ listrel1 r \ listrel(r')" by(auto elim!: listrel1E simp add: listrel_iff_zip set_zip refl_on_def) lemma listrel_reflcl_if_listrel1: "(xs,ys) \ listrel1 r \ (xs,ys) \ listrel(r\<^sup>*)" by(erule listrel1E)(auto simp add: listrel_iff_zip set_zip) lemma listrel_rtrancl_eq_rtrancl_listrel1: "listrel (r\<^sup>*) = (listrel1 r)\<^sup>*" proof { fix x y assume "(x,y) \ listrel (r\<^sup>*)" then have "(x,y) \ (listrel1 r)\<^sup>*" by induct (auto intro: rtrancl_listrel1_ConsI2) } then show "listrel (r\<^sup>*) \ (listrel1 r)\<^sup>*" by (rule subrelI) next show "listrel (r\<^sup>*) \ (listrel1 r)\<^sup>*" proof(rule subrelI) fix xs ys assume "(xs,ys) \ (listrel1 r)\<^sup>*" then show "(xs,ys) \ listrel (r\<^sup>*)" proof induct case base show ?case by(auto simp add: listrel_iff_zip set_zip) next case (step ys zs) thus ?case by (metis listrel_reflcl_if_listrel1 listrel_rtrancl_trans) qed qed qed lemma rtrancl_listrel1_if_listrel: "(xs,ys) \ listrel r \ (xs,ys) \ (listrel1 r)\<^sup>*" by(metis listrel_rtrancl_eq_rtrancl_listrel1 subsetD[OF listrel_mono] r_into_rtrancl subsetI) lemma listrel_subset_rtrancl_listrel1: "listrel r \ (listrel1 r)\<^sup>*" by(fast intro:rtrancl_listrel1_if_listrel) subsection \Size function\ lemma [measure_function]: "is_measure f \ is_measure (size_list f)" by (rule is_measure_trivial) lemma [measure_function]: "is_measure f \ is_measure (size_option f)" by (rule is_measure_trivial) lemma size_list_estimation[termination_simp]: "x \ set xs \ y < f x \ y < size_list f xs" by (induct xs) auto lemma size_list_estimation'[termination_simp]: "x \ set xs \ y \ f x \ y \ size_list f xs" by (induct xs) auto lemma size_list_map[simp]: "size_list f (map g xs) = size_list (f \ g) xs" by (induct xs) auto lemma size_list_append[simp]: "size_list f (xs @ ys) = size_list f xs + size_list f ys" by (induct xs, auto) lemma size_list_pointwise[termination_simp]: "(\x. x \ set xs \ f x \ g x) \ size_list f xs \ size_list g xs" by (induct xs) force+ subsection \Monad operation\ definition bind :: "'a list \ ('a \ 'b list) \ 'b list" where "bind xs f = concat (map f xs)" hide_const (open) bind lemma bind_simps [simp]: "List.bind [] f = []" "List.bind (x # xs) f = f x @ List.bind xs f" by (simp_all add: bind_def) lemma list_bind_cong [fundef_cong]: assumes "xs = ys" "(\x. x \ set xs \ f x = g x)" shows "List.bind xs f = List.bind ys g" proof - from assms(2) have "List.bind xs f = List.bind xs g" by (induction xs) simp_all with assms(1) show ?thesis by simp qed lemma set_list_bind: "set (List.bind xs f) = (\x\set xs. set (f x))" by (induction xs) simp_all subsection \Code generation\ text\Optional tail recursive version of \<^const>\map\. Can avoid stack overflow in some target languages.\ fun map_tailrec_rev :: "('a \ 'b) \ 'a list \ 'b list \ 'b list" where "map_tailrec_rev f [] bs = bs" | "map_tailrec_rev f (a#as) bs = map_tailrec_rev f as (f a # bs)" lemma map_tailrec_rev: "map_tailrec_rev f as bs = rev(map f as) @ bs" by(induction as arbitrary: bs) simp_all definition map_tailrec :: "('a \ 'b) \ 'a list \ 'b list" where "map_tailrec f as = rev (map_tailrec_rev f as [])" text\Code equation:\ lemma map_eq_map_tailrec: "map = map_tailrec" by(simp add: fun_eq_iff map_tailrec_def map_tailrec_rev) subsubsection \Counterparts for set-related operations\ definition member :: "'a list \ 'a \ bool" where [code_abbrev]: "member xs x \ x \ set xs" text \ Use \member\ only for generating executable code. Otherwise use \<^prop>\x \ set xs\ instead --- it is much easier to reason about. \ lemma member_rec [code]: "member (x # xs) y \ x = y \ member xs y" "member [] y \ False" by (auto simp add: member_def) lemma in_set_member (* FIXME delete candidate *): "x \ set xs \ member xs x" by (simp add: member_def) lemmas list_all_iff [code_abbrev] = fun_cong[OF list.pred_set] definition list_ex :: "('a \ bool) \ 'a list \ bool" where list_ex_iff [code_abbrev]: "list_ex P xs \ Bex (set xs) P" definition list_ex1 :: "('a \ bool) \ 'a list \ bool" where list_ex1_iff [code_abbrev]: "list_ex1 P xs \ (\! x. x \ set xs \ P x)" text \ Usually you should prefer \\x\set xs\, \\x\set xs\ and \\!x. x\set xs \ _\ over \<^const>\list_all\, \<^const>\list_ex\ and \<^const>\list_ex1\ in specifications. \ lemma list_all_simps [code]: "list_all P (x # xs) \ P x \ list_all P xs" "list_all P [] \ True" by (simp_all add: list_all_iff) lemma list_ex_simps [simp, code]: "list_ex P (x # xs) \ P x \ list_ex P xs" "list_ex P [] \ False" by (simp_all add: list_ex_iff) lemma list_ex1_simps [simp, code]: "list_ex1 P [] = False" "list_ex1 P (x # xs) = (if P x then list_all (\y. \ P y \ x = y) xs else list_ex1 P xs)" by (auto simp add: list_ex1_iff list_all_iff) lemma Ball_set_list_all: (* FIXME delete candidate *) "Ball (set xs) P \ list_all P xs" by (simp add: list_all_iff) lemma Bex_set_list_ex: (* FIXME delete candidate *) "Bex (set xs) P \ list_ex P xs" by (simp add: list_ex_iff) lemma list_all_append [simp]: "list_all P (xs @ ys) \ list_all P xs \ list_all P ys" by (auto simp add: list_all_iff) lemma list_ex_append [simp]: "list_ex P (xs @ ys) \ list_ex P xs \ list_ex P ys" by (auto simp add: list_ex_iff) lemma list_all_rev [simp]: "list_all P (rev xs) \ list_all P xs" by (simp add: list_all_iff) lemma list_ex_rev [simp]: "list_ex P (rev xs) \ list_ex P xs" by (simp add: list_ex_iff) lemma list_all_length: "list_all P xs \ (\n < length xs. P (xs ! n))" by (auto simp add: list_all_iff set_conv_nth) lemma list_ex_length: "list_ex P xs \ (\n < length xs. P (xs ! n))" by (auto simp add: list_ex_iff set_conv_nth) lemmas list_all_cong [fundef_cong] = list.pred_cong lemma list_ex_cong [fundef_cong]: "xs = ys \ (\x. x \ set ys \ f x = g x) \ list_ex f xs = list_ex g ys" by (simp add: list_ex_iff) definition can_select :: "('a \ bool) \ 'a set \ bool" where [code_abbrev]: "can_select P A = (\!x\A. P x)" lemma can_select_set_list_ex1 [code]: "can_select P (set A) = list_ex1 P A" by (simp add: list_ex1_iff can_select_def) text \Executable checks for relations on sets\ definition listrel1p :: "('a \ 'a \ bool) \ 'a list \ 'a list \ bool" where "listrel1p r xs ys = ((xs, ys) \ listrel1 {(x, y). r x y})" lemma [code_unfold]: "(xs, ys) \ listrel1 r = listrel1p (\x y. (x, y) \ r) xs ys" unfolding listrel1p_def by auto lemma [code]: "listrel1p r [] xs = False" "listrel1p r xs [] = False" "listrel1p r (x # xs) (y # ys) \ r x y \ xs = ys \ x = y \ listrel1p r xs ys" by (simp add: listrel1p_def)+ definition lexordp :: "('a \ 'a \ bool) \ 'a list \ 'a list \ bool" where "lexordp r xs ys = ((xs, ys) \ lexord {(x, y). r x y})" lemma [code_unfold]: "(xs, ys) \ lexord r = lexordp (\x y. (x, y) \ r) xs ys" unfolding lexordp_def by auto lemma [code]: "lexordp r xs [] = False" "lexordp r [] (y#ys) = True" "lexordp r (x # xs) (y # ys) = (r x y \ (x = y \ lexordp r xs ys))" unfolding lexordp_def by auto text \Bounded quantification and summation over nats.\ lemma atMost_upto [code_unfold]: "{..n} = set [0..m (\m \ {0..m (\m \ {0..m\n::nat. P m) \ (\m \ {0..n}. P m)" by auto lemma ex_nat_less [code_unfold]: "(\m\n::nat. P m) \ (\m \ {0..n}. P m)" by auto text\Bounded \LEAST\ operator:\ definition "Bleast S P = (LEAST x. x \ S \ P x)" definition "abort_Bleast S P = (LEAST x. x \ S \ P x)" declare [[code abort: abort_Bleast]] lemma Bleast_code [code]: "Bleast (set xs) P = (case filter P (sort xs) of x#xs \ x | [] \ abort_Bleast (set xs) P)" proof (cases "filter P (sort xs)") case Nil thus ?thesis by (simp add: Bleast_def abort_Bleast_def) next case (Cons x ys) have "(LEAST x. x \ set xs \ P x) = x" proof (rule Least_equality) show "x \ set xs \ P x" by (metis Cons Cons_eq_filter_iff in_set_conv_decomp set_sort) next fix y assume "y \ set xs \ P y" hence "y \ set (filter P xs)" by auto thus "x \ y" by (metis Cons eq_iff filter_sort set_ConsD set_sort sorted.simps(2) sorted_sort) qed thus ?thesis using Cons by (simp add: Bleast_def) qed declare Bleast_def[symmetric, code_unfold] text \Summation over ints.\ lemma greaterThanLessThan_upto [code_unfold]: "{i<..Optimizing by rewriting\ definition null :: "'a list \ bool" where [code_abbrev]: "null xs \ xs = []" text \ Efficient emptyness check is implemented by \<^const>\null\. \ lemma null_rec [code]: "null (x # xs) \ False" "null [] \ True" by (simp_all add: null_def) lemma eq_Nil_null: (* FIXME delete candidate *) "xs = [] \ null xs" by (simp add: null_def) lemma equal_Nil_null [code_unfold]: "HOL.equal xs [] \ null xs" "HOL.equal [] = null" by (auto simp add: equal null_def) definition maps :: "('a \ 'b list) \ 'a list \ 'b list" where [code_abbrev]: "maps f xs = concat (map f xs)" definition map_filter :: "('a \ 'b option) \ 'a list \ 'b list" where [code_post]: "map_filter f xs = map (the \ f) (filter (\x. f x \ None) xs)" text \ Operations \<^const>\maps\ and \<^const>\map_filter\ avoid intermediate lists on execution -- do not use for proving. \ lemma maps_simps [code]: "maps f (x # xs) = f x @ maps f xs" "maps f [] = []" by (simp_all add: maps_def) lemma map_filter_simps [code]: "map_filter f (x # xs) = (case f x of None \ map_filter f xs | Some y \ y # map_filter f xs)" "map_filter f [] = []" by (simp_all add: map_filter_def split: option.split) lemma concat_map_maps: (* FIXME delete candidate *) "concat (map f xs) = maps f xs" by (simp add: maps_def) lemma map_filter_map_filter [code_unfold]: "map f (filter P xs) = map_filter (\x. if P x then Some (f x) else None) xs" by (simp add: map_filter_def) text \Optimized code for \\i\{a..b::int}\ and \\n:{a.. and similiarly for \\\.\ definition all_interval_nat :: "(nat \ bool) \ nat \ nat \ bool" where "all_interval_nat P i j \ (\n \ {i.. i \ j \ P i \ all_interval_nat P (Suc i) j" proof - have *: "\n. P i \ \n\{Suc i.. i \ n \ n < j \ P n" proof - fix n assume "P i" "\n\{Suc i.. n" "n < j" then show "P n" by (cases "n = i") simp_all qed show ?thesis by (auto simp add: all_interval_nat_def intro: *) qed lemma list_all_iff_all_interval_nat [code_unfold]: "list_all P [i.. all_interval_nat P i j" by (simp add: list_all_iff all_interval_nat_def) lemma list_ex_iff_not_all_inverval_nat [code_unfold]: "list_ex P [i.. \ (all_interval_nat (Not \ P) i j)" by (simp add: list_ex_iff all_interval_nat_def) definition all_interval_int :: "(int \ bool) \ int \ int \ bool" where "all_interval_int P i j \ (\k \ {i..j}. P k)" lemma [code]: "all_interval_int P i j \ i > j \ P i \ all_interval_int P (i + 1) j" proof - have *: "\k. P i \ \k\{i+1..j}. P k \ i \ k \ k \ j \ P k" proof - fix k assume "P i" "\k\{i+1..j}. P k" "i \ k" "k \ j" then show "P k" by (cases "k = i") simp_all qed show ?thesis by (auto simp add: all_interval_int_def intro: *) qed lemma list_all_iff_all_interval_int [code_unfold]: "list_all P [i..j] \ all_interval_int P i j" by (simp add: list_all_iff all_interval_int_def) lemma list_ex_iff_not_all_inverval_int [code_unfold]: "list_ex P [i..j] \ \ (all_interval_int (Not \ P) i j)" by (simp add: list_ex_iff all_interval_int_def) text \optimized code (tail-recursive) for \<^term>\length\\ definition gen_length :: "nat \ 'a list \ nat" where "gen_length n xs = n + length xs" lemma gen_length_code [code]: "gen_length n [] = n" "gen_length n (x # xs) = gen_length (Suc n) xs" by(simp_all add: gen_length_def) declare list.size(3-4)[code del] lemma length_code [code]: "length = gen_length 0" by(simp add: gen_length_def fun_eq_iff) hide_const (open) member null maps map_filter all_interval_nat all_interval_int gen_length subsubsection \Pretty lists\ ML \ (* Code generation for list literals. *) signature LIST_CODE = sig val add_literal_list: string -> theory -> theory end; structure List_Code : LIST_CODE = struct open Basic_Code_Thingol; fun implode_list t = let fun dest_cons (IConst { sym = Code_Symbol.Constant \<^const_name>\Cons\, ... } `$ t1 `$ t2) = SOME (t1, t2) | dest_cons _ = NONE; val (ts, t') = Code_Thingol.unfoldr dest_cons t; in case t' of IConst { sym = Code_Symbol.Constant \<^const_name>\Nil\, ... } => SOME ts | _ => NONE end; fun print_list (target_fxy, target_cons) pr fxy t1 t2 = Code_Printer.brackify_infix (target_fxy, Code_Printer.R) fxy ( pr (Code_Printer.INFX (target_fxy, Code_Printer.X)) t1, Code_Printer.str target_cons, pr (Code_Printer.INFX (target_fxy, Code_Printer.R)) t2 ); fun add_literal_list target = let fun pretty literals pr _ vars fxy [(t1, _), (t2, _)] = case Option.map (cons t1) (implode_list t2) of SOME ts => Code_Printer.literal_list literals (map (pr vars Code_Printer.NOBR) ts) | NONE => print_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2; in Code_Target.set_printings (Code_Symbol.Constant (\<^const_name>\Cons\, [(target, SOME (Code_Printer.complex_const_syntax (2, pretty)))])) end end; \ code_printing type_constructor list \ (SML) "_ list" and (OCaml) "_ list" and (Haskell) "![(_)]" and (Scala) "List[(_)]" | constant Nil \ (SML) "[]" and (OCaml) "[]" and (Haskell) "[]" and (Scala) "!Nil" | class_instance list :: equal \ (Haskell) - | constant "HOL.equal :: 'a list \ 'a list \ bool" \ (Haskell) infix 4 "==" setup \fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"]\ code_reserved SML list code_reserved OCaml list subsubsection \Use convenient predefined operations\ code_printing constant "(@)" \ (SML) infixr 7 "@" and (OCaml) infixr 6 "@" and (Haskell) infixr 5 "++" and (Scala) infixl 7 "++" | constant map \ (Haskell) "map" | constant filter \ (Haskell) "filter" | constant concat \ (Haskell) "concat" | constant List.maps \ (Haskell) "concatMap" | constant rev \ (Haskell) "reverse" | constant zip \ (Haskell) "zip" | constant List.null \ (Haskell) "null" | constant takeWhile \ (Haskell) "takeWhile" | constant dropWhile \ (Haskell) "dropWhile" | constant list_all \ (Haskell) "all" | constant list_ex \ (Haskell) "any" subsubsection \Implementation of sets by lists\ lemma is_empty_set [code]: "Set.is_empty (set xs) \ List.null xs" by (simp add: Set.is_empty_def null_def) lemma empty_set [code]: "{} = set []" by simp lemma UNIV_coset [code]: "UNIV = List.coset []" by simp lemma compl_set [code]: "- set xs = List.coset xs" by simp lemma compl_coset [code]: "- List.coset xs = set xs" by simp lemma [code]: "x \ set xs \ List.member xs x" "x \ List.coset xs \ \ List.member xs x" by (simp_all add: member_def) lemma insert_code [code]: "insert x (set xs) = set (List.insert x xs)" "insert x (List.coset xs) = List.coset (removeAll x xs)" by simp_all lemma remove_code [code]: "Set.remove x (set xs) = set (removeAll x xs)" "Set.remove x (List.coset xs) = List.coset (List.insert x xs)" by (simp_all add: remove_def Compl_insert) lemma filter_set [code]: "Set.filter P (set xs) = set (filter P xs)" by auto lemma image_set [code]: "image f (set xs) = set (map f xs)" by simp lemma subset_code [code]: "set xs \ B \ (\x\set xs. x \ B)" "A \ List.coset ys \ (\y\set ys. y \ A)" "List.coset [] \ set [] \ False" by auto text \A frequent case -- avoid intermediate sets\ lemma [code_unfold]: "set xs \ set ys \ list_all (\x. x \ set ys) xs" by (auto simp: list_all_iff) lemma Ball_set [code]: "Ball (set xs) P \ list_all P xs" by (simp add: list_all_iff) lemma Bex_set [code]: "Bex (set xs) P \ list_ex P xs" by (simp add: list_ex_iff) lemma card_set [code]: "card (set xs) = length (remdups xs)" proof - have "card (set (remdups xs)) = length (remdups xs)" by (rule distinct_card) simp then show ?thesis by simp qed lemma the_elem_set [code]: "the_elem (set [x]) = x" by simp lemma Pow_set [code]: "Pow (set []) = {{}}" "Pow (set (x # xs)) = (let A = Pow (set xs) in A \ insert x ` A)" by (simp_all add: Pow_insert Let_def) definition map_project :: "('a \ 'b option) \ 'a set \ 'b set" where "map_project f A = {b. \ a \ A. f a = Some b}" lemma [code]: "map_project f (set xs) = set (List.map_filter f xs)" by (auto simp add: map_project_def map_filter_def image_def) hide_const (open) map_project text \Operations on relations\ lemma product_code [code]: "Product_Type.product (set xs) (set ys) = set [(x, y). x \ xs, y \ ys]" by (auto simp add: Product_Type.product_def) lemma Id_on_set [code]: "Id_on (set xs) = set [(x, x). x \ xs]" by (auto simp add: Id_on_def) lemma [code]: "R `` S = List.map_project (\(x, y). if x \ S then Some y else None) R" unfolding map_project_def by (auto split: prod.split if_split_asm) lemma trancl_set_ntrancl [code]: "trancl (set xs) = ntrancl (card (set xs) - 1) (set xs)" by (simp add: finite_trancl_ntranl) lemma set_relcomp [code]: "set xys O set yzs = set ([(fst xy, snd yz). xy \ xys, yz \ yzs, snd xy = fst yz])" by auto (auto simp add: Bex_def image_def) lemma wf_set [code]: "wf (set xs) = acyclic (set xs)" by (simp add: wf_iff_acyclic_if_finite) subsection \Setup for Lifting/Transfer\ subsubsection \Transfer rules for the Transfer package\ context includes lifting_syntax begin lemma tl_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A) tl tl" unfolding tl_def[abs_def] by transfer_prover lemma butlast_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A) butlast butlast" by (rule rel_funI, erule list_all2_induct, auto) lemma map_rec: "map f xs = rec_list Nil (%x _ y. Cons (f x) y) xs" by (induct xs) auto lemma append_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A ===> list_all2 A) append append" unfolding List.append_def by transfer_prover lemma rev_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A) rev rev" unfolding List.rev_def by transfer_prover lemma filter_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> list_all2 A) filter filter" unfolding List.filter_def by transfer_prover lemma fold_transfer [transfer_rule]: "((A ===> B ===> B) ===> list_all2 A ===> B ===> B) fold fold" unfolding List.fold_def by transfer_prover lemma foldr_transfer [transfer_rule]: "((A ===> B ===> B) ===> list_all2 A ===> B ===> B) foldr foldr" unfolding List.foldr_def by transfer_prover lemma foldl_transfer [transfer_rule]: "((B ===> A ===> B) ===> B ===> list_all2 A ===> B) foldl foldl" unfolding List.foldl_def by transfer_prover lemma concat_transfer [transfer_rule]: "(list_all2 (list_all2 A) ===> list_all2 A) concat concat" unfolding List.concat_def by transfer_prover lemma drop_transfer [transfer_rule]: "((=) ===> list_all2 A ===> list_all2 A) drop drop" unfolding List.drop_def by transfer_prover lemma take_transfer [transfer_rule]: "((=) ===> list_all2 A ===> list_all2 A) take take" unfolding List.take_def by transfer_prover lemma list_update_transfer [transfer_rule]: "(list_all2 A ===> (=) ===> A ===> list_all2 A) list_update list_update" unfolding list_update_def by transfer_prover lemma takeWhile_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> list_all2 A) takeWhile takeWhile" unfolding takeWhile_def by transfer_prover lemma dropWhile_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> list_all2 A) dropWhile dropWhile" unfolding dropWhile_def by transfer_prover lemma zip_transfer [transfer_rule]: "(list_all2 A ===> list_all2 B ===> list_all2 (rel_prod A B)) zip zip" unfolding zip_def by transfer_prover lemma product_transfer [transfer_rule]: "(list_all2 A ===> list_all2 B ===> list_all2 (rel_prod A B)) List.product List.product" unfolding List.product_def by transfer_prover lemma product_lists_transfer [transfer_rule]: "(list_all2 (list_all2 A) ===> list_all2 (list_all2 A)) product_lists product_lists" unfolding product_lists_def by transfer_prover lemma insert_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(A ===> list_all2 A ===> list_all2 A) List.insert List.insert" unfolding List.insert_def [abs_def] by transfer_prover lemma find_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> rel_option A) List.find List.find" unfolding List.find_def by transfer_prover lemma those_transfer [transfer_rule]: "(list_all2 (rel_option P) ===> rel_option (list_all2 P)) those those" unfolding List.those_def by transfer_prover lemma remove1_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(A ===> list_all2 A ===> list_all2 A) remove1 remove1" unfolding remove1_def by transfer_prover lemma removeAll_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(A ===> list_all2 A ===> list_all2 A) removeAll removeAll" unfolding removeAll_def by transfer_prover lemma successively_transfer [transfer_rule]: "((A ===> A ===> (=)) ===> list_all2 A ===> (=)) successively successively" unfolding successively_altdef by transfer_prover lemma distinct_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> (=)) distinct distinct" unfolding distinct_def by transfer_prover lemma distinct_adj_transfer [transfer_rule]: assumes "bi_unique A" shows "(list_all2 A ===> (=)) distinct_adj distinct_adj" unfolding rel_fun_def proof (intro allI impI) fix xs ys assume "list_all2 A xs ys" thus "distinct_adj xs \ distinct_adj ys" proof (induction rule: list_all2_induct) case (Cons x xs y ys) note * = this show ?case proof (cases xs) case [simp]: (Cons x' xs') with * obtain y' ys' where [simp]: "ys = y' # ys'" by (cases ys) auto from * show ?thesis using assms by (auto simp: distinct_adj_Cons bi_unique_def) qed (use * in auto) qed auto qed lemma remdups_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A) remdups remdups" unfolding remdups_def by transfer_prover lemma remdups_adj_transfer [transfer_rule]: assumes [transfer_rule]: "bi_unique A" shows "(list_all2 A ===> list_all2 A) remdups_adj remdups_adj" proof (rule rel_funI, erule list_all2_induct) qed (auto simp: remdups_adj_Cons assms[unfolded bi_unique_def] split: list.splits) lemma replicate_transfer [transfer_rule]: "((=) ===> A ===> list_all2 A) replicate replicate" unfolding replicate_def by transfer_prover lemma length_transfer [transfer_rule]: "(list_all2 A ===> (=)) length length" unfolding size_list_overloaded_def size_list_def by transfer_prover lemma rotate1_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A) rotate1 rotate1" unfolding rotate1_def by transfer_prover lemma rotate_transfer [transfer_rule]: "((=) ===> list_all2 A ===> list_all2 A) rotate rotate" unfolding rotate_def [abs_def] by transfer_prover lemma nths_transfer [transfer_rule]: "(list_all2 A ===> rel_set (=) ===> list_all2 A) nths nths" unfolding nths_def [abs_def] by transfer_prover lemma subseqs_transfer [transfer_rule]: "(list_all2 A ===> list_all2 (list_all2 A)) subseqs subseqs" unfolding subseqs_def [abs_def] by transfer_prover lemma partition_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> rel_prod (list_all2 A) (list_all2 A)) partition partition" unfolding partition_def by transfer_prover lemma lists_transfer [transfer_rule]: "(rel_set A ===> rel_set (list_all2 A)) lists lists" proof (rule rel_funI, rule rel_setI) show "\l \ lists X; rel_set A X Y\ \ \y\lists Y. list_all2 A l y" for X Y l proof (induction l rule: lists.induct) case (Cons a l) then show ?case by (simp only: rel_set_def list_all2_Cons1, metis lists.Cons) qed auto show "\l \ lists Y; rel_set A X Y\ \ \x\lists X. list_all2 A x l" for X Y l proof (induction l rule: lists.induct) case (Cons a l) then show ?case by (simp only: rel_set_def list_all2_Cons2, metis lists.Cons) qed auto qed lemma set_Cons_transfer [transfer_rule]: "(rel_set A ===> rel_set (list_all2 A) ===> rel_set (list_all2 A)) set_Cons set_Cons" unfolding rel_fun_def rel_set_def set_Cons_def by (fastforce simp add: list_all2_Cons1 list_all2_Cons2) lemma listset_transfer [transfer_rule]: "(list_all2 (rel_set A) ===> rel_set (list_all2 A)) listset listset" unfolding listset_def by transfer_prover lemma null_transfer [transfer_rule]: "(list_all2 A ===> (=)) List.null List.null" unfolding rel_fun_def List.null_def by auto lemma list_all_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> (=)) list_all list_all" unfolding list_all_iff [abs_def] by transfer_prover lemma list_ex_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> (=)) list_ex list_ex" unfolding list_ex_iff [abs_def] by transfer_prover lemma splice_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A ===> list_all2 A) splice splice" apply (rule rel_funI, erule list_all2_induct, simp add: rel_fun_def, simp) apply (rule rel_funI) apply (erule_tac xs=x in list_all2_induct, simp, simp add: rel_fun_def) done lemma shuffles_transfer [transfer_rule]: "(list_all2 A ===> list_all2 A ===> rel_set (list_all2 A)) shuffles shuffles" proof (intro rel_funI, goal_cases) case (1 xs xs' ys ys') thus ?case proof (induction xs ys arbitrary: xs' ys' rule: shuffles.induct) case (3 x xs y ys xs' ys') from "3.prems" obtain x' xs'' where xs': "xs' = x' # xs''" by (cases xs') auto from "3.prems" obtain y' ys'' where ys': "ys' = y' # ys''" by (cases ys') auto have [transfer_rule]: "A x x'" "A y y'" "list_all2 A xs xs''" "list_all2 A ys ys''" using "3.prems" by (simp_all add: xs' ys') have [transfer_rule]: "rel_set (list_all2 A) (shuffles xs (y # ys)) (shuffles xs'' ys')" and [transfer_rule]: "rel_set (list_all2 A) (shuffles (x # xs) ys) (shuffles xs' ys'')" using "3.prems" by (auto intro!: "3.IH" simp: xs' ys') have "rel_set (list_all2 A) ((#) x ` shuffles xs (y # ys) \ (#) y ` shuffles (x # xs) ys) ((#) x' ` shuffles xs'' ys' \ (#) y' ` shuffles xs' ys'')" by transfer_prover thus ?case by (simp add: xs' ys') qed (auto simp: rel_set_def) qed lemma rtrancl_parametric [transfer_rule]: assumes [transfer_rule]: "bi_unique A" "bi_total A" shows "(rel_set (rel_prod A A) ===> rel_set (rel_prod A A)) rtrancl rtrancl" unfolding rtrancl_def by transfer_prover lemma monotone_parametric [transfer_rule]: assumes [transfer_rule]: "bi_total A" shows "((A ===> A ===> (=)) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) monotone monotone" unfolding monotone_def[abs_def] by transfer_prover lemma fun_ord_parametric [transfer_rule]: assumes [transfer_rule]: "bi_total C" shows "((A ===> B ===> (=)) ===> (C ===> A) ===> (C ===> B) ===> (=)) fun_ord fun_ord" unfolding fun_ord_def[abs_def] by transfer_prover lemma fun_lub_parametric [transfer_rule]: assumes [transfer_rule]: "bi_total A" "bi_unique A" shows "((rel_set A ===> B) ===> rel_set (C ===> A) ===> C ===> B) fun_lub fun_lub" unfolding fun_lub_def[abs_def] by transfer_prover end end diff --git a/src/HOL/Nat.thy b/src/HOL/Nat.thy --- a/src/HOL/Nat.thy +++ b/src/HOL/Nat.thy @@ -1,2548 +1,2548 @@ (* Title: HOL/Nat.thy Author: Tobias Nipkow Author: Lawrence C Paulson Author: Markus Wenzel *) section \Natural numbers\ theory Nat imports Inductive Typedef Fun Rings begin subsection \Type \ind\\ typedecl ind axiomatization Zero_Rep :: ind and Suc_Rep :: "ind \ ind" \ \The axiom of infinity in 2 parts:\ where Suc_Rep_inject: "Suc_Rep x = Suc_Rep y \ x = y" and Suc_Rep_not_Zero_Rep: "Suc_Rep x \ Zero_Rep" subsection \Type nat\ text \Type definition\ inductive Nat :: "ind \ bool" where Zero_RepI: "Nat Zero_Rep" | Suc_RepI: "Nat i \ Nat (Suc_Rep i)" typedef nat = "{n. Nat n}" morphisms Rep_Nat Abs_Nat using Nat.Zero_RepI by auto lemma Nat_Rep_Nat: "Nat (Rep_Nat n)" using Rep_Nat by simp lemma Nat_Abs_Nat_inverse: "Nat n \ Rep_Nat (Abs_Nat n) = n" using Abs_Nat_inverse by simp lemma Nat_Abs_Nat_inject: "Nat n \ Nat m \ Abs_Nat n = Abs_Nat m \ n = m" using Abs_Nat_inject by simp instantiation nat :: zero begin definition Zero_nat_def: "0 = Abs_Nat Zero_Rep" instance .. end definition Suc :: "nat \ nat" where "Suc n = Abs_Nat (Suc_Rep (Rep_Nat n))" lemma Suc_not_Zero: "Suc m \ 0" by (simp add: Zero_nat_def Suc_def Suc_RepI Zero_RepI Nat_Abs_Nat_inject Suc_Rep_not_Zero_Rep Nat_Rep_Nat) lemma Zero_not_Suc: "0 \ Suc m" by (rule not_sym) (rule Suc_not_Zero) lemma Suc_Rep_inject': "Suc_Rep x = Suc_Rep y \ x = y" by (rule iffI, rule Suc_Rep_inject) simp_all lemma nat_induct0: assumes "P 0" and "\n. P n \ P (Suc n)" shows "P n" proof - have "P (Abs_Nat (Rep_Nat n))" using assms unfolding Zero_nat_def Suc_def by (iprover intro: Nat_Rep_Nat [THEN Nat.induct] elim: Nat_Abs_Nat_inverse [THEN subst]) then show ?thesis by (simp add: Rep_Nat_inverse) qed free_constructors case_nat for "0 :: nat" | Suc pred where "pred (0 :: nat) = (0 :: nat)" apply atomize_elim apply (rename_tac n, induct_tac n rule: nat_induct0, auto) apply (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI Suc_Rep_inject' Rep_Nat_inject) apply (simp only: Suc_not_Zero) done \ \Avoid name clashes by prefixing the output of \old_rep_datatype\ with \old\.\ setup \Sign.mandatory_path "old"\ old_rep_datatype "0 :: nat" Suc by (erule nat_induct0) auto setup \Sign.parent_path\ \ \But erase the prefix for properties that are not generated by \free_constructors\.\ setup \Sign.mandatory_path "nat"\ declare old.nat.inject[iff del] and old.nat.distinct(1)[simp del, induct_simp del] lemmas induct = old.nat.induct lemmas inducts = old.nat.inducts lemmas rec = old.nat.rec lemmas simps = nat.inject nat.distinct nat.case nat.rec setup \Sign.parent_path\ abbreviation rec_nat :: "'a \ (nat \ 'a \ 'a) \ nat \ 'a" where "rec_nat \ old.rec_nat" declare nat.sel[code del] hide_const (open) Nat.pred \ \hide everything related to the selector\ hide_fact nat.case_eq_if nat.collapse nat.expand nat.sel nat.exhaust_sel nat.split_sel nat.split_sel_asm lemma nat_exhaust [case_names 0 Suc, cases type: nat]: "(y = 0 \ P) \ (\nat. y = Suc nat \ P) \ P" \ \for backward compatibility -- names of variables differ\ by (rule old.nat.exhaust) lemma nat_induct [case_names 0 Suc, induct type: nat]: fixes n assumes "P 0" and "\n. P n \ P (Suc n)" shows "P n" \ \for backward compatibility -- names of variables differ\ using assms by (rule nat.induct) hide_fact nat_exhaust nat_induct0 ML \ val nat_basic_lfp_sugar = let val ctr_sugar = the (Ctr_Sugar.ctr_sugar_of_global \<^theory> \<^type_name>\nat\); val recx = Logic.varify_types_global \<^term>\rec_nat\; val C = body_type (fastype_of recx); in {T = HOLogic.natT, fp_res_index = 0, C = C, fun_arg_Tsss = [[], [[HOLogic.natT, C]]], ctr_sugar = ctr_sugar, recx = recx, rec_thms = @{thms nat.rec}} end; \ setup \ let fun basic_lfp_sugars_of _ [\<^typ>\nat\] _ _ ctxt = ([], [0], [nat_basic_lfp_sugar], [], [], [], TrueI (*dummy*), [], false, ctxt) | basic_lfp_sugars_of bs arg_Ts callers callssss ctxt = BNF_LFP_Rec_Sugar.default_basic_lfp_sugars_of bs arg_Ts callers callssss ctxt; in BNF_LFP_Rec_Sugar.register_lfp_rec_extension {nested_simps = [], special_endgame_tac = K (K (K (K no_tac))), is_new_datatype = K (K true), basic_lfp_sugars_of = basic_lfp_sugars_of, rewrite_nested_rec_call = NONE} end \ text \Injectiveness and distinctness lemmas\ lemma inj_Suc [simp]: "inj_on Suc N" by (simp add: inj_on_def) lemma bij_betw_Suc [simp]: "bij_betw Suc M N \ Suc ` M = N" by (simp add: bij_betw_def) lemma Suc_neq_Zero: "Suc m = 0 \ R" by (rule notE) (rule Suc_not_Zero) lemma Zero_neq_Suc: "0 = Suc m \ R" by (rule Suc_neq_Zero) (erule sym) lemma Suc_inject: "Suc x = Suc y \ x = y" by (rule inj_Suc [THEN injD]) lemma n_not_Suc_n: "n \ Suc n" by (induct n) simp_all lemma Suc_n_not_n: "Suc n \ n" by (rule not_sym) (rule n_not_Suc_n) text \A special form of induction for reasoning about \<^term>\m < n\ and \<^term>\m - n\.\ lemma diff_induct: assumes "\x. P x 0" and "\y. P 0 (Suc y)" and "\x y. P x y \ P (Suc x) (Suc y)" shows "P m n" proof (induct n arbitrary: m) case 0 show ?case by (rule assms(1)) next case (Suc n) show ?case proof (induct m) case 0 show ?case by (rule assms(2)) next case (Suc m) from \P m n\ show ?case by (rule assms(3)) qed qed subsection \Arithmetic operators\ instantiation nat :: comm_monoid_diff begin primrec plus_nat where add_0: "0 + n = (n::nat)" | add_Suc: "Suc m + n = Suc (m + n)" lemma add_0_right [simp]: "m + 0 = m" for m :: nat by (induct m) simp_all lemma add_Suc_right [simp]: "m + Suc n = Suc (m + n)" by (induct m) simp_all declare add_0 [code] lemma add_Suc_shift [code]: "Suc m + n = m + Suc n" by simp primrec minus_nat where diff_0 [code]: "m - 0 = (m::nat)" | diff_Suc: "m - Suc n = (case m - n of 0 \ 0 | Suc k \ k)" declare diff_Suc [simp del] lemma diff_0_eq_0 [simp, code]: "0 - n = 0" for n :: nat by (induct n) (simp_all add: diff_Suc) lemma diff_Suc_Suc [simp, code]: "Suc m - Suc n = m - n" by (induct n) (simp_all add: diff_Suc) instance proof fix n m q :: nat show "(n + m) + q = n + (m + q)" by (induct n) simp_all show "n + m = m + n" by (induct n) simp_all show "m + n - m = n" by (induct m) simp_all show "n - m - q = n - (m + q)" by (induct q) (simp_all add: diff_Suc) show "0 + n = n" by simp show "0 - n = 0" by simp qed end hide_fact (open) add_0 add_0_right diff_0 instantiation nat :: comm_semiring_1_cancel begin definition One_nat_def [simp]: "1 = Suc 0" primrec times_nat where mult_0: "0 * n = (0::nat)" | mult_Suc: "Suc m * n = n + (m * n)" lemma mult_0_right [simp]: "m * 0 = 0" for m :: nat by (induct m) simp_all lemma mult_Suc_right [simp]: "m * Suc n = m + (m * n)" by (induct m) (simp_all add: add.left_commute) lemma add_mult_distrib: "(m + n) * k = (m * k) + (n * k)" for m n k :: nat by (induct m) (simp_all add: add.assoc) instance proof fix k n m q :: nat show "0 \ (1::nat)" by simp show "1 * n = n" by simp show "n * m = m * n" by (induct n) simp_all show "(n * m) * q = n * (m * q)" by (induct n) (simp_all add: add_mult_distrib) show "(n + m) * q = n * q + m * q" by (rule add_mult_distrib) show "k * (m - n) = (k * m) - (k * n)" by (induct m n rule: diff_induct) simp_all qed end subsubsection \Addition\ text \Reasoning about \m + 0 = 0\, etc.\ lemma add_is_0 [iff]: "m + n = 0 \ m = 0 \ n = 0" for m n :: nat by (cases m) simp_all lemma add_is_1: "m + n = Suc 0 \ m = Suc 0 \ n = 0 \ m = 0 \ n = Suc 0" by (cases m) simp_all lemma one_is_add: "Suc 0 = m + n \ m = Suc 0 \ n = 0 \ m = 0 \ n = Suc 0" by (rule trans, rule eq_commute, rule add_is_1) lemma add_eq_self_zero: "m + n = m \ n = 0" for m n :: nat by (induct m) simp_all lemma plus_1_eq_Suc: "plus 1 = Suc" by (simp add: fun_eq_iff) lemma Suc_eq_plus1: "Suc n = n + 1" by simp lemma Suc_eq_plus1_left: "Suc n = 1 + n" by simp subsubsection \Difference\ lemma Suc_diff_diff [simp]: "(Suc m - n) - Suc k = m - n - k" by (simp add: diff_diff_add) lemma diff_Suc_1 [simp]: "Suc n - 1 = n" by simp subsubsection \Multiplication\ lemma mult_is_0 [simp]: "m * n = 0 \ m = 0 \ n = 0" for m n :: nat by (induct m) auto lemma mult_eq_1_iff [simp]: "m * n = Suc 0 \ m = Suc 0 \ n = Suc 0" proof (induct m) case 0 then show ?case by simp next case (Suc m) then show ?case by (induct n) auto qed lemma one_eq_mult_iff [simp]: "Suc 0 = m * n \ m = Suc 0 \ n = Suc 0" by (simp add: eq_commute flip: mult_eq_1_iff) lemma nat_mult_eq_1_iff [simp]: "m * n = 1 \ m = 1 \ n = 1" and nat_1_eq_mult_iff [simp]: "1 = m * n \ m = 1 \ n = 1" for m n :: nat by auto lemma mult_cancel1 [simp]: "k * m = k * n \ m = n \ k = 0" for k m n :: nat proof - have "k \ 0 \ k * m = k * n \ m = n" proof (induct n arbitrary: m) case 0 then show "m = 0" by simp next case (Suc n) then show "m = Suc n" by (cases m) (simp_all add: eq_commute [of 0]) qed then show ?thesis by auto qed lemma mult_cancel2 [simp]: "m * k = n * k \ m = n \ k = 0" for k m n :: nat by (simp add: mult.commute) lemma Suc_mult_cancel1: "Suc k * m = Suc k * n \ m = n" by (subst mult_cancel1) simp subsection \Orders on \<^typ>\nat\\ subsubsection \Operation definition\ instantiation nat :: linorder begin primrec less_eq_nat where "(0::nat) \ n \ True" | "Suc m \ n \ (case n of 0 \ False | Suc n \ m \ n)" declare less_eq_nat.simps [simp del] lemma le0 [iff]: "0 \ n" for n :: nat by (simp add: less_eq_nat.simps) lemma [code]: "0 \ n \ True" for n :: nat by simp definition less_nat where less_eq_Suc_le: "n < m \ Suc n \ m" lemma Suc_le_mono [iff]: "Suc n \ Suc m \ n \ m" by (simp add: less_eq_nat.simps(2)) lemma Suc_le_eq [code]: "Suc m \ n \ m < n" unfolding less_eq_Suc_le .. lemma le_0_eq [iff]: "n \ 0 \ n = 0" for n :: nat by (induct n) (simp_all add: less_eq_nat.simps(2)) lemma not_less0 [iff]: "\ n < 0" for n :: nat by (simp add: less_eq_Suc_le) lemma less_nat_zero_code [code]: "n < 0 \ False" for n :: nat by simp lemma Suc_less_eq [iff]: "Suc m < Suc n \ m < n" by (simp add: less_eq_Suc_le) lemma less_Suc_eq_le [code]: "m < Suc n \ m \ n" by (simp add: less_eq_Suc_le) lemma Suc_less_eq2: "Suc n < m \ (\m'. m = Suc m' \ n < m')" by (cases m) auto lemma le_SucI: "m \ n \ m \ Suc n" by (induct m arbitrary: n) (simp_all add: less_eq_nat.simps(2) split: nat.splits) lemma Suc_leD: "Suc m \ n \ m \ n" by (cases n) (auto intro: le_SucI) lemma less_SucI: "m < n \ m < Suc n" by (simp add: less_eq_Suc_le) (erule Suc_leD) lemma Suc_lessD: "Suc m < n \ m < n" by (simp add: less_eq_Suc_le) (erule Suc_leD) instance proof fix n m q :: nat show "n < m \ n \ m \ \ m \ n" proof (induct n arbitrary: m) case 0 then show ?case by (cases m) (simp_all add: less_eq_Suc_le) next case (Suc n) then show ?case by (cases m) (simp_all add: less_eq_Suc_le) qed show "n \ n" by (induct n) simp_all then show "n = m" if "n \ m" and "m \ n" using that by (induct n arbitrary: m) (simp_all add: less_eq_nat.simps(2) split: nat.splits) show "n \ q" if "n \ m" and "m \ q" using that proof (induct n arbitrary: m q) case 0 show ?case by simp next case (Suc n) then show ?case by (simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits, clarify, simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits, clarify, simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits) qed show "n \ m \ m \ n" by (induct n arbitrary: m) (simp_all add: less_eq_nat.simps(2) split: nat.splits) qed end instantiation nat :: order_bot begin definition bot_nat :: nat where "bot_nat = 0" instance by standard (simp add: bot_nat_def) end instance nat :: no_top by standard (auto intro: less_Suc_eq_le [THEN iffD2]) subsubsection \Introduction properties\ lemma lessI [iff]: "n < Suc n" by (simp add: less_Suc_eq_le) lemma zero_less_Suc [iff]: "0 < Suc n" by (simp add: less_Suc_eq_le) subsubsection \Elimination properties\ lemma less_not_refl: "\ n < n" for n :: nat by (rule order_less_irrefl) lemma less_not_refl2: "n < m \ m \ n" for m n :: nat by (rule not_sym) (rule less_imp_neq) lemma less_not_refl3: "s < t \ s \ t" for s t :: nat by (rule less_imp_neq) lemma less_irrefl_nat: "n < n \ R" for n :: nat by (rule notE, rule less_not_refl) lemma less_zeroE: "n < 0 \ R" for n :: nat by (rule notE) (rule not_less0) lemma less_Suc_eq: "m < Suc n \ m < n \ m = n" unfolding less_Suc_eq_le le_less .. lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)" by (simp add: less_Suc_eq) lemma less_one [iff]: "n < 1 \ n = 0" for n :: nat unfolding One_nat_def by (rule less_Suc0) lemma Suc_mono: "m < n \ Suc m < Suc n" by simp text \"Less than" is antisymmetric, sort of.\ lemma less_antisym: "\ n < m \ n < Suc m \ m = n" unfolding not_less less_Suc_eq_le by (rule antisym) lemma nat_neq_iff: "m \ n \ m < n \ n < m" for m n :: nat by (rule linorder_neq_iff) subsubsection \Inductive (?) properties\ lemma Suc_lessI: "m < n \ Suc m \ n \ Suc m < n" unfolding less_eq_Suc_le [of m] le_less by simp lemma lessE: assumes major: "i < k" and 1: "k = Suc i \ P" and 2: "\j. i < j \ k = Suc j \ P" shows P proof - from major have "\j. i \ j \ k = Suc j" unfolding less_eq_Suc_le by (induct k) simp_all then have "(\j. i < j \ k = Suc j) \ k = Suc i" by (auto simp add: less_le) with 1 2 show P by auto qed lemma less_SucE: assumes major: "m < Suc n" and less: "m < n \ P" and eq: "m = n \ P" shows P proof (rule major [THEN lessE]) show "Suc n = Suc m \ P" using eq by blast show "\j. \m < j; Suc n = Suc j\ \ P" by (blast intro: less) qed lemma Suc_lessE: assumes major: "Suc i < k" and minor: "\j. i < j \ k = Suc j \ P" shows P proof (rule major [THEN lessE]) show "k = Suc (Suc i) \ P" using lessI minor by iprover show "\j. \Suc i < j; k = Suc j\ \ P" using Suc_lessD minor by iprover qed lemma Suc_less_SucD: "Suc m < Suc n \ m < n" by simp lemma less_trans_Suc: assumes le: "i < j" shows "j < k \ Suc i < k" proof (induct k) case 0 then show ?case by simp next case (Suc k) with le show ?case by simp (auto simp add: less_Suc_eq dest: Suc_lessD) qed text \Can be used with \less_Suc_eq\ to get \<^prop>\n = m \ n < m\.\ lemma not_less_eq: "\ m < n \ n < Suc m" by (simp only: not_less less_Suc_eq_le) lemma not_less_eq_eq: "\ m \ n \ Suc n \ m" by (simp only: not_le Suc_le_eq) text \Properties of "less than or equal".\ lemma le_imp_less_Suc: "m \ n \ m < Suc n" by (simp only: less_Suc_eq_le) lemma Suc_n_not_le_n: "\ Suc n \ n" by (simp add: not_le less_Suc_eq_le) lemma le_Suc_eq: "m \ Suc n \ m \ n \ m = Suc n" by (simp add: less_Suc_eq_le [symmetric] less_Suc_eq) lemma le_SucE: "m \ Suc n \ (m \ n \ R) \ (m = Suc n \ R) \ R" by (drule le_Suc_eq [THEN iffD1], iprover+) lemma Suc_leI: "m < n \ Suc m \ n" by (simp only: Suc_le_eq) text \Stronger version of \Suc_leD\.\ lemma Suc_le_lessD: "Suc m \ n \ m < n" by (simp only: Suc_le_eq) lemma less_imp_le_nat: "m < n \ m \ n" for m n :: nat unfolding less_eq_Suc_le by (rule Suc_leD) text \For instance, \(Suc m < Suc n) = (Suc m \ n) = (m < n)\\ lemmas le_simps = less_imp_le_nat less_Suc_eq_le Suc_le_eq text \Equivalence of \m \ n\ and \m < n \ m = n\\ lemma less_or_eq_imp_le: "m < n \ m = n \ m \ n" for m n :: nat unfolding le_less . lemma le_eq_less_or_eq: "m \ n \ m < n \ m = n" for m n :: nat by (rule le_less) text \Useful with \blast\.\ lemma eq_imp_le: "m = n \ m \ n" for m n :: nat by auto lemma le_refl: "n \ n" for n :: nat by simp lemma le_trans: "i \ j \ j \ k \ i \ k" for i j k :: nat by (rule order_trans) lemma le_antisym: "m \ n \ n \ m \ m = n" for m n :: nat by (rule antisym) lemma nat_less_le: "m < n \ m \ n \ m \ n" for m n :: nat by (rule less_le) lemma le_neq_implies_less: "m \ n \ m \ n \ m < n" for m n :: nat unfolding less_le .. lemma nat_le_linear: "m \ n \ n \ m" for m n :: nat by (rule linear) lemmas linorder_neqE_nat = linorder_neqE [where 'a = nat] lemma le_less_Suc_eq: "m \ n \ n < Suc m \ n = m" unfolding less_Suc_eq_le by auto lemma not_less_less_Suc_eq: "\ n < m \ n < Suc m \ n = m" unfolding not_less by (rule le_less_Suc_eq) lemmas not_less_simps = not_less_less_Suc_eq le_less_Suc_eq lemma not0_implies_Suc: "n \ 0 \ \m. n = Suc m" by (cases n) simp_all lemma gr0_implies_Suc: "n > 0 \ \m. n = Suc m" by (cases n) simp_all lemma gr_implies_not0: "m < n \ n \ 0" for m n :: nat by (cases n) simp_all lemma neq0_conv[iff]: "n \ 0 \ 0 < n" for n :: nat by (cases n) simp_all text \This theorem is useful with \blast\\ lemma gr0I: "(n = 0 \ False) \ 0 < n" for n :: nat by (rule neq0_conv[THEN iffD1]) iprover lemma gr0_conv_Suc: "0 < n \ (\m. n = Suc m)" by (fast intro: not0_implies_Suc) lemma not_gr0 [iff]: "\ 0 < n \ n = 0" for n :: nat using neq0_conv by blast lemma Suc_le_D: "Suc n \ m' \ \m. m' = Suc m" by (induct m') simp_all text \Useful in certain inductive arguments\ lemma less_Suc_eq_0_disj: "m < Suc n \ m = 0 \ (\j. m = Suc j \ j < n)" by (cases m) simp_all lemma All_less_Suc: "(\i < Suc n. P i) = (P n \ (\i < n. P i))" by (auto simp: less_Suc_eq) lemma All_less_Suc2: "(\i < Suc n. P i) = (P 0 \ (\i < n. P(Suc i)))" by (auto simp: less_Suc_eq_0_disj) lemma Ex_less_Suc: "(\i < Suc n. P i) = (P n \ (\i < n. P i))" by (auto simp: less_Suc_eq) lemma Ex_less_Suc2: "(\i < Suc n. P i) = (P 0 \ (\i < n. P(Suc i)))" by (auto simp: less_Suc_eq_0_disj) text \@{term mono} (non-strict) doesn't imply increasing, as the function could be constant\ lemma strict_mono_imp_increasing: fixes n::nat assumes "strict_mono f" shows "f n \ n" proof (induction n) case 0 then show ?case by auto next case (Suc n) then show ?case unfolding not_less_eq_eq [symmetric] using Suc_n_not_le_n assms order_trans strict_mono_less_eq by blast qed subsubsection \Monotonicity of Addition\ lemma Suc_pred [simp]: "n > 0 \ Suc (n - Suc 0) = n" by (simp add: diff_Suc split: nat.split) lemma Suc_diff_1 [simp]: "0 < n \ Suc (n - 1) = n" unfolding One_nat_def by (rule Suc_pred) lemma nat_add_left_cancel_le [simp]: "k + m \ k + n \ m \ n" for k m n :: nat by (induct k) simp_all lemma nat_add_left_cancel_less [simp]: "k + m < k + n \ m < n" for k m n :: nat by (induct k) simp_all lemma add_gr_0 [iff]: "m + n > 0 \ m > 0 \ n > 0" for m n :: nat by (auto dest: gr0_implies_Suc) text \strict, in 1st argument\ lemma add_less_mono1: "i < j \ i + k < j + k" for i j k :: nat by (induct k) simp_all text \strict, in both arguments\ lemma add_less_mono: fixes i j k l :: nat assumes "i < j" "k < l" shows "i + k < j + l" proof - have "i + k < j + k" by (simp add: add_less_mono1 assms) also have "... < j + l" using \i < j\ by (induction j) (auto simp: assms) finally show ?thesis . qed lemma less_imp_Suc_add: "m < n \ \k. n = Suc (m + k)" proof (induct n) case 0 then show ?case by simp next case Suc then show ?case by (simp add: order_le_less) (blast elim!: less_SucE intro!: Nat.add_0_right [symmetric] add_Suc_right [symmetric]) qed lemma le_Suc_ex: "k \ l \ (\n. l = k + n)" for k l :: nat by (auto simp: less_Suc_eq_le[symmetric] dest: less_imp_Suc_add) lemma less_natE: assumes \m < n\ obtains q where \n = Suc (m + q)\ using assms by (auto dest: less_imp_Suc_add intro: that) text \strict, in 1st argument; proof is by induction on \k > 0\\ lemma mult_less_mono2: fixes i j :: nat assumes "i < j" and "0 < k" shows "k * i < k * j" using \0 < k\ proof (induct k) case 0 then show ?case by simp next case (Suc k) with \i < j\ show ?case by (cases k) (simp_all add: add_less_mono) qed text \Addition is the inverse of subtraction: if \<^term>\n \ m\ then \<^term>\n + (m - n) = m\.\ lemma add_diff_inverse_nat: "\ m < n \ n + (m - n) = m" for m n :: nat by (induct m n rule: diff_induct) simp_all lemma nat_le_iff_add: "m \ n \ (\k. n = m + k)" for m n :: nat using nat_add_left_cancel_le[of m 0] by (auto dest: le_Suc_ex) text \The naturals form an ordered \semidom\ and a \dioid\.\ instance nat :: linordered_semidom proof fix m n q :: nat show "0 < (1::nat)" by simp show "m \ n \ q + m \ q + n" by simp show "m < n \ 0 < q \ q * m < q * n" by (simp add: mult_less_mono2) show "m \ 0 \ n \ 0 \ m * n \ 0" by simp show "n \ m \ (m - n) + n = m" by (simp add: add_diff_inverse_nat add.commute linorder_not_less) qed instance nat :: dioid by standard (rule nat_le_iff_add) declare le0[simp del] \ \This is now @{thm zero_le}\ declare le_0_eq[simp del] \ \This is now @{thm le_zero_eq}\ declare not_less0[simp del] \ \This is now @{thm not_less_zero}\ declare not_gr0[simp del] \ \This is now @{thm not_gr_zero}\ instance nat :: ordered_cancel_comm_monoid_add .. instance nat :: ordered_cancel_comm_monoid_diff .. subsubsection \\<^term>\min\ and \<^term>\max\\ global_interpretation bot_nat_0: ordering_top \(\)\ \(>)\ \0::nat\ by standard simp global_interpretation max_nat: semilattice_neutr_order max \0::nat\ \(\)\ \(>)\ by standard (simp add: max_def) lemma mono_Suc: "mono Suc" by (rule monoI) simp lemma min_0L [simp]: "min 0 n = 0" for n :: nat by (rule min_absorb1) simp lemma min_0R [simp]: "min n 0 = 0" for n :: nat by (rule min_absorb2) simp lemma min_Suc_Suc [simp]: "min (Suc m) (Suc n) = Suc (min m n)" by (simp add: mono_Suc min_of_mono) lemma min_Suc1: "min (Suc n) m = (case m of 0 \ 0 | Suc m' \ Suc(min n m'))" by (simp split: nat.split) lemma min_Suc2: "min m (Suc n) = (case m of 0 \ 0 | Suc m' \ Suc(min m' n))" by (simp split: nat.split) lemma max_0L [simp]: "max 0 n = n" for n :: nat by (fact max_nat.left_neutral) lemma max_0R [simp]: "max n 0 = n" for n :: nat by (fact max_nat.right_neutral) lemma max_Suc_Suc [simp]: "max (Suc m) (Suc n) = Suc (max m n)" by (simp add: mono_Suc max_of_mono) lemma max_Suc1: "max (Suc n) m = (case m of 0 \ Suc n | Suc m' \ Suc (max n m'))" by (simp split: nat.split) lemma max_Suc2: "max m (Suc n) = (case m of 0 \ Suc n | Suc m' \ Suc (max m' n))" by (simp split: nat.split) lemma nat_mult_min_left: "min m n * q = min (m * q) (n * q)" for m n q :: nat by (simp add: min_def not_le) (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans) lemma nat_mult_min_right: "m * min n q = min (m * n) (m * q)" for m n q :: nat by (simp add: min_def not_le) (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans) lemma nat_add_max_left: "max m n + q = max (m + q) (n + q)" for m n q :: nat by (simp add: max_def) lemma nat_add_max_right: "m + max n q = max (m + n) (m + q)" for m n q :: nat by (simp add: max_def) lemma nat_mult_max_left: "max m n * q = max (m * q) (n * q)" for m n q :: nat by (simp add: max_def not_le) (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans) lemma nat_mult_max_right: "m * max n q = max (m * n) (m * q)" for m n q :: nat by (simp add: max_def not_le) (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans) subsubsection \Additional theorems about \<^term>\(\)\\ text \Complete induction, aka course-of-values induction\ instance nat :: wellorder proof fix P and n :: nat assume step: "(\m. m < n \ P m) \ P n" for n :: nat have "\q. q \ n \ P q" proof (induct n) case (0 n) have "P 0" by (rule step) auto with 0 show ?case by auto next case (Suc m n) then have "n \ m \ n = Suc m" by (simp add: le_Suc_eq) then show ?case proof assume "n \ m" then show "P n" by (rule Suc(1)) next assume n: "n = Suc m" show "P n" by (rule step) (rule Suc(1), simp add: n le_simps) qed qed then show "P n" by auto qed lemma Least_eq_0[simp]: "P 0 \ Least P = 0" for P :: "nat \ bool" by (rule Least_equality[OF _ le0]) lemma Least_Suc: assumes "P n" "\ P 0" shows "(LEAST n. P n) = Suc (LEAST m. P (Suc m))" proof (cases n) case (Suc m) show ?thesis proof (rule antisym) show "(LEAST x. P x) \ Suc (LEAST x. P (Suc x))" using assms Suc by (force intro: LeastI Least_le) have \
: "P (LEAST x. P x)" by (blast intro: LeastI assms) show "Suc (LEAST m. P (Suc m)) \ (LEAST n. P n)" proof (cases "(LEAST n. P n)") case 0 then show ?thesis using \
by (simp add: assms) next case Suc with \
show ?thesis by (auto simp: Least_le) qed qed qed (use assms in auto) lemma Least_Suc2: "P n \ Q m \ \ P 0 \ \k. P (Suc k) = Q k \ Least P = Suc (Least Q)" by (erule (1) Least_Suc [THEN ssubst]) simp lemma ex_least_nat_le: fixes P :: "nat \ bool" assumes "P n" "\ P 0" shows "\k\n. (\i P i) \ P k" proof (cases n) case (Suc m) with assms show ?thesis by (blast intro: Least_le LeastI_ex dest: not_less_Least) qed (use assms in auto) lemma ex_least_nat_less: fixes P :: "nat \ bool" assumes "P n" "\ P 0" shows "\ki\k. \ P i) \ P (Suc k)" proof (cases n) case (Suc m) then obtain k where k: "k \ n" "\i P i" "P k" using ex_least_nat_le [OF assms] by blast show ?thesis by (cases k) (use assms k less_eq_Suc_le in auto) qed (use assms in auto) lemma nat_less_induct: fixes P :: "nat \ bool" assumes "\n. \m. m < n \ P m \ P n" shows "P n" using assms less_induct by blast lemma measure_induct_rule [case_names less]: fixes f :: "'a \ 'b::wellorder" assumes step: "\x. (\y. f y < f x \ P y) \ P x" shows "P a" by (induct m \ "f a" arbitrary: a rule: less_induct) (auto intro: step) text \old style induction rules:\ lemma measure_induct: fixes f :: "'a \ 'b::wellorder" shows "(\x. \y. f y < f x \ P y \ P x) \ P a" by (rule measure_induct_rule [of f P a]) iprover lemma full_nat_induct: assumes step: "\n. (\m. Suc m \ n \ P m) \ P n" shows "P n" by (rule less_induct) (auto intro: step simp:le_simps) text\An induction rule for establishing binary relations\ lemma less_Suc_induct [consumes 1]: assumes less: "i < j" and step: "\i. P i (Suc i)" and trans: "\i j k. i < j \ j < k \ P i j \ P j k \ P i k" shows "P i j" proof - from less obtain k where j: "j = Suc (i + k)" by (auto dest: less_imp_Suc_add) have "P i (Suc (i + k))" proof (induct k) case 0 show ?case by (simp add: step) next case (Suc k) have "0 + i < Suc k + i" by (rule add_less_mono1) simp then have "i < Suc (i + k)" by (simp add: add.commute) from trans[OF this lessI Suc step] show ?case by simp qed then show "P i j" by (simp add: j) qed text \ The method of infinite descent, frequently used in number theory. Provided by Roelof Oosterhuis. \P n\ is true for all natural numbers if \<^item> case ``0'': given \n = 0\ prove \P n\ \<^item> case ``smaller'': given \n > 0\ and \\ P n\ prove there exists a smaller natural number \m\ such that \\ P m\. \ lemma infinite_descent: "(\n. \ P n \ \m P m) \ P n" for P :: "nat \ bool" \ \compact version without explicit base case\ by (induct n rule: less_induct) auto lemma infinite_descent0 [case_names 0 smaller]: fixes P :: "nat \ bool" assumes "P 0" and "\n. n > 0 \ \ P n \ \m. m < n \ \ P m" shows "P n" proof (rule infinite_descent) show "\n. \ P n \ \m P m" using assms by (case_tac "n > 0") auto qed text \ Infinite descent using a mapping to \nat\: \P x\ is true for all \x \ D\ if there exists a \V \ D \ nat\ and \<^item> case ``0'': given \V x = 0\ prove \P x\ \<^item> ``smaller'': given \V x > 0\ and \\ P x\ prove there exists a \y \ D\ such that \V y < V x\ and \\ P y\. \ corollary infinite_descent0_measure [case_names 0 smaller]: fixes V :: "'a \ nat" assumes 1: "\x. V x = 0 \ P x" and 2: "\x. V x > 0 \ \ P x \ \y. V y < V x \ \ P y" shows "P x" proof - obtain n where "n = V x" by auto moreover have "\x. V x = n \ P x" proof (induct n rule: infinite_descent0) case 0 with 1 show "P x" by auto next case (smaller n) then obtain x where *: "V x = n " and "V x > 0 \ \ P x" by auto with 2 obtain y where "V y < V x \ \ P y" by auto with * obtain m where "m = V y \ m < n \ \ P y" by auto then show ?case by auto qed ultimately show "P x" by auto qed text \Again, without explicit base case:\ lemma infinite_descent_measure: fixes V :: "'a \ nat" assumes "\x. \ P x \ \y. V y < V x \ \ P y" shows "P x" proof - from assms obtain n where "n = V x" by auto moreover have "\x. V x = n \ P x" proof (induct n rule: infinite_descent, auto) show "\m < V x. \y. V y = m \ \ P y" if "\ P x" for x using assms and that by auto qed ultimately show "P x" by auto qed text \A (clumsy) way of lifting \<\ monotonicity to \\\ monotonicity\ lemma less_mono_imp_le_mono: fixes f :: "nat \ nat" and i j :: nat assumes "\i j::nat. i < j \ f i < f j" and "i \ j" shows "f i \ f j" using assms by (auto simp add: order_le_less) text \non-strict, in 1st argument\ lemma add_le_mono1: "i \ j \ i + k \ j + k" for i j k :: nat by (rule add_right_mono) text \non-strict, in both arguments\ lemma add_le_mono: "i \ j \ k \ l \ i + k \ j + l" for i j k l :: nat by (rule add_mono) lemma le_add2: "n \ m + n" for m n :: nat by simp lemma le_add1: "n \ n + m" for m n :: nat by simp lemma less_add_Suc1: "i < Suc (i + m)" by (rule le_less_trans, rule le_add1, rule lessI) lemma less_add_Suc2: "i < Suc (m + i)" by (rule le_less_trans, rule le_add2, rule lessI) lemma less_iff_Suc_add: "m < n \ (\k. n = Suc (m + k))" by (iprover intro!: less_add_Suc1 less_imp_Suc_add) lemma trans_le_add1: "i \ j \ i \ j + m" for i j m :: nat by (rule le_trans, assumption, rule le_add1) lemma trans_le_add2: "i \ j \ i \ m + j" for i j m :: nat by (rule le_trans, assumption, rule le_add2) lemma trans_less_add1: "i < j \ i < j + m" for i j m :: nat by (rule less_le_trans, assumption, rule le_add1) lemma trans_less_add2: "i < j \ i < m + j" for i j m :: nat by (rule less_le_trans, assumption, rule le_add2) lemma add_lessD1: "i + j < k \ i < k" for i j k :: nat by (rule le_less_trans [of _ "i+j"]) (simp_all add: le_add1) lemma not_add_less1 [iff]: "\ i + j < i" for i j :: nat by simp lemma not_add_less2 [iff]: "\ j + i < i" for i j :: nat by simp lemma add_leD1: "m + k \ n \ m \ n" for k m n :: nat by (rule order_trans [of _ "m + k"]) (simp_all add: le_add1) lemma add_leD2: "m + k \ n \ k \ n" for k m n :: nat by (force simp add: add.commute dest: add_leD1) lemma add_leE: "m + k \ n \ (m \ n \ k \ n \ R) \ R" for k m n :: nat by (blast dest: add_leD1 add_leD2) text \needs \\k\ for \ac_simps\ to work\ lemma less_add_eq_less: "\k. k < l \ m + l = k + n \ m < n" for l m n :: nat by (force simp del: add_Suc_right simp add: less_iff_Suc_add add_Suc_right [symmetric] ac_simps) subsubsection \More results about difference\ lemma Suc_diff_le: "n \ m \ Suc m - n = Suc (m - n)" by (induct m n rule: diff_induct) simp_all lemma diff_less_Suc: "m - n < Suc m" by (induct m n rule: diff_induct) (auto simp: less_Suc_eq) lemma diff_le_self [simp]: "m - n \ m" for m n :: nat by (induct m n rule: diff_induct) (simp_all add: le_SucI) lemma less_imp_diff_less: "j < k \ j - n < k" for j k n :: nat by (rule le_less_trans, rule diff_le_self) lemma diff_Suc_less [simp]: "0 < n \ n - Suc i < n" by (cases n) (auto simp add: le_simps) lemma diff_add_assoc: "k \ j \ (i + j) - k = i + (j - k)" for i j k :: nat by (fact ordered_cancel_comm_monoid_diff_class.diff_add_assoc) lemma add_diff_assoc [simp]: "k \ j \ i + (j - k) = i + j - k" for i j k :: nat by (fact ordered_cancel_comm_monoid_diff_class.add_diff_assoc) lemma diff_add_assoc2: "k \ j \ (j + i) - k = (j - k) + i" for i j k :: nat by (fact ordered_cancel_comm_monoid_diff_class.diff_add_assoc2) lemma add_diff_assoc2 [simp]: "k \ j \ j - k + i = j + i - k" for i j k :: nat by (fact ordered_cancel_comm_monoid_diff_class.add_diff_assoc2) lemma le_imp_diff_is_add: "i \ j \ (j - i = k) = (j = k + i)" for i j k :: nat by auto lemma diff_is_0_eq [simp]: "m - n = 0 \ m \ n" for m n :: nat by (induct m n rule: diff_induct) simp_all lemma diff_is_0_eq' [simp]: "m \ n \ m - n = 0" for m n :: nat by (rule iffD2, rule diff_is_0_eq) lemma zero_less_diff [simp]: "0 < n - m \ m < n" for m n :: nat by (induct m n rule: diff_induct) simp_all lemma less_imp_add_positive: assumes "i < j" shows "\k::nat. 0 < k \ i + k = j" proof from assms show "0 < j - i \ i + (j - i) = j" by (simp add: order_less_imp_le) qed text \a nice rewrite for bounded subtraction\ lemma nat_minus_add_max: "n - m + m = max n m" for m n :: nat by (simp add: max_def not_le order_less_imp_le) lemma nat_diff_split: "P (a - b) \ (a < b \ P 0) \ (\d. a = b + d \ P d)" for a b :: nat \ \elimination of \-\ on \nat\\ by (cases "a < b") (auto simp add: not_less le_less dest!: add_eq_self_zero [OF sym]) lemma nat_diff_split_asm: "P (a - b) \ \ (a < b \ \ P 0 \ (\d. a = b + d \ \ P d))" for a b :: nat \ \elimination of \-\ on \nat\ in assumptions\ by (auto split: nat_diff_split) lemma Suc_pred': "0 < n \ n = Suc(n - 1)" by simp lemma add_eq_if: "m + n = (if m = 0 then n else Suc ((m - 1) + n))" unfolding One_nat_def by (cases m) simp_all lemma mult_eq_if: "m * n = (if m = 0 then 0 else n + ((m - 1) * n))" for m n :: nat by (cases m) simp_all lemma Suc_diff_eq_diff_pred: "0 < n \ Suc m - n = m - (n - 1)" by (cases n) simp_all lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n" by (cases m) simp_all lemma Let_Suc [simp]: "Let (Suc n) f \ f (Suc n)" by (fact Let_def) subsubsection \Monotonicity of multiplication\ lemma mult_le_mono1: "i \ j \ i * k \ j * k" for i j k :: nat by (simp add: mult_right_mono) lemma mult_le_mono2: "i \ j \ k * i \ k * j" for i j k :: nat by (simp add: mult_left_mono) text \\\\ monotonicity, BOTH arguments\ lemma mult_le_mono: "i \ j \ k \ l \ i * k \ j * l" for i j k l :: nat by (simp add: mult_mono) lemma mult_less_mono1: "i < j \ 0 < k \ i * k < j * k" for i j k :: nat by (simp add: mult_strict_right_mono) text \Differs from the standard \zero_less_mult_iff\ in that there are no negative numbers.\ lemma nat_0_less_mult_iff [simp]: "0 < m * n \ 0 < m \ 0 < n" for m n :: nat proof (induct m) case 0 then show ?case by simp next case (Suc m) then show ?case by (cases n) simp_all qed lemma one_le_mult_iff [simp]: "Suc 0 \ m * n \ Suc 0 \ m \ Suc 0 \ n" proof (induct m) case 0 then show ?case by simp next case (Suc m) then show ?case by (cases n) simp_all qed lemma mult_less_cancel2 [simp]: "m * k < n * k \ 0 < k \ m < n" for k m n :: nat proof (intro iffI conjI) assume m: "m * k < n * k" then show "0 < k" by (cases k) auto show "m < n" proof (cases k) case 0 then show ?thesis using m by auto next case (Suc k') then show ?thesis using m by (simp flip: linorder_not_le) (blast intro: add_mono mult_le_mono1) qed next assume "0 < k \ m < n" then show "m * k < n * k" by (blast intro: mult_less_mono1) qed lemma mult_less_cancel1 [simp]: "k * m < k * n \ 0 < k \ m < n" for k m n :: nat by (simp add: mult.commute [of k]) lemma mult_le_cancel1 [simp]: "k * m \ k * n \ (0 < k \ m \ n)" for k m n :: nat by (simp add: linorder_not_less [symmetric], auto) lemma mult_le_cancel2 [simp]: "m * k \ n * k \ (0 < k \ m \ n)" for k m n :: nat by (simp add: linorder_not_less [symmetric], auto) lemma Suc_mult_less_cancel1: "Suc k * m < Suc k * n \ m < n" by (subst mult_less_cancel1) simp lemma Suc_mult_le_cancel1: "Suc k * m \ Suc k * n \ m \ n" by (subst mult_le_cancel1) simp lemma le_square: "m \ m * m" for m :: nat by (cases m) (auto intro: le_add1) lemma le_cube: "m \ m * (m * m)" for m :: nat by (cases m) (auto intro: le_add1) text \Lemma for \gcd\\ lemma mult_eq_self_implies_10: fixes m n :: nat assumes "m = m * n" shows "n = 1 \ m = 0" proof (rule disjCI) assume "m \ 0" show "n = 1" proof (cases n "1::nat" rule: linorder_cases) case greater show ?thesis using assms mult_less_mono2 [OF greater, of m] \m \ 0\ by auto qed (use assms \m \ 0\ in auto) qed lemma mono_times_nat: fixes n :: nat assumes "n > 0" shows "mono (times n)" proof fix m q :: nat assume "m \ q" with assms show "n * m \ n * q" by simp qed text \The lattice order on \<^typ>\nat\.\ instantiation nat :: distrib_lattice begin definition "(inf :: nat \ nat \ nat) = min" definition "(sup :: nat \ nat \ nat) = max" instance by intro_classes (auto simp add: inf_nat_def sup_nat_def max_def not_le min_def intro: order_less_imp_le antisym elim!: order_trans order_less_trans) end subsection \Natural operation of natural numbers on functions\ text \ We use the same logical constant for the power operations on functions and relations, in order to share the same syntax. \ consts compow :: "nat \ 'a \ 'a" abbreviation compower :: "'a \ nat \ 'a" (infixr "^^" 80) where "f ^^ n \ compow n f" notation (latex output) compower ("(_\<^bsup>_\<^esup>)" [1000] 1000) text \\f ^^ n = f \ \ \ f\, the \n\-fold composition of \f\\ overloading funpow \ "compow :: nat \ ('a \ 'a) \ ('a \ 'a)" begin primrec funpow :: "nat \ ('a \ 'a) \ 'a \ 'a" where "funpow 0 f = id" | "funpow (Suc n) f = f \ funpow n f" end lemma funpow_0 [simp]: "(f ^^ 0) x = x" by simp lemma funpow_Suc_right: "f ^^ Suc n = f ^^ n \ f" proof (induct n) case 0 then show ?case by simp next fix n assume "f ^^ Suc n = f ^^ n \ f" then show "f ^^ Suc (Suc n) = f ^^ Suc n \ f" by (simp add: o_assoc) qed lemmas funpow_simps_right = funpow.simps(1) funpow_Suc_right text \For code generation.\ definition funpow :: "nat \ ('a \ 'a) \ 'a \ 'a" where funpow_code_def [code_abbrev]: "funpow = compow" lemma [code]: "funpow (Suc n) f = f \ funpow n f" "funpow 0 f = id" by (simp_all add: funpow_code_def) hide_const (open) funpow lemma funpow_add: "f ^^ (m + n) = f ^^ m \ f ^^ n" by (induct m) simp_all lemma funpow_mult: "(f ^^ m) ^^ n = f ^^ (m * n)" for f :: "'a \ 'a" by (induct n) (simp_all add: funpow_add) lemma funpow_swap1: "f ((f ^^ n) x) = (f ^^ n) (f x)" proof - have "f ((f ^^ n) x) = (f ^^ (n + 1)) x" by simp also have "\ = (f ^^ n \ f ^^ 1) x" by (simp only: funpow_add) also have "\ = (f ^^ n) (f x)" by simp finally show ?thesis . qed lemma comp_funpow: "comp f ^^ n = comp (f ^^ n)" for f :: "'a \ 'a" by (induct n) simp_all lemma Suc_funpow[simp]: "Suc ^^ n = ((+) n)" by (induct n) simp_all lemma id_funpow[simp]: "id ^^ n = id" by (induct n) simp_all lemma funpow_mono: "mono f \ A \ B \ (f ^^ n) A \ (f ^^ n) B" for f :: "'a \ ('a::order)" by (induct n arbitrary: A B) (auto simp del: funpow.simps(2) simp add: funpow_Suc_right mono_def) lemma funpow_mono2: assumes "mono f" and "i \ j" and "x \ y" and "x \ f x" shows "(f ^^ i) x \ (f ^^ j) y" using assms(2,3) proof (induct j arbitrary: y) case 0 then show ?case by simp next case (Suc j) show ?case proof(cases "i = Suc j") case True with assms(1) Suc show ?thesis by (simp del: funpow.simps add: funpow_simps_right monoD funpow_mono) next case False with assms(1,4) Suc show ?thesis by (simp del: funpow.simps add: funpow_simps_right le_eq_less_or_eq less_Suc_eq_le) (simp add: Suc.hyps monoD order_subst1) qed qed lemma inj_fn[simp]: fixes f::"'a \ 'a" assumes "inj f" shows "inj (f^^n)" proof (induction n) case Suc thus ?case using inj_compose[OF assms Suc.IH] by (simp del: comp_apply) qed simp lemma surj_fn[simp]: fixes f::"'a \ 'a" assumes "surj f" shows "surj (f^^n)" proof (induction n) case Suc thus ?case by (simp add: comp_surj[OF Suc.IH assms] del: comp_apply) qed simp lemma bij_fn[simp]: fixes f::"'a \ 'a" assumes "bij f" shows "bij (f^^n)" by (rule bijI[OF inj_fn[OF bij_is_inj[OF assms]] surj_fn[OF bij_is_surj[OF assms]]]) subsection \Kleene iteration\ lemma Kleene_iter_lpfp: fixes f :: "'a::order_bot \ 'a" assumes "mono f" and "f p \ p" shows "(f ^^ k) bot \ p" proof (induct k) case 0 show ?case by simp next case Suc show ?case using monoD[OF assms(1) Suc] assms(2) by simp qed lemma lfp_Kleene_iter: assumes "mono f" and "(f ^^ Suc k) bot = (f ^^ k) bot" shows "lfp f = (f ^^ k) bot" proof (rule antisym) show "lfp f \ (f ^^ k) bot" proof (rule lfp_lowerbound) show "f ((f ^^ k) bot) \ (f ^^ k) bot" using assms(2) by simp qed show "(f ^^ k) bot \ lfp f" using Kleene_iter_lpfp[OF assms(1)] lfp_unfold[OF assms(1)] by simp qed lemma mono_pow: "mono f \ mono (f ^^ n)" for f :: "'a \ 'a::complete_lattice" by (induct n) (auto simp: mono_def) lemma lfp_funpow: assumes f: "mono f" shows "lfp (f ^^ Suc n) = lfp f" proof (rule antisym) show "lfp f \ lfp (f ^^ Suc n)" proof (rule lfp_lowerbound) have "f (lfp (f ^^ Suc n)) = lfp (\x. f ((f ^^ n) x))" unfolding funpow_Suc_right by (simp add: lfp_rolling f mono_pow comp_def) then show "f (lfp (f ^^ Suc n)) \ lfp (f ^^ Suc n)" by (simp add: comp_def) qed have "(f ^^ n) (lfp f) = lfp f" for n by (induct n) (auto intro: f lfp_fixpoint) then show "lfp (f ^^ Suc n) \ lfp f" by (intro lfp_lowerbound) (simp del: funpow.simps) qed lemma gfp_funpow: assumes f: "mono f" shows "gfp (f ^^ Suc n) = gfp f" proof (rule antisym) show "gfp f \ gfp (f ^^ Suc n)" proof (rule gfp_upperbound) have "f (gfp (f ^^ Suc n)) = gfp (\x. f ((f ^^ n) x))" unfolding funpow_Suc_right by (simp add: gfp_rolling f mono_pow comp_def) then show "f (gfp (f ^^ Suc n)) \ gfp (f ^^ Suc n)" by (simp add: comp_def) qed have "(f ^^ n) (gfp f) = gfp f" for n by (induct n) (auto intro: f gfp_fixpoint) then show "gfp (f ^^ Suc n) \ gfp f" by (intro gfp_upperbound) (simp del: funpow.simps) qed lemma Kleene_iter_gpfp: fixes f :: "'a::order_top \ 'a" assumes "mono f" and "p \ f p" shows "p \ (f ^^ k) top" proof (induct k) case 0 show ?case by simp next case Suc show ?case using monoD[OF assms(1) Suc] assms(2) by simp qed lemma gfp_Kleene_iter: assumes "mono f" and "(f ^^ Suc k) top = (f ^^ k) top" shows "gfp f = (f ^^ k) top" (is "?lhs = ?rhs") proof (rule antisym) have "?rhs \ f ?rhs" using assms(2) by simp then show "?rhs \ ?lhs" by (rule gfp_upperbound) show "?lhs \ ?rhs" using Kleene_iter_gpfp[OF assms(1)] gfp_unfold[OF assms(1)] by simp qed subsection \Embedding of the naturals into any \semiring_1\: \<^term>\of_nat\\ context semiring_1 begin definition of_nat :: "nat \ 'a" where "of_nat n = (plus 1 ^^ n) 0" lemma of_nat_simps [simp]: shows of_nat_0: "of_nat 0 = 0" and of_nat_Suc: "of_nat (Suc m) = 1 + of_nat m" by (simp_all add: of_nat_def) lemma of_nat_1 [simp]: "of_nat 1 = 1" by (simp add: of_nat_def) lemma of_nat_add [simp]: "of_nat (m + n) = of_nat m + of_nat n" by (induct m) (simp_all add: ac_simps) lemma of_nat_mult [simp]: "of_nat (m * n) = of_nat m * of_nat n" by (induct m) (simp_all add: ac_simps distrib_right) lemma mult_of_nat_commute: "of_nat x * y = y * of_nat x" by (induct x) (simp_all add: algebra_simps) primrec of_nat_aux :: "('a \ 'a) \ nat \ 'a \ 'a" where "of_nat_aux inc 0 i = i" | "of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i)" \ \tail recursive\ lemma of_nat_code: "of_nat n = of_nat_aux (\i. i + 1) n 0" proof (induct n) case 0 then show ?case by simp next case (Suc n) have "\i. of_nat_aux (\i. i + 1) n (i + 1) = of_nat_aux (\i. i + 1) n i + 1" by (induct n) simp_all from this [of 0] have "of_nat_aux (\i. i + 1) n 1 = of_nat_aux (\i. i + 1) n 0 + 1" by simp with Suc show ?case by (simp add: add.commute) qed lemma of_nat_of_bool [simp]: "of_nat (of_bool P) = of_bool P" by auto end declare of_nat_code [code] context semiring_1_cancel begin lemma of_nat_diff: \of_nat (m - n) = of_nat m - of_nat n\ if \n \ m\ proof - from that obtain q where \m = n + q\ by (blast dest: le_Suc_ex) then show ?thesis by simp qed end text \Class for unital semirings with characteristic zero. Includes non-ordered rings like the complex numbers.\ class semiring_char_0 = semiring_1 + assumes inj_of_nat: "inj of_nat" begin lemma of_nat_eq_iff [simp]: "of_nat m = of_nat n \ m = n" by (auto intro: inj_of_nat injD) text \Special cases where either operand is zero\ lemma of_nat_0_eq_iff [simp]: "0 = of_nat n \ 0 = n" by (fact of_nat_eq_iff [of 0 n, unfolded of_nat_0]) lemma of_nat_eq_0_iff [simp]: "of_nat m = 0 \ m = 0" by (fact of_nat_eq_iff [of m 0, unfolded of_nat_0]) lemma of_nat_1_eq_iff [simp]: "1 = of_nat n \ n=1" using of_nat_eq_iff by fastforce lemma of_nat_eq_1_iff [simp]: "of_nat n = 1 \ n=1" using of_nat_eq_iff by fastforce lemma of_nat_neq_0 [simp]: "of_nat (Suc n) \ 0" unfolding of_nat_eq_0_iff by simp lemma of_nat_0_neq [simp]: "0 \ of_nat (Suc n)" unfolding of_nat_0_eq_iff by simp end class ring_char_0 = ring_1 + semiring_char_0 context linordered_nonzero_semiring begin lemma of_nat_0_le_iff [simp]: "0 \ of_nat n" by (induct n) simp_all lemma of_nat_less_0_iff [simp]: "\ of_nat m < 0" by (simp add: not_less) lemma of_nat_mono[simp]: "i \ j \ of_nat i \ of_nat j" by (auto simp: le_iff_add intro!: add_increasing2) lemma of_nat_less_iff [simp]: "of_nat m < of_nat n \ m < n" proof(induct m n rule: diff_induct) case (1 m) then show ?case by auto next case (2 n) then show ?case by (simp add: add_pos_nonneg) next case (3 m n) then show ?case by (auto simp: add_commute [of 1] add_mono1 not_less add_right_mono leD) qed lemma of_nat_le_iff [simp]: "of_nat m \ of_nat n \ m \ n" by (simp add: not_less [symmetric] linorder_not_less [symmetric]) lemma less_imp_of_nat_less: "m < n \ of_nat m < of_nat n" by simp lemma of_nat_less_imp_less: "of_nat m < of_nat n \ m < n" by simp text \Every \linordered_nonzero_semiring\ has characteristic zero.\ subclass semiring_char_0 - by standard (auto intro!: injI simp add: eq_iff) + by standard (auto intro!: injI simp add: order.eq_iff) text \Special cases where either operand is zero\ lemma of_nat_le_0_iff [simp]: "of_nat m \ 0 \ m = 0" by (rule of_nat_le_iff [of _ 0, simplified]) lemma of_nat_0_less_iff [simp]: "0 < of_nat n \ 0 < n" by (rule of_nat_less_iff [of 0, simplified]) end context linordered_nonzero_semiring begin lemma of_nat_max: "of_nat (max x y) = max (of_nat x) (of_nat y)" by (auto simp: max_def ord_class.max_def) lemma of_nat_min: "of_nat (min x y) = min (of_nat x) (of_nat y)" by (auto simp: min_def ord_class.min_def) end context linordered_semidom begin subclass linordered_nonzero_semiring .. subclass semiring_char_0 .. end context linordered_idom begin lemma abs_of_nat [simp]: "\of_nat n\ = of_nat n" by (simp add: abs_if) lemma sgn_of_nat [simp]: "sgn (of_nat n) = of_bool (n > 0)" by simp end lemma of_nat_id [simp]: "of_nat n = n" by (induct n) simp_all lemma of_nat_eq_id [simp]: "of_nat = id" by (auto simp add: fun_eq_iff) subsection \The set of natural numbers\ context semiring_1 begin definition Nats :: "'a set" ("\") where "\ = range of_nat" lemma of_nat_in_Nats [simp]: "of_nat n \ \" by (simp add: Nats_def) lemma Nats_0 [simp]: "0 \ \" using of_nat_0 [symmetric] unfolding Nats_def by (rule range_eqI) lemma Nats_1 [simp]: "1 \ \" using of_nat_1 [symmetric] unfolding Nats_def by (rule range_eqI) lemma Nats_add [simp]: "a \ \ \ b \ \ \ a + b \ \" unfolding Nats_def using of_nat_add [symmetric] by (blast intro: range_eqI) lemma Nats_mult [simp]: "a \ \ \ b \ \ \ a * b \ \" unfolding Nats_def using of_nat_mult [symmetric] by (blast intro: range_eqI) lemma Nats_cases [cases set: Nats]: assumes "x \ \" obtains (of_nat) n where "x = of_nat n" unfolding Nats_def proof - from \x \ \\ have "x \ range of_nat" unfolding Nats_def . then obtain n where "x = of_nat n" .. then show thesis .. qed lemma Nats_induct [case_names of_nat, induct set: Nats]: "x \ \ \ (\n. P (of_nat n)) \ P x" by (rule Nats_cases) auto end lemma Nats_diff [simp]: fixes a:: "'a::linordered_idom" assumes "a \ \" "b \ \" "b \ a" shows "a - b \ \" proof - obtain i where i: "a = of_nat i" using Nats_cases assms by blast obtain j where j: "b = of_nat j" using Nats_cases assms by blast have "j \ i" using \b \ a\ i j of_nat_le_iff by blast then have *: "of_nat i - of_nat j = (of_nat (i-j) :: 'a)" by (simp add: of_nat_diff) then show ?thesis by (simp add: * i j) qed subsection \Further arithmetic facts concerning the natural numbers\ lemma subst_equals: assumes "t = s" and "u = t" shows "u = s" using assms(2,1) by (rule trans) locale nat_arith begin lemma add1: "(A::'a::comm_monoid_add) \ k + a \ A + b \ k + (a + b)" by (simp only: ac_simps) lemma add2: "(B::'a::comm_monoid_add) \ k + b \ a + B \ k + (a + b)" by (simp only: ac_simps) lemma suc1: "A == k + a \ Suc A \ k + Suc a" by (simp only: add_Suc_right) lemma rule0: "(a::'a::comm_monoid_add) \ a + 0" by (simp only: add_0_right) end ML_file \Tools/nat_arith.ML\ simproc_setup nateq_cancel_sums ("(l::nat) + m = n" | "(l::nat) = m + n" | "Suc m = n" | "m = Suc n") = \fn phi => try o Nat_Arith.cancel_eq_conv\ simproc_setup natless_cancel_sums ("(l::nat) + m < n" | "(l::nat) < m + n" | "Suc m < n" | "m < Suc n") = \fn phi => try o Nat_Arith.cancel_less_conv\ simproc_setup natle_cancel_sums ("(l::nat) + m \ n" | "(l::nat) \ m + n" | "Suc m \ n" | "m \ Suc n") = \fn phi => try o Nat_Arith.cancel_le_conv\ simproc_setup natdiff_cancel_sums ("(l::nat) + m - n" | "(l::nat) - (m + n)" | "Suc m - n" | "m - Suc n") = \fn phi => try o Nat_Arith.cancel_diff_conv\ context order begin lemma lift_Suc_mono_le: assumes mono: "\n. f n \ f (Suc n)" and "n \ n'" shows "f n \ f n'" proof (cases "n < n'") case True then show ?thesis by (induct n n' rule: less_Suc_induct) (auto intro: mono) next case False with \n \ n'\ show ?thesis by auto qed lemma lift_Suc_antimono_le: assumes mono: "\n. f n \ f (Suc n)" and "n \ n'" shows "f n \ f n'" proof (cases "n < n'") case True then show ?thesis by (induct n n' rule: less_Suc_induct) (auto intro: mono) next case False with \n \ n'\ show ?thesis by auto qed lemma lift_Suc_mono_less: assumes mono: "\n. f n < f (Suc n)" and "n < n'" shows "f n < f n'" using \n < n'\ by (induct n n' rule: less_Suc_induct) (auto intro: mono) lemma lift_Suc_mono_less_iff: "(\n. f n < f (Suc n)) \ f n < f m \ n < m" by (blast intro: less_asym' lift_Suc_mono_less [of f] dest: linorder_not_less[THEN iffD1] le_eq_less_or_eq [THEN iffD1]) end lemma mono_iff_le_Suc: "mono f \ (\n. f n \ f (Suc n))" unfolding mono_def by (auto intro: lift_Suc_mono_le [of f]) lemma antimono_iff_le_Suc: "antimono f \ (\n. f (Suc n) \ f n)" unfolding antimono_def by (auto intro: lift_Suc_antimono_le [of f]) lemma mono_nat_linear_lb: fixes f :: "nat \ nat" assumes "\m n. m < n \ f m < f n" shows "f m + k \ f (m + k)" proof (induct k) case 0 then show ?case by simp next case (Suc k) then have "Suc (f m + k) \ Suc (f (m + k))" by simp also from assms [of "m + k" "Suc (m + k)"] have "Suc (f (m + k)) \ f (Suc (m + k))" by (simp add: Suc_le_eq) finally show ?case by simp qed text \Subtraction laws, mostly by Clemens Ballarin\ lemma diff_less_mono: fixes a b c :: nat assumes "a < b" and "c \ a" shows "a - c < b - c" proof - from assms obtain d e where "b = c + (d + e)" and "a = c + e" and "d > 0" by (auto dest!: le_Suc_ex less_imp_Suc_add simp add: ac_simps) then show ?thesis by simp qed lemma less_diff_conv: "i < j - k \ i + k < j" for i j k :: nat by (cases "k \ j") (auto simp add: not_le dest: less_imp_Suc_add le_Suc_ex) lemma less_diff_conv2: "k \ j \ j - k < i \ j < i + k" for j k i :: nat by (auto dest: le_Suc_ex) lemma le_diff_conv: "j - k \ i \ j \ i + k" for j k i :: nat by (cases "k \ j") (auto simp add: not_le dest!: less_imp_Suc_add le_Suc_ex) lemma diff_diff_cancel [simp]: "i \ n \ n - (n - i) = i" for i n :: nat by (auto dest: le_Suc_ex) lemma diff_less [simp]: "0 < n \ 0 < m \ m - n < m" for i n :: nat by (auto dest: less_imp_Suc_add) text \Simplification of relational expressions involving subtraction\ lemma diff_diff_eq: "k \ m \ k \ n \ m - k - (n - k) = m - n" for m n k :: nat by (auto dest!: le_Suc_ex) hide_fact (open) diff_diff_eq lemma eq_diff_iff: "k \ m \ k \ n \ m - k = n - k \ m = n" for m n k :: nat by (auto dest: le_Suc_ex) lemma less_diff_iff: "k \ m \ k \ n \ m - k < n - k \ m < n" for m n k :: nat by (auto dest!: le_Suc_ex) lemma le_diff_iff: "k \ m \ k \ n \ m - k \ n - k \ m \ n" for m n k :: nat by (auto dest!: le_Suc_ex) lemma le_diff_iff': "a \ c \ b \ c \ c - a \ c - b \ b \ a" for a b c :: nat by (force dest: le_Suc_ex) text \(Anti)Monotonicity of subtraction -- by Stephan Merz\ lemma diff_le_mono: "m \ n \ m - l \ n - l" for m n l :: nat by (auto dest: less_imp_le less_imp_Suc_add split: nat_diff_split) lemma diff_le_mono2: "m \ n \ l - n \ l - m" for m n l :: nat by (auto dest: less_imp_le le_Suc_ex less_imp_Suc_add less_le_trans split: nat_diff_split) lemma diff_less_mono2: "m < n \ m < l \ l - n < l - m" for m n l :: nat by (auto dest: less_imp_Suc_add split: nat_diff_split) lemma diffs0_imp_equal: "m - n = 0 \ n - m = 0 \ m = n" for m n :: nat by (simp split: nat_diff_split) lemma min_diff: "min (m - i) (n - i) = min m n - i" for m n i :: nat by (cases m n rule: le_cases) (auto simp add: not_le min.absorb1 min.absorb2 min.absorb_iff1 [symmetric] diff_le_mono) lemma inj_on_diff_nat: fixes k :: nat assumes "\n. n \ N \ k \ n" shows "inj_on (\n. n - k) N" proof (rule inj_onI) fix x y assume a: "x \ N" "y \ N" "x - k = y - k" with assms have "x - k + k = y - k + k" by auto with a assms show "x = y" by (auto simp add: eq_diff_iff) qed text \Rewriting to pull differences out\ lemma diff_diff_right [simp]: "k \ j \ i - (j - k) = i + k - j" for i j k :: nat by (fact diff_diff_right) lemma diff_Suc_diff_eq1 [simp]: assumes "k \ j" shows "i - Suc (j - k) = i + k - Suc j" proof - from assms have *: "Suc (j - k) = Suc j - k" by (simp add: Suc_diff_le) from assms have "k \ Suc j" by (rule order_trans) simp with diff_diff_right [of k "Suc j" i] * show ?thesis by simp qed lemma diff_Suc_diff_eq2 [simp]: assumes "k \ j" shows "Suc (j - k) - i = Suc j - (k + i)" proof - from assms obtain n where "j = k + n" by (auto dest: le_Suc_ex) moreover have "Suc n - i = (k + Suc n) - (k + i)" using add_diff_cancel_left [of k "Suc n" i] by simp ultimately show ?thesis by simp qed lemma Suc_diff_Suc: assumes "n < m" shows "Suc (m - Suc n) = m - n" proof - from assms obtain q where "m = n + Suc q" by (auto dest: less_imp_Suc_add) moreover define r where "r = Suc q" ultimately have "Suc (m - Suc n) = r" and "m = n + r" by simp_all then show ?thesis by simp qed lemma one_less_mult: "Suc 0 < n \ Suc 0 < m \ Suc 0 < m * n" using less_1_mult [of n m] by (simp add: ac_simps) lemma n_less_m_mult_n: "0 < n \ Suc 0 < m \ n < m * n" using mult_strict_right_mono [of 1 m n] by simp lemma n_less_n_mult_m: "0 < n \ Suc 0 < m \ n < n * m" using mult_strict_left_mono [of 1 m n] by simp text \Induction starting beyond zero\ lemma nat_induct_at_least [consumes 1, case_names base Suc]: "P n" if "n \ m" "P m" "\n. n \ m \ P n \ P (Suc n)" proof - define q where "q = n - m" with \n \ m\ have "n = m + q" by simp moreover have "P (m + q)" by (induction q) (use that in simp_all) ultimately show "P n" by simp qed lemma nat_induct_non_zero [consumes 1, case_names 1 Suc]: "P n" if "n > 0" "P 1" "\n. n > 0 \ P n \ P (Suc n)" proof - from \n > 0\ have "n \ 1" by (cases n) simp_all moreover note \P 1\ moreover have "\n. n \ 1 \ P n \ P (Suc n)" using \\n. n > 0 \ P n \ P (Suc n)\ by (simp add: Suc_le_eq) ultimately show "P n" by (rule nat_induct_at_least) qed text \Specialized induction principles that work "backwards":\ lemma inc_induct [consumes 1, case_names base step]: assumes less: "i \ j" and base: "P j" and step: "\n. i \ n \ n < j \ P (Suc n) \ P n" shows "P i" using less step proof (induct "j - i" arbitrary: i) case (0 i) then have "i = j" by simp with base show ?case by simp next case (Suc d n) from Suc.hyps have "n \ j" by auto with Suc have "n < j" by (simp add: less_le) from \Suc d = j - n\ have "d + 1 = j - n" by simp then have "d + 1 - 1 = j - n - 1" by simp then have "d = j - n - 1" by simp then have "d = j - (n + 1)" by (simp add: diff_diff_eq) then have "d = j - Suc n" by simp moreover from \n < j\ have "Suc n \ j" by (simp add: Suc_le_eq) ultimately have "P (Suc n)" proof (rule Suc.hyps) fix q assume "Suc n \ q" then have "n \ q" by (simp add: Suc_le_eq less_imp_le) moreover assume "q < j" moreover assume "P (Suc q)" ultimately show "P q" by (rule Suc.prems) qed with order_refl \n < j\ show "P n" by (rule Suc.prems) qed lemma strict_inc_induct [consumes 1, case_names base step]: assumes less: "i < j" and base: "\i. j = Suc i \ P i" and step: "\i. i < j \ P (Suc i) \ P i" shows "P i" using less proof (induct "j - i - 1" arbitrary: i) case (0 i) from \i < j\ obtain n where "j = i + n" and "n > 0" by (auto dest!: less_imp_Suc_add) with 0 have "j = Suc i" by (auto intro: order_antisym simp add: Suc_le_eq) with base show ?case by simp next case (Suc d i) from \Suc d = j - i - 1\ have *: "Suc d = j - Suc i" by (simp add: diff_diff_add) then have "Suc d - 1 = j - Suc i - 1" by simp then have "d = j - Suc i - 1" by simp moreover from * have "j - Suc i \ 0" by auto then have "Suc i < j" by (simp add: not_le) ultimately have "P (Suc i)" by (rule Suc.hyps) with \i < j\ show "P i" by (rule step) qed lemma zero_induct_lemma: "P k \ (\n. P (Suc n) \ P n) \ P (k - i)" using inc_induct[of "k - i" k P, simplified] by blast lemma zero_induct: "P k \ (\n. P (Suc n) \ P n) \ P 0" using inc_induct[of 0 k P] by blast text \Further induction rule similar to @{thm inc_induct}.\ lemma dec_induct [consumes 1, case_names base step]: "i \ j \ P i \ (\n. i \ n \ n < j \ P n \ P (Suc n)) \ P j" proof (induct j arbitrary: i) case 0 then show ?case by simp next case (Suc j) from Suc.prems consider "i \ j" | "i = Suc j" by (auto simp add: le_Suc_eq) then show ?case proof cases case 1 moreover have "j < Suc j" by simp moreover have "P j" using \i \ j\ \P i\ proof (rule Suc.hyps) fix q assume "i \ q" moreover assume "q < j" then have "q < Suc j" by (simp add: less_Suc_eq) moreover assume "P q" ultimately show "P (Suc q)" by (rule Suc.prems) qed ultimately show "P (Suc j)" by (rule Suc.prems) next case 2 with \P i\ show "P (Suc j)" by simp qed qed lemma transitive_stepwise_le: assumes "m \ n" "\x. R x x" "\x y z. R x y \ R y z \ R x z" and "\n. R n (Suc n)" shows "R m n" using \m \ n\ by (induction rule: dec_induct) (use assms in blast)+ subsubsection \Greatest operator\ lemma ex_has_greatest_nat: "P (k::nat) \ \y. P y \ y \ b \ \x. P x \ (\y. P y \ y \ x)" proof (induction "b-k" arbitrary: b k rule: less_induct) case less show ?case proof cases assume "\n>k. P n" then obtain n where "n>k" "P n" by blast have "n \ b" using \P n\ less.prems(2) by auto hence "b-n < b-k" by(rule diff_less_mono2[OF \k less_le_trans[OF \k]]) from less.hyps[OF this \P n\ less.prems(2)] show ?thesis . next assume "\ (\n>k. P n)" hence "\y. P y \ y \ k" by (auto simp: not_less) thus ?thesis using less.prems(1) by auto qed qed lemma fixes k::nat assumes "P k" and minor: "\y. P y \ y \ b" shows GreatestI_nat: "P (Greatest P)" and Greatest_le_nat: "k \ Greatest P" proof - obtain x where "P x" "\y. P y \ y \ x" using assms ex_has_greatest_nat by blast with \P k\ show "P (Greatest P)" "k \ Greatest P" using GreatestI2_order by blast+ qed lemma GreatestI_ex_nat: "\ \k::nat. P k; \y. P y \ y \ b \ \ P (Greatest P)" by (blast intro: GreatestI_nat) subsection \Monotonicity of \funpow\\ lemma funpow_increasing: "m \ n \ mono f \ (f ^^ n) \ \ (f ^^ m) \" for f :: "'a::{lattice,order_top} \ 'a" by (induct rule: inc_induct) (auto simp del: funpow.simps(2) simp add: funpow_Suc_right intro: order_trans[OF _ funpow_mono]) lemma funpow_decreasing: "m \ n \ mono f \ (f ^^ m) \ \ (f ^^ n) \" for f :: "'a::{lattice,order_bot} \ 'a" by (induct rule: dec_induct) (auto simp del: funpow.simps(2) simp add: funpow_Suc_right intro: order_trans[OF _ funpow_mono]) lemma mono_funpow: "mono Q \ mono (\i. (Q ^^ i) \)" for Q :: "'a::{lattice,order_bot} \ 'a" by (auto intro!: funpow_decreasing simp: mono_def) lemma antimono_funpow: "mono Q \ antimono (\i. (Q ^^ i) \)" for Q :: "'a::{lattice,order_top} \ 'a" by (auto intro!: funpow_increasing simp: antimono_def) subsection \The divides relation on \<^typ>\nat\\ lemma dvd_1_left [iff]: "Suc 0 dvd k" by (simp add: dvd_def) lemma dvd_1_iff_1 [simp]: "m dvd Suc 0 \ m = Suc 0" by (simp add: dvd_def) lemma nat_dvd_1_iff_1 [simp]: "m dvd 1 \ m = 1" for m :: nat by (simp add: dvd_def) lemma dvd_antisym: "m dvd n \ n dvd m \ m = n" for m n :: nat unfolding dvd_def by (force dest: mult_eq_self_implies_10 simp add: mult.assoc) lemma dvd_diff_nat [simp]: "k dvd m \ k dvd n \ k dvd (m - n)" for k m n :: nat unfolding dvd_def by (blast intro: right_diff_distrib' [symmetric]) lemma dvd_diffD: fixes k m n :: nat assumes "k dvd m - n" "k dvd n" "n \ m" shows "k dvd m" proof - have "k dvd n + (m - n)" using assms by (blast intro: dvd_add) with assms show ?thesis by simp qed lemma dvd_diffD1: "k dvd m - n \ k dvd m \ n \ m \ k dvd n" for k m n :: nat by (drule_tac m = m in dvd_diff_nat) auto lemma dvd_mult_cancel: fixes m n k :: nat assumes "k * m dvd k * n" and "0 < k" shows "m dvd n" proof - from assms(1) obtain q where "k * n = (k * m) * q" .. then have "k * n = k * (m * q)" by (simp add: ac_simps) with \0 < k\ have "n = m * q" by (auto simp add: mult_left_cancel) then show ?thesis .. qed lemma dvd_mult_cancel1: fixes m n :: nat assumes "0 < m" shows "m * n dvd m \ n = 1" proof assume "m * n dvd m" then have "m * n dvd m * 1" by simp then have "n dvd 1" by (iprover intro: assms dvd_mult_cancel) then show "n = 1" by auto qed auto lemma dvd_mult_cancel2: "0 < m \ n * m dvd m \ n = 1" for m n :: nat using dvd_mult_cancel1 [of m n] by (simp add: ac_simps) lemma dvd_imp_le: "k dvd n \ 0 < n \ k \ n" for k n :: nat by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc) lemma nat_dvd_not_less: "0 < m \ m < n \ \ n dvd m" for m n :: nat by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc) lemma less_eq_dvd_minus: fixes m n :: nat assumes "m \ n" shows "m dvd n \ m dvd n - m" proof - from assms have "n = m + (n - m)" by simp then obtain q where "n = m + q" .. then show ?thesis by (simp add: add.commute [of m]) qed lemma dvd_minus_self: "m dvd n - m \ n < m \ m dvd n" for m n :: nat by (cases "n < m") (auto elim!: dvdE simp add: not_less le_imp_diff_is_add dest: less_imp_le) lemma dvd_minus_add: fixes m n q r :: nat assumes "q \ n" "q \ r * m" shows "m dvd n - q \ m dvd n + (r * m - q)" proof - have "m dvd n - q \ m dvd r * m + (n - q)" using dvd_add_times_triv_left_iff [of m r] by simp also from assms have "\ \ m dvd r * m + n - q" by simp also from assms have "\ \ m dvd (r * m - q) + n" by simp also have "\ \ m dvd n + (r * m - q)" by (simp add: add.commute) finally show ?thesis . qed subsection \Aliasses\ lemma nat_mult_1: "1 * n = n" for n :: nat by (fact mult_1_left) lemma nat_mult_1_right: "n * 1 = n" for n :: nat by (fact mult_1_right) lemma diff_mult_distrib: "(m - n) * k = (m * k) - (n * k)" for k m n :: nat by (fact left_diff_distrib') lemma diff_mult_distrib2: "k * (m - n) = (k * m) - (k * n)" for k m n :: nat by (fact right_diff_distrib') (*Used in AUTO2 and Groups.le_diff_conv2 (with variables renamed) doesn't work for some reason*) lemma le_diff_conv2: "k \ j \ (i \ j - k) = (i + k \ j)" for i j k :: nat by (fact le_diff_conv2) lemma diff_self_eq_0 [simp]: "m - m = 0" for m :: nat by (fact diff_cancel) lemma diff_diff_left [simp]: "i - j - k = i - (j + k)" for i j k :: nat by (fact diff_diff_add) lemma diff_commute: "i - j - k = i - k - j" for i j k :: nat by (fact diff_right_commute) lemma diff_add_inverse: "(n + m) - n = m" for m n :: nat by (fact add_diff_cancel_left') lemma diff_add_inverse2: "(m + n) - n = m" for m n :: nat by (fact add_diff_cancel_right') lemma diff_cancel: "(k + m) - (k + n) = m - n" for k m n :: nat by (fact add_diff_cancel_left) lemma diff_cancel2: "(m + k) - (n + k) = m - n" for k m n :: nat by (fact add_diff_cancel_right) lemma diff_add_0: "n - (n + m) = 0" for m n :: nat by (fact diff_add_zero) lemma add_mult_distrib2: "k * (m + n) = (k * m) + (k * n)" for k m n :: nat by (fact distrib_left) lemmas nat_distrib = add_mult_distrib distrib_left diff_mult_distrib diff_mult_distrib2 subsection \Size of a datatype value\ class size = fixes size :: "'a \ nat" \ \see further theory \Wellfounded\\ instantiation nat :: size begin definition size_nat where [simp, code]: "size (n::nat) = n" instance .. end lemmas size_nat = size_nat_def lemma size_neq_size_imp_neq: "size x \ size y \ x \ y" by (erule contrapos_nn) (rule arg_cong) subsection \Code module namespace\ code_identifier code_module Nat \ (SML) Arith and (OCaml) Arith and (Haskell) Arith hide_const (open) of_nat_aux end diff --git a/src/HOL/Orderings.thy b/src/HOL/Orderings.thy --- a/src/HOL/Orderings.thy +++ b/src/HOL/Orderings.thy @@ -1,1801 +1,1805 @@ (* Title: HOL/Orderings.thy Author: Tobias Nipkow, Markus Wenzel, and Larry Paulson *) section \Abstract orderings\ theory Orderings imports HOL keywords "print_orders" :: diag begin ML_file \~~/src/Provers/order.ML\ subsection \Abstract ordering\ locale partial_preordering = fixes less_eq :: \'a \ 'a \ bool\ (infix \\<^bold>\\ 50) assumes refl: \a \<^bold>\ a\ \ \not \iff\: makes problems due to multiple (dual) interpretations\ and trans: \a \<^bold>\ b \ b \<^bold>\ c \ a \<^bold>\ c\ locale preordering = partial_preordering + fixes less :: \'a \ 'a \ bool\ (infix \\<^bold><\ 50) assumes strict_iff_not: \a \<^bold>< b \ a \<^bold>\ b \ \ b \<^bold>\ a\ begin lemma strict_implies_order: \a \<^bold>< b \ a \<^bold>\ b\ by (simp add: strict_iff_not) lemma irrefl: \ \not \iff\: makes problems due to multiple (dual) interpretations\ \\ a \<^bold>< a\ by (simp add: strict_iff_not) lemma asym: \a \<^bold>< b \ b \<^bold>< a \ False\ by (auto simp add: strict_iff_not) lemma strict_trans1: \a \<^bold>\ b \ b \<^bold>< c \ a \<^bold>< c\ by (auto simp add: strict_iff_not intro: trans) lemma strict_trans2: \a \<^bold>< b \ b \<^bold>\ c \ a \<^bold>< c\ by (auto simp add: strict_iff_not intro: trans) lemma strict_trans: \a \<^bold>< b \ b \<^bold>< c \ a \<^bold>< c\ by (auto intro: strict_trans1 strict_implies_order) end lemma preordering_strictI: \ \Alternative introduction rule with bias towards strict order\ fixes less_eq (infix \\<^bold>\\ 50) and less (infix \\<^bold><\ 50) assumes less_eq_less: \\a b. a \<^bold>\ b \ a \<^bold>< b \ a = b\ assumes asym: \\a b. a \<^bold>< b \ \ b \<^bold>< a\ assumes irrefl: \\a. \ a \<^bold>< a\ assumes trans: \\a b c. a \<^bold>< b \ b \<^bold>< c \ a \<^bold>< c\ shows \preordering (\<^bold>\) (\<^bold><)\ proof fix a b show \a \<^bold>< b \ a \<^bold>\ b \ \ b \<^bold>\ a\ by (auto simp add: less_eq_less asym irrefl) next fix a show \a \<^bold>\ a\ by (auto simp add: less_eq_less) next fix a b c assume \a \<^bold>\ b\ and \b \<^bold>\ c\ then show \a \<^bold>\ c\ by (auto simp add: less_eq_less intro: trans) qed lemma preordering_dualI: fixes less_eq (infix \\<^bold>\\ 50) and less (infix \\<^bold><\ 50) assumes \preordering (\a b. b \<^bold>\ a) (\a b. b \<^bold>< a)\ shows \preordering (\<^bold>\) (\<^bold><)\ proof - from assms interpret preordering \\a b. b \<^bold>\ a\ \\a b. b \<^bold>< a\ . show ?thesis by standard (auto simp: strict_iff_not refl intro: trans) qed locale ordering = partial_preordering + fixes less :: \'a \ 'a \ bool\ (infix \\<^bold><\ 50) assumes strict_iff_order: \a \<^bold>< b \ a \<^bold>\ b \ a \ b\ assumes antisym: \a \<^bold>\ b \ b \<^bold>\ a \ a = b\ begin sublocale preordering \(\<^bold>\)\ \(\<^bold><)\ proof show \a \<^bold>< b \ a \<^bold>\ b \ \ b \<^bold>\ a\ for a b by (auto simp add: strict_iff_order intro: antisym) qed lemma strict_implies_not_eq: \a \<^bold>< b \ a \ b\ by (simp add: strict_iff_order) lemma not_eq_order_implies_strict: \a \ b \ a \<^bold>\ b \ a \<^bold>< b\ by (simp add: strict_iff_order) lemma order_iff_strict: \a \<^bold>\ b \ a \<^bold>< b \ a = b\ by (auto simp add: strict_iff_order refl) lemma eq_iff: \a = b \ a \<^bold>\ b \ b \<^bold>\ a\ by (auto simp add: refl intro: antisym) end lemma ordering_strictI: \ \Alternative introduction rule with bias towards strict order\ fixes less_eq (infix \\<^bold>\\ 50) and less (infix \\<^bold><\ 50) assumes less_eq_less: \\a b. a \<^bold>\ b \ a \<^bold>< b \ a = b\ assumes asym: \\a b. a \<^bold>< b \ \ b \<^bold>< a\ assumes irrefl: \\a. \ a \<^bold>< a\ assumes trans: \\a b c. a \<^bold>< b \ b \<^bold>< c \ a \<^bold>< c\ shows \ordering (\<^bold>\) (\<^bold><)\ proof fix a b show \a \<^bold>< b \ a \<^bold>\ b \ a \ b\ by (auto simp add: less_eq_less asym irrefl) next fix a show \a \<^bold>\ a\ by (auto simp add: less_eq_less) next fix a b c assume \a \<^bold>\ b\ and \b \<^bold>\ c\ then show \a \<^bold>\ c\ by (auto simp add: less_eq_less intro: trans) next fix a b assume \a \<^bold>\ b\ and \b \<^bold>\ a\ then show \a = b\ by (auto simp add: less_eq_less asym) qed lemma ordering_dualI: fixes less_eq (infix \\<^bold>\\ 50) and less (infix \\<^bold><\ 50) assumes \ordering (\a b. b \<^bold>\ a) (\a b. b \<^bold>< a)\ shows \ordering (\<^bold>\) (\<^bold><)\ proof - from assms interpret ordering \\a b. b \<^bold>\ a\ \\a b. b \<^bold>< a\ . show ?thesis by standard (auto simp: strict_iff_order refl intro: antisym trans) qed locale ordering_top = ordering + fixes top :: \'a\ (\\<^bold>\\) assumes extremum [simp]: \a \<^bold>\ \<^bold>\\ begin lemma extremum_uniqueI: \\<^bold>\ \<^bold>\ a \ a = \<^bold>\\ by (rule antisym) auto lemma extremum_unique: \\<^bold>\ \<^bold>\ a \ a = \<^bold>\\ by (auto intro: antisym) lemma extremum_strict [simp]: \\ (\<^bold>\ \<^bold>< a)\ using extremum [of a] by (auto simp add: order_iff_strict intro: asym irrefl) lemma not_eq_extremum: \a \ \<^bold>\ \ a \<^bold>< \<^bold>\\ by (auto simp add: order_iff_strict intro: not_eq_order_implies_strict extremum) end subsection \Syntactic orders\ class ord = fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" begin notation less_eq ("'(\')") and less_eq ("(_/ \ _)" [51, 51] 50) and less ("'(<')") and less ("(_/ < _)" [51, 51] 50) abbreviation (input) greater_eq (infix "\" 50) where "x \ y \ y \ x" abbreviation (input) greater (infix ">" 50) where "x > y \ y < x" notation (ASCII) less_eq ("'(<=')") and less_eq ("(_/ <= _)" [51, 51] 50) notation (input) greater_eq (infix ">=" 50) end subsection \Quasi orders\ class preorder = ord + assumes less_le_not_le: "x < y \ x \ y \ \ (y \ x)" and order_refl [iff]: "x \ x" and order_trans: "x \ y \ y \ z \ x \ z" begin sublocale order: preordering less_eq less + dual_order: preordering greater_eq greater proof - interpret preordering less_eq less by standard (auto intro: order_trans simp add: less_le_not_le) show \preordering less_eq less\ by (fact preordering_axioms) then show \preordering greater_eq greater\ by (rule preordering_dualI) qed text \Reflexivity.\ lemma eq_refl: "x = y \ x \ y" \ \This form is useful with the classical reasoner.\ by (erule ssubst) (rule order_refl) lemma less_irrefl [iff]: "\ x < x" by (simp add: less_le_not_le) lemma less_imp_le: "x < y \ x \ y" by (simp add: less_le_not_le) text \Asymmetry.\ lemma less_not_sym: "x < y \ \ (y < x)" by (simp add: less_le_not_le) lemma less_asym: "x < y \ (\ P \ y < x) \ P" by (drule less_not_sym, erule contrapos_np) simp text \Transitivity.\ lemma less_trans: "x < y \ y < z \ x < z" by (auto simp add: less_le_not_le intro: order_trans) lemma le_less_trans: "x \ y \ y < z \ x < z" by (auto simp add: less_le_not_le intro: order_trans) lemma less_le_trans: "x < y \ y \ z \ x < z" by (auto simp add: less_le_not_le intro: order_trans) text \Useful for simplification, but too risky to include by default.\ lemma less_imp_not_less: "x < y \ (\ y < x) \ True" by (blast elim: less_asym) lemma less_imp_triv: "x < y \ (y < x \ P) \ True" by (blast elim: less_asym) text \Transitivity rules for calculational reasoning\ lemma less_asym': "a < b \ b < a \ P" by (rule less_asym) text \Dual order\ lemma dual_preorder: \class.preorder (\) (>)\ by standard (auto simp add: less_le_not_le intro: order_trans) end subsection \Partial orders\ class order = preorder + - assumes antisym: "x \ y \ y \ x \ x = y" + assumes order_antisym: "x \ y \ y \ x \ x = y" begin lemma less_le: "x < y \ x \ y \ x \ y" - by (auto simp add: less_le_not_le intro: antisym) + by (auto simp add: less_le_not_le intro: order_antisym) sublocale order: ordering less_eq less + dual_order: ordering greater_eq greater proof - interpret ordering less_eq less - by standard (auto intro: antisym order_trans simp add: less_le) + by standard (auto intro: order_antisym order_trans simp add: less_le) show "ordering less_eq less" by (fact ordering_axioms) then show "ordering greater_eq greater" by (rule ordering_dualI) qed +print_theorems + text \Reflexivity.\ lemma le_less: "x \ y \ x < y \ x = y" \ \NOT suitable for iff, since it can cause PROOF FAILED.\ by (fact order.order_iff_strict) lemma le_imp_less_or_eq: "x \ y \ x < y \ x = y" by (simp add: less_le) text \Useful for simplification, but too risky to include by default.\ lemma less_imp_not_eq: "x < y \ (x = y) \ False" by auto lemma less_imp_not_eq2: "x < y \ (y = x) \ False" by auto text \Transitivity rules for calculational reasoning\ lemma neq_le_trans: "a \ b \ a \ b \ a < b" by (fact order.not_eq_order_implies_strict) lemma le_neq_trans: "a \ b \ a \ b \ a < b" by (rule order.not_eq_order_implies_strict) text \Asymmetry.\ -lemma eq_iff: "x = y \ x \ y \ y \ x" +lemma order_eq_iff: "x = y \ x \ y \ y \ x" by (fact order.eq_iff) lemma antisym_conv: "y \ x \ x \ y \ x = y" - by (simp add: eq_iff) + by (simp add: order.eq_iff) lemma less_imp_neq: "x < y \ x \ y" by (fact order.strict_implies_not_eq) lemma antisym_conv1: "\ x < y \ x \ y \ x = y" by (simp add: local.le_less) lemma antisym_conv2: "x \ y \ \ x < y \ x = y" by (simp add: local.less_le) lemma leD: "y \ x \ \ x < y" - by (auto simp: less_le antisym) + by (auto simp: less_le order.antisym) text \Least value operator\ definition (in ord) Least :: "('a \ bool) \ 'a" (binder "LEAST " 10) where "Least P = (THE x. P x \ (\y. P y \ x \ y))" lemma Least_equality: assumes "P x" and "\y. P y \ x \ y" shows "Least P = x" unfolding Least_def by (rule the_equality) - (blast intro: assms antisym)+ + (blast intro: assms order.antisym)+ lemma LeastI2_order: assumes "P x" and "\y. P y \ x \ y" and "\x. P x \ \y. P y \ x \ y \ Q x" shows "Q (Least P)" unfolding Least_def by (rule theI2) - (blast intro: assms antisym)+ + (blast intro: assms order.antisym)+ lemma Least_ex1: assumes "\!x. P x \ (\y. P y \ x \ y)" shows Least1I: "P (Least P)" and Least1_le: "P z \ Least P \ z" using theI'[OF assms] unfolding Least_def by auto text \Greatest value operator\ definition Greatest :: "('a \ bool) \ 'a" (binder "GREATEST " 10) where "Greatest P = (THE x. P x \ (\y. P y \ x \ y))" lemma GreatestI2_order: "\ P x; \y. P y \ x \ y; \x. \ P x; \y. P y \ x \ y \ \ Q x \ \ Q (Greatest P)" unfolding Greatest_def -by (rule theI2) (blast intro: antisym)+ +by (rule theI2) (blast intro: order.antisym)+ lemma Greatest_equality: "\ P x; \y. P y \ x \ y \ \ Greatest P = x" unfolding Greatest_def -by (rule the_equality) (blast intro: antisym)+ +by (rule the_equality) (blast intro: order.antisym)+ end lemma ordering_orderI: fixes less_eq (infix "\<^bold>\" 50) and less (infix "\<^bold><" 50) assumes "ordering less_eq less" shows "class.order less_eq less" proof - from assms interpret ordering less_eq less . show ?thesis by standard (auto intro: antisym trans simp add: refl strict_iff_order) qed lemma order_strictI: fixes less (infix "\" 50) and less_eq (infix "\" 50) assumes "\a b. a \ b \ a \ b \ a = b" assumes "\a b. a \ b \ \ b \ a" assumes "\a. \ a \ a" assumes "\a b c. a \ b \ b \ c \ a \ c" shows "class.order less_eq less" by (rule ordering_orderI) (rule ordering_strictI, (fact assms)+) context order begin text \Dual order\ lemma dual_order: "class.order (\) (>)" using dual_order.ordering_axioms by (rule ordering_orderI) end subsection \Linear (total) orders\ class linorder = order + assumes linear: "x \ y \ y \ x" begin lemma less_linear: "x < y \ x = y \ y < x" unfolding less_le using less_le linear by blast lemma le_less_linear: "x \ y \ y < x" by (simp add: le_less less_linear) lemma le_cases [case_names le ge]: "(x \ y \ P) \ (y \ x \ P) \ P" using linear by blast lemma (in linorder) le_cases3: "\\x \ y; y \ z\ \ P; \y \ x; x \ z\ \ P; \x \ z; z \ y\ \ P; \z \ y; y \ x\ \ P; \y \ z; z \ x\ \ P; \z \ x; x \ y\ \ P\ \ P" by (blast intro: le_cases) lemma linorder_cases [case_names less equal greater]: "(x < y \ P) \ (x = y \ P) \ (y < x \ P) \ P" using less_linear by blast lemma linorder_wlog[case_names le sym]: "(\a b. a \ b \ P a b) \ (\a b. P b a \ P a b) \ P a b" by (cases rule: le_cases[of a b]) blast+ lemma not_less: "\ x < y \ y \ x" unfolding less_le - using linear by (blast intro: antisym) + using linear by (blast intro: order.antisym) lemma not_less_iff_gr_or_eq: "\(x < y) \ (x > y \ x = y)" by (auto simp add:not_less le_less) lemma not_le: "\ x \ y \ y < x" unfolding less_le - using linear by (blast intro: antisym) + using linear by (blast intro: order.antisym) lemma neq_iff: "x \ y \ x < y \ y < x" by (cut_tac x = x and y = y in less_linear, auto) lemma neqE: "x \ y \ (x < y \ R) \ (y < x \ R) \ R" by (simp add: neq_iff) blast lemma antisym_conv3: "\ y < x \ \ x < y \ x = y" -by (blast intro: antisym dest: not_less [THEN iffD1]) +by (blast intro: order.antisym dest: not_less [THEN iffD1]) lemma leI: "\ x < y \ y \ x" unfolding not_less . lemma not_le_imp_less: "\ y \ x \ x < y" unfolding not_le . lemma linorder_less_wlog[case_names less refl sym]: "\\a b. a < b \ P a b; \a. P a a; \a b. P b a \ P a b\ \ P a b" using antisym_conv3 by blast text \Dual order\ lemma dual_linorder: "class.linorder (\) (>)" by (rule class.linorder.intro, rule dual_order) (unfold_locales, rule linear) end text \Alternative introduction rule with bias towards strict order\ lemma linorder_strictI: fixes less_eq (infix "\<^bold>\" 50) and less (infix "\<^bold><" 50) assumes "class.order less_eq less" assumes trichotomy: "\a b. a \<^bold>< b \ a = b \ b \<^bold>< a" shows "class.linorder less_eq less" proof - interpret order less_eq less by (fact \class.order less_eq less\) show ?thesis proof fix a b show "a \<^bold>\ b \ b \<^bold>\ a" using trichotomy by (auto simp add: le_less) qed qed subsection \Reasoning tools setup\ ML \ signature ORDERS = sig val print_structures: Proof.context -> unit val order_tac: Proof.context -> thm list -> int -> tactic val add_struct: string * term list -> string -> attribute val del_struct: string * term list -> attribute end; structure Orders: ORDERS = struct (* context data *) fun struct_eq ((s1: string, ts1), (s2, ts2)) = s1 = s2 andalso eq_list (op aconv) (ts1, ts2); structure Data = Generic_Data ( type T = ((string * term list) * Order_Tac.less_arith) list; (* Order structures: identifier of the structure, list of operations and record of theorems needed to set up the transitivity reasoner, identifier and operations identify the structure uniquely. *) val empty = []; val extend = I; fun merge data = AList.join struct_eq (K fst) data; ); fun print_structures ctxt = let val structs = Data.get (Context.Proof ctxt); fun pretty_term t = Pretty.block [Pretty.quote (Syntax.pretty_term ctxt t), Pretty.brk 1, Pretty.str "::", Pretty.brk 1, Pretty.quote (Syntax.pretty_typ ctxt (type_of t))]; fun pretty_struct ((s, ts), _) = Pretty.block [Pretty.str s, Pretty.str ":", Pretty.brk 1, Pretty.enclose "(" ")" (Pretty.breaks (map pretty_term ts))]; in Pretty.writeln (Pretty.big_list "order structures:" (map pretty_struct structs)) end; val _ = Outer_Syntax.command \<^command_keyword>\print_orders\ "print order structures available to transitivity reasoner" (Scan.succeed (Toplevel.keep (print_structures o Toplevel.context_of))); (* tactics *) fun struct_tac ((s, ops), thms) ctxt facts = let val [eq, le, less] = ops; fun decomp thy (\<^const>\Trueprop\ $ t) = let fun excluded t = (* exclude numeric types: linear arithmetic subsumes transitivity *) let val T = type_of t in T = HOLogic.natT orelse T = HOLogic.intT orelse T = HOLogic.realT end; fun rel (bin_op $ t1 $ t2) = if excluded t1 then NONE else if Pattern.matches thy (eq, bin_op) then SOME (t1, "=", t2) else if Pattern.matches thy (le, bin_op) then SOME (t1, "<=", t2) else if Pattern.matches thy (less, bin_op) then SOME (t1, "<", t2) else NONE | rel _ = NONE; fun dec (Const (\<^const_name>\Not\, _) $ t) = (case rel t of NONE => NONE | SOME (t1, rel, t2) => SOME (t1, "~" ^ rel, t2)) | dec x = rel x; in dec t end | decomp _ _ = NONE; in (case s of "order" => Order_Tac.partial_tac decomp thms ctxt facts | "linorder" => Order_Tac.linear_tac decomp thms ctxt facts | _ => error ("Unknown order kind " ^ quote s ^ " encountered in transitivity reasoner")) end fun order_tac ctxt facts = FIRST' (map (fn s => CHANGED o struct_tac s ctxt facts) (Data.get (Context.Proof ctxt))); (* attributes *) fun add_struct s tag = Thm.declaration_attribute (fn thm => Data.map (AList.map_default struct_eq (s, Order_Tac.empty TrueI) (Order_Tac.update tag thm))); fun del_struct s = Thm.declaration_attribute (fn _ => Data.map (AList.delete struct_eq s)); end; \ attribute_setup order = \ Scan.lift ((Args.add -- Args.name >> (fn (_, s) => SOME s) || Args.del >> K NONE) --| Args.colon (* FIXME || Scan.succeed true *) ) -- Scan.lift Args.name -- Scan.repeat Args.term >> (fn ((SOME tag, n), ts) => Orders.add_struct (n, ts) tag | ((NONE, n), ts) => Orders.del_struct (n, ts)) \ "theorems controlling transitivity reasoner" method_setup order = \ Scan.succeed (fn ctxt => SIMPLE_METHOD' (Orders.order_tac ctxt [])) \ "transitivity reasoner" text \Declarations to set up transitivity reasoner of partial and linear orders.\ context order begin (* The type constraint on @{term (=}) below is necessary since the operation is not a parameter of the locale. *) declare less_irrefl [THEN notE, order add less_reflE: order "(=) :: 'a \ 'a \ bool" "(<=)" "(<)"] declare order_refl [order add le_refl: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_imp_le [order add less_imp_le: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] -declare antisym [order add eqI: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] +declare order.antisym [order add eqI: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare eq_refl [order add eqD1: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare sym [THEN eq_refl, order add eqD2: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_trans [order add less_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_le_trans [order add less_le_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare le_less_trans [order add le_less_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare order_trans [order add le_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare le_neq_trans [order add le_neq_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare neq_le_trans [order add neq_le_trans: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_imp_neq [order add less_imp_neq: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare eq_neq_eq_imp_neq [order add eq_neq_eq_imp_neq: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_sym [order add not_sym: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"] end context linorder begin declare [[order del: order "(=) :: 'a => 'a => bool" "(<=)" "(<)"]] declare less_irrefl [THEN notE, order add less_reflE: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare order_refl [order add le_refl: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_imp_le [order add less_imp_le: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_less [THEN iffD2, order add not_lessI: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_le [THEN iffD2, order add not_leI: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_less [THEN iffD1, order add not_lessD: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_le [THEN iffD1, order add not_leD: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] -declare antisym [order add eqI: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] +declare order.antisym [order add eqI: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare eq_refl [order add eqD1: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare sym [THEN eq_refl, order add eqD2: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_trans [order add less_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_le_trans [order add less_le_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare le_less_trans [order add le_less_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare order_trans [order add le_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare le_neq_trans [order add le_neq_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare neq_le_trans [order add neq_le_trans: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare less_imp_neq [order add less_imp_neq: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare eq_neq_eq_imp_neq [order add eq_neq_eq_imp_neq: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] declare not_sym [order add not_sym: linorder "(=) :: 'a => 'a => bool" "(<=)" "(<)"] end setup \ map_theory_simpset (fn ctxt0 => ctxt0 addSolver mk_solver "Transitivity" (fn ctxt => Orders.order_tac ctxt (Simplifier.prems_of ctxt))) (*Adding the transitivity reasoners also as safe solvers showed a slight speed up, but the reasoning strength appears to be not higher (at least no breaking of additional proofs in the entire HOL distribution, as of 5 March 2004, was observed).*) \ ML \ local fun prp t thm = Thm.prop_of thm = t; (* FIXME proper aconv!? *) in fun antisym_le_simproc ctxt ct = (case Thm.term_of ct of (le as Const (_, T)) $ r $ s => (let val prems = Simplifier.prems_of ctxt; val less = Const (\<^const_name>\less\, T); val t = HOLogic.mk_Trueprop(le $ s $ r); in (case find_first (prp t) prems of NONE => let val t = HOLogic.mk_Trueprop(HOLogic.Not $ (less $ r $ s)) in (case find_first (prp t) prems of NONE => NONE | SOME thm => SOME(mk_meta_eq(thm RS @{thm antisym_conv1}))) end | SOME thm => SOME (mk_meta_eq (thm RS @{thm order_class.antisym_conv}))) end handle THM _ => NONE) | _ => NONE); fun antisym_less_simproc ctxt ct = (case Thm.term_of ct of NotC $ ((less as Const(_,T)) $ r $ s) => (let val prems = Simplifier.prems_of ctxt; val le = Const (\<^const_name>\less_eq\, T); val t = HOLogic.mk_Trueprop(le $ r $ s); in (case find_first (prp t) prems of NONE => let val t = HOLogic.mk_Trueprop (NotC $ (less $ s $ r)) in (case find_first (prp t) prems of NONE => NONE | SOME thm => SOME (mk_meta_eq(thm RS @{thm linorder_class.antisym_conv3}))) end | SOME thm => SOME (mk_meta_eq (thm RS @{thm antisym_conv2}))) end handle THM _ => NONE) | _ => NONE); end; \ simproc_setup antisym_le ("(x::'a::order) \ y") = "K antisym_le_simproc" simproc_setup antisym_less ("\ (x::'a::linorder) < y") = "K antisym_less_simproc" subsection \Bounded quantifiers\ syntax (ASCII) "_All_less" :: "[idt, 'a, bool] => bool" ("(3ALL _<_./ _)" [0, 0, 10] 10) "_Ex_less" :: "[idt, 'a, bool] => bool" ("(3EX _<_./ _)" [0, 0, 10] 10) "_All_less_eq" :: "[idt, 'a, bool] => bool" ("(3ALL _<=_./ _)" [0, 0, 10] 10) "_Ex_less_eq" :: "[idt, 'a, bool] => bool" ("(3EX _<=_./ _)" [0, 0, 10] 10) "_All_greater" :: "[idt, 'a, bool] => bool" ("(3ALL _>_./ _)" [0, 0, 10] 10) "_Ex_greater" :: "[idt, 'a, bool] => bool" ("(3EX _>_./ _)" [0, 0, 10] 10) "_All_greater_eq" :: "[idt, 'a, bool] => bool" ("(3ALL _>=_./ _)" [0, 0, 10] 10) "_Ex_greater_eq" :: "[idt, 'a, bool] => bool" ("(3EX _>=_./ _)" [0, 0, 10] 10) "_All_neq" :: "[idt, 'a, bool] => bool" ("(3ALL _~=_./ _)" [0, 0, 10] 10) "_Ex_neq" :: "[idt, 'a, bool] => bool" ("(3EX _~=_./ _)" [0, 0, 10] 10) syntax "_All_less" :: "[idt, 'a, bool] => bool" ("(3\_<_./ _)" [0, 0, 10] 10) "_Ex_less" :: "[idt, 'a, bool] => bool" ("(3\_<_./ _)" [0, 0, 10] 10) "_All_less_eq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) "_Ex_less_eq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) "_All_greater" :: "[idt, 'a, bool] => bool" ("(3\_>_./ _)" [0, 0, 10] 10) "_Ex_greater" :: "[idt, 'a, bool] => bool" ("(3\_>_./ _)" [0, 0, 10] 10) "_All_greater_eq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) "_Ex_greater_eq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) "_All_neq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) "_Ex_neq" :: "[idt, 'a, bool] => bool" ("(3\_\_./ _)" [0, 0, 10] 10) syntax (input) "_All_less" :: "[idt, 'a, bool] => bool" ("(3! _<_./ _)" [0, 0, 10] 10) "_Ex_less" :: "[idt, 'a, bool] => bool" ("(3? _<_./ _)" [0, 0, 10] 10) "_All_less_eq" :: "[idt, 'a, bool] => bool" ("(3! _<=_./ _)" [0, 0, 10] 10) "_Ex_less_eq" :: "[idt, 'a, bool] => bool" ("(3? _<=_./ _)" [0, 0, 10] 10) "_All_neq" :: "[idt, 'a, bool] => bool" ("(3! _~=_./ _)" [0, 0, 10] 10) "_Ex_neq" :: "[idt, 'a, bool] => bool" ("(3? _~=_./ _)" [0, 0, 10] 10) translations "\x "\x. x < y \ P" "\x "\x. x < y \ P" "\x\y. P" \ "\x. x \ y \ P" "\x\y. P" \ "\x. x \ y \ P" "\x>y. P" \ "\x. x > y \ P" "\x>y. P" \ "\x. x > y \ P" "\x\y. P" \ "\x. x \ y \ P" "\x\y. P" \ "\x. x \ y \ P" "\x\y. P" \ "\x. x \ y \ P" "\x\y. P" \ "\x. x \ y \ P" print_translation \ let val All_binder = Mixfix.binder_name \<^const_syntax>\All\; val Ex_binder = Mixfix.binder_name \<^const_syntax>\Ex\; val impl = \<^const_syntax>\HOL.implies\; val conj = \<^const_syntax>\HOL.conj\; val less = \<^const_syntax>\less\; val less_eq = \<^const_syntax>\less_eq\; val trans = [((All_binder, impl, less), (\<^syntax_const>\_All_less\, \<^syntax_const>\_All_greater\)), ((All_binder, impl, less_eq), (\<^syntax_const>\_All_less_eq\, \<^syntax_const>\_All_greater_eq\)), ((Ex_binder, conj, less), (\<^syntax_const>\_Ex_less\, \<^syntax_const>\_Ex_greater\)), ((Ex_binder, conj, less_eq), (\<^syntax_const>\_Ex_less_eq\, \<^syntax_const>\_Ex_greater_eq\))]; fun matches_bound v t = (case t of Const (\<^syntax_const>\_bound\, _) $ Free (v', _) => v = v' | _ => false); fun contains_var v = Term.exists_subterm (fn Free (x, _) => x = v | _ => false); fun mk x c n P = Syntax.const c $ Syntax_Trans.mark_bound_body x $ n $ P; fun tr' q = (q, fn _ => (fn [Const (\<^syntax_const>\_bound\, _) $ Free (v, T), Const (c, _) $ (Const (d, _) $ t $ u) $ P] => (case AList.lookup (=) trans (q, c, d) of NONE => raise Match | SOME (l, g) => if matches_bound v t andalso not (contains_var v u) then mk (v, T) l u P else if matches_bound v u andalso not (contains_var v t) then mk (v, T) g t P else raise Match) | _ => raise Match)); in [tr' All_binder, tr' Ex_binder] end \ subsection \Transitivity reasoning\ context ord begin lemma ord_le_eq_trans: "a \ b \ b = c \ a \ c" by (rule subst) lemma ord_eq_le_trans: "a = b \ b \ c \ a \ c" by (rule ssubst) lemma ord_less_eq_trans: "a < b \ b = c \ a < c" by (rule subst) lemma ord_eq_less_trans: "a = b \ b < c \ a < c" by (rule ssubst) end lemma order_less_subst2: "(a::'a::order) < b ==> f b < (c::'c::order) ==> (!!x y. x < y ==> f x < f y) ==> f a < c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a < b" hence "f a < f b" by (rule r) also assume "f b < c" finally (less_trans) show ?thesis . qed lemma order_less_subst1: "(a::'a::order) < f b ==> (b::'b::order) < c ==> (!!x y. x < y ==> f x < f y) ==> a < f c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a < f b" also assume "b < c" hence "f b < f c" by (rule r) finally (less_trans) show ?thesis . qed lemma order_le_less_subst2: "(a::'a::order) <= b ==> f b < (c::'c::order) ==> (!!x y. x <= y ==> f x <= f y) ==> f a < c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a <= b" hence "f a <= f b" by (rule r) also assume "f b < c" finally (le_less_trans) show ?thesis . qed lemma order_le_less_subst1: "(a::'a::order) <= f b ==> (b::'b::order) < c ==> (!!x y. x < y ==> f x < f y) ==> a < f c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a <= f b" also assume "b < c" hence "f b < f c" by (rule r) finally (le_less_trans) show ?thesis . qed lemma order_less_le_subst2: "(a::'a::order) < b ==> f b <= (c::'c::order) ==> (!!x y. x < y ==> f x < f y) ==> f a < c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a < b" hence "f a < f b" by (rule r) also assume "f b <= c" finally (less_le_trans) show ?thesis . qed lemma order_less_le_subst1: "(a::'a::order) < f b ==> (b::'b::order) <= c ==> (!!x y. x <= y ==> f x <= f y) ==> a < f c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a < f b" also assume "b <= c" hence "f b <= f c" by (rule r) finally (less_le_trans) show ?thesis . qed lemma order_subst1: "(a::'a::order) <= f b ==> (b::'b::order) <= c ==> (!!x y. x <= y ==> f x <= f y) ==> a <= f c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a <= f b" also assume "b <= c" hence "f b <= f c" by (rule r) finally (order_trans) show ?thesis . qed lemma order_subst2: "(a::'a::order) <= b ==> f b <= (c::'c::order) ==> (!!x y. x <= y ==> f x <= f y) ==> f a <= c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a <= b" hence "f a <= f b" by (rule r) also assume "f b <= c" finally (order_trans) show ?thesis . qed lemma ord_le_eq_subst: "a <= b ==> f b = c ==> (!!x y. x <= y ==> f x <= f y) ==> f a <= c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a <= b" hence "f a <= f b" by (rule r) also assume "f b = c" finally (ord_le_eq_trans) show ?thesis . qed lemma ord_eq_le_subst: "a = f b ==> b <= c ==> (!!x y. x <= y ==> f x <= f y) ==> a <= f c" proof - assume r: "!!x y. x <= y ==> f x <= f y" assume "a = f b" also assume "b <= c" hence "f b <= f c" by (rule r) finally (ord_eq_le_trans) show ?thesis . qed lemma ord_less_eq_subst: "a < b ==> f b = c ==> (!!x y. x < y ==> f x < f y) ==> f a < c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a < b" hence "f a < f b" by (rule r) also assume "f b = c" finally (ord_less_eq_trans) show ?thesis . qed lemma ord_eq_less_subst: "a = f b ==> b < c ==> (!!x y. x < y ==> f x < f y) ==> a < f c" proof - assume r: "!!x y. x < y ==> f x < f y" assume "a = f b" also assume "b < c" hence "f b < f c" by (rule r) finally (ord_eq_less_trans) show ?thesis . qed text \ Note that this list of rules is in reverse order of priorities. \ lemmas [trans] = order_less_subst2 order_less_subst1 order_le_less_subst2 order_le_less_subst1 order_less_le_subst2 order_less_le_subst1 order_subst2 order_subst1 ord_le_eq_subst ord_eq_le_subst ord_less_eq_subst ord_eq_less_subst forw_subst back_subst rev_mp mp lemmas (in order) [trans] = neq_le_trans le_neq_trans lemmas (in preorder) [trans] = less_trans less_asym' le_less_trans less_le_trans order_trans lemmas (in order) [trans] = - antisym + order.antisym lemmas (in ord) [trans] = ord_le_eq_trans ord_eq_le_trans ord_less_eq_trans ord_eq_less_trans lemmas [trans] = trans lemmas order_trans_rules = order_less_subst2 order_less_subst1 order_le_less_subst2 order_le_less_subst1 order_less_le_subst2 order_less_le_subst1 order_subst2 order_subst1 ord_le_eq_subst ord_eq_le_subst ord_less_eq_subst ord_eq_less_subst forw_subst back_subst rev_mp mp neq_le_trans le_neq_trans less_trans less_asym' le_less_trans less_le_trans order_trans - antisym + order.antisym ord_le_eq_trans ord_eq_le_trans ord_less_eq_trans ord_eq_less_trans trans text \These support proving chains of decreasing inequalities a >= b >= c ... in Isar proofs.\ lemma xt1 [no_atp]: "a = b \ b > c \ a > c" "a > b \ b = c \ a > c" "a = b \ b \ c \ a \ c" "a \ b \ b = c \ a \ c" "(x::'a::order) \ y \ y \ x \ x = y" "(x::'a::order) \ y \ y \ z \ x \ z" "(x::'a::order) > y \ y \ z \ x > z" "(x::'a::order) \ y \ y > z \ x > z" "(a::'a::order) > b \ b > a \ P" "(x::'a::order) > y \ y > z \ x > z" "(a::'a::order) \ b \ a \ b \ a > b" "(a::'a::order) \ b \ a \ b \ a > b" "a = f b \ b > c \ (\x y. x > y \ f x > f y) \ a > f c" "a > b \ f b = c \ (\x y. x > y \ f x > f y) \ f a > c" "a = f b \ b \ c \ (\x y. x \ y \ f x \ f y) \ a \ f c" "a \ b \ f b = c \ (\x y. x \ y \ f x \ f y) \ f a \ c" by auto lemma xt2 [no_atp]: "(a::'a::order) >= f b ==> b >= c ==> (!!x y. x >= y ==> f x >= f y) ==> a >= f c" by (subgoal_tac "f b >= f c", force, force) lemma xt3 [no_atp]: "(a::'a::order) >= b ==> (f b::'b::order) >= c ==> (!!x y. x >= y ==> f x >= f y) ==> f a >= c" by (subgoal_tac "f a >= f b", force, force) lemma xt4 [no_atp]: "(a::'a::order) > f b ==> (b::'b::order) >= c ==> (!!x y. x >= y ==> f x >= f y) ==> a > f c" by (subgoal_tac "f b >= f c", force, force) lemma xt5 [no_atp]: "(a::'a::order) > b ==> (f b::'b::order) >= c==> (!!x y. x > y ==> f x > f y) ==> f a > c" by (subgoal_tac "f a > f b", force, force) lemma xt6 [no_atp]: "(a::'a::order) >= f b ==> b > c ==> (!!x y. x > y ==> f x > f y) ==> a > f c" by (subgoal_tac "f b > f c", force, force) lemma xt7 [no_atp]: "(a::'a::order) >= b ==> (f b::'b::order) > c ==> (!!x y. x >= y ==> f x >= f y) ==> f a > c" by (subgoal_tac "f a >= f b", force, force) lemma xt8 [no_atp]: "(a::'a::order) > f b ==> (b::'b::order) > c ==> (!!x y. x > y ==> f x > f y) ==> a > f c" by (subgoal_tac "f b > f c", force, force) lemma xt9 [no_atp]: "(a::'a::order) > b ==> (f b::'b::order) > c ==> (!!x y. x > y ==> f x > f y) ==> f a > c" by (subgoal_tac "f a > f b", force, force) lemmas xtrans = xt1 xt2 xt3 xt4 xt5 xt6 xt7 xt8 xt9 (* Since "a >= b" abbreviates "b <= a", the abbreviation "..." stands for the wrong thing in an Isar proof. The extra transitivity rules can be used as follows: lemma "(a::'a::order) > z" proof - have "a >= b" (is "_ >= ?rhs") sorry also have "?rhs >= c" (is "_ >= ?rhs") sorry also (xtrans) have "?rhs = d" (is "_ = ?rhs") sorry also (xtrans) have "?rhs >= e" (is "_ >= ?rhs") sorry also (xtrans) have "?rhs > f" (is "_ > ?rhs") sorry also (xtrans) have "?rhs > z" sorry finally (xtrans) show ?thesis . qed Alternatively, one can use "declare xtrans [trans]" and then leave out the "(xtrans)" above. *) subsection \Monotonicity\ context order begin definition mono :: "('a \ 'b::order) \ bool" where "mono f \ (\x y. x \ y \ f x \ f y)" lemma monoI [intro?]: fixes f :: "'a \ 'b::order" shows "(\x y. x \ y \ f x \ f y) \ mono f" unfolding mono_def by iprover lemma monoD [dest?]: fixes f :: "'a \ 'b::order" shows "mono f \ x \ y \ f x \ f y" unfolding mono_def by iprover lemma monoE: fixes f :: "'a \ 'b::order" assumes "mono f" assumes "x \ y" obtains "f x \ f y" proof from assms show "f x \ f y" by (simp add: mono_def) qed definition antimono :: "('a \ 'b::order) \ bool" where "antimono f \ (\x y. x \ y \ f x \ f y)" lemma antimonoI [intro?]: fixes f :: "'a \ 'b::order" shows "(\x y. x \ y \ f x \ f y) \ antimono f" unfolding antimono_def by iprover lemma antimonoD [dest?]: fixes f :: "'a \ 'b::order" shows "antimono f \ x \ y \ f x \ f y" unfolding antimono_def by iprover lemma antimonoE: fixes f :: "'a \ 'b::order" assumes "antimono f" assumes "x \ y" obtains "f x \ f y" proof from assms show "f x \ f y" by (simp add: antimono_def) qed definition strict_mono :: "('a \ 'b::order) \ bool" where "strict_mono f \ (\x y. x < y \ f x < f y)" lemma strict_monoI [intro?]: assumes "\x y. x < y \ f x < f y" shows "strict_mono f" using assms unfolding strict_mono_def by auto lemma strict_monoD [dest?]: "strict_mono f \ x < y \ f x < f y" unfolding strict_mono_def by auto lemma strict_mono_mono [dest?]: assumes "strict_mono f" shows "mono f" proof (rule monoI) fix x y assume "x \ y" show "f x \ f y" proof (cases "x = y") case True then show ?thesis by simp next case False with \x \ y\ have "x < y" by simp with assms strict_monoD have "f x < f y" by auto then show ?thesis by simp qed qed end context linorder begin lemma mono_invE: fixes f :: "'a \ 'b::order" assumes "mono f" assumes "f x < f y" obtains "x \ y" proof show "x \ y" proof (rule ccontr) assume "\ x \ y" then have "y \ x" by simp with \mono f\ obtain "f y \ f x" by (rule monoE) with \f x < f y\ show False by simp qed qed lemma mono_strict_invE: fixes f :: "'a \ 'b::order" assumes "mono f" assumes "f x < f y" obtains "x < y" proof show "x < y" proof (rule ccontr) assume "\ x < y" then have "y \ x" by simp with \mono f\ obtain "f y \ f x" by (rule monoE) with \f x < f y\ show False by simp qed qed lemma strict_mono_eq: assumes "strict_mono f" shows "f x = f y \ x = y" proof assume "f x = f y" show "x = y" proof (cases x y rule: linorder_cases) case less with assms strict_monoD have "f x < f y" by auto with \f x = f y\ show ?thesis by simp next case equal then show ?thesis . next case greater with assms strict_monoD have "f y < f x" by auto with \f x = f y\ show ?thesis by simp qed qed simp lemma strict_mono_less_eq: assumes "strict_mono f" shows "f x \ f y \ x \ y" proof assume "x \ y" with assms strict_mono_mono monoD show "f x \ f y" by auto next assume "f x \ f y" show "x \ y" proof (rule ccontr) assume "\ x \ y" then have "y < x" by simp with assms strict_monoD have "f y < f x" by auto with \f x \ f y\ show False by simp qed qed lemma strict_mono_less: assumes "strict_mono f" shows "f x < f y \ x < y" using assms by (auto simp add: less_le Orderings.less_le strict_mono_eq strict_mono_less_eq) end subsection \min and max -- fundamental\ definition (in ord) min :: "'a \ 'a \ 'a" where "min a b = (if a \ b then a else b)" definition (in ord) max :: "'a \ 'a \ 'a" where "max a b = (if a \ b then b else a)" lemma min_absorb1: "x \ y \ min x y = x" by (simp add: min_def) lemma max_absorb2: "x \ y \ max x y = y" by (simp add: max_def) lemma min_absorb2: "(y::'a::order) \ x \ min x y = y" by (simp add:min_def) lemma max_absorb1: "(y::'a::order) \ x \ max x y = x" by (simp add: max_def) lemma max_min_same [simp]: fixes x y :: "'a :: linorder" shows "max x (min x y) = x" "max (min x y) x = x" "max (min x y) y = y" "max y (min x y) = y" by(auto simp add: max_def min_def) subsection \(Unique) top and bottom elements\ class bot = fixes bot :: 'a ("\") class order_bot = order + bot + assumes bot_least: "\ \ a" begin sublocale bot: ordering_top greater_eq greater bot by standard (fact bot_least) lemma le_bot: "a \ \ \ a = \" by (fact bot.extremum_uniqueI) lemma bot_unique: "a \ \ \ a = \" by (fact bot.extremum_unique) lemma not_less_bot: "\ a < \" by (fact bot.extremum_strict) lemma bot_less: "a \ \ \ \ < a" by (fact bot.not_eq_extremum) lemma max_bot[simp]: "max bot x = x" by(simp add: max_def bot_unique) lemma max_bot2[simp]: "max x bot = x" by(simp add: max_def bot_unique) lemma min_bot[simp]: "min bot x = bot" by(simp add: min_def bot_unique) lemma min_bot2[simp]: "min x bot = bot" by(simp add: min_def bot_unique) end class top = fixes top :: 'a ("\") class order_top = order + top + assumes top_greatest: "a \ \" begin sublocale top: ordering_top less_eq less top by standard (fact top_greatest) lemma top_le: "\ \ a \ a = \" by (fact top.extremum_uniqueI) lemma top_unique: "\ \ a \ a = \" by (fact top.extremum_unique) lemma not_top_less: "\ \ < a" by (fact top.extremum_strict) lemma less_top: "a \ \ \ a < \" by (fact top.not_eq_extremum) lemma max_top[simp]: "max top x = top" by(simp add: max_def top_unique) lemma max_top2[simp]: "max x top = top" by(simp add: max_def top_unique) lemma min_top[simp]: "min top x = x" by(simp add: min_def top_unique) lemma min_top2[simp]: "min x top = x" by(simp add: min_def top_unique) end subsection \Dense orders\ class dense_order = order + assumes dense: "x < y \ (\z. x < z \ z < y)" class dense_linorder = linorder + dense_order begin lemma dense_le: fixes y z :: 'a assumes "\x. x < y \ x \ z" shows "y \ z" proof (rule ccontr) assume "\ ?thesis" hence "z < y" by simp from dense[OF this] obtain x where "x < y" and "z < x" by safe moreover have "x \ z" using assms[OF \x < y\] . ultimately show False by auto qed lemma dense_le_bounded: fixes x y z :: 'a assumes "x < y" assumes *: "\w. \ x < w ; w < y \ \ w \ z" shows "y \ z" proof (rule dense_le) fix w assume "w < y" from dense[OF \x < y\] obtain u where "x < u" "u < y" by safe from linear[of u w] show "w \ z" proof (rule disjE) assume "u \ w" from less_le_trans[OF \x < u\ \u \ w\] \w < y\ show "w \ z" by (rule *) next assume "w \ u" from \w \ u\ *[OF \x < u\ \u < y\] show "w \ z" by (rule order_trans) qed qed lemma dense_ge: fixes y z :: 'a assumes "\x. z < x \ y \ x" shows "y \ z" proof (rule ccontr) assume "\ ?thesis" hence "z < y" by simp from dense[OF this] obtain x where "x < y" and "z < x" by safe moreover have "y \ x" using assms[OF \z < x\] . ultimately show False by auto qed lemma dense_ge_bounded: fixes x y z :: 'a assumes "z < x" assumes *: "\w. \ z < w ; w < x \ \ y \ w" shows "y \ z" proof (rule dense_ge) fix w assume "z < w" from dense[OF \z < x\] obtain u where "z < u" "u < x" by safe from linear[of u w] show "y \ w" proof (rule disjE) assume "w \ u" from \z < w\ le_less_trans[OF \w \ u\ \u < x\] show "y \ w" by (rule *) next assume "u \ w" from *[OF \z < u\ \u < x\] \u \ w\ show "y \ w" by (rule order_trans) qed qed end class no_top = order + assumes gt_ex: "\y. x < y" class no_bot = order + assumes lt_ex: "\y. y < x" class unbounded_dense_linorder = dense_linorder + no_top + no_bot subsection \Wellorders\ class wellorder = linorder + assumes less_induct [case_names less]: "(\x. (\y. y < x \ P y) \ P x) \ P a" begin lemma wellorder_Least_lemma: fixes k :: 'a assumes "P k" shows LeastI: "P (LEAST x. P x)" and Least_le: "(LEAST x. P x) \ k" proof - have "P (LEAST x. P x) \ (LEAST x. P x) \ k" using assms proof (induct k rule: less_induct) case (less x) then have "P x" by simp show ?case proof (rule classical) assume assm: "\ (P (LEAST a. P a) \ (LEAST a. P a) \ x)" have "\y. P y \ x \ y" proof (rule classical) fix y assume "P y" and "\ x \ y" with less have "P (LEAST a. P a)" and "(LEAST a. P a) \ y" by (auto simp add: not_le) with assm have "x < (LEAST a. P a)" and "(LEAST a. P a) \ y" by auto then show "x \ y" by auto qed with \P x\ have Least: "(LEAST a. P a) = x" by (rule Least_equality) with \P x\ show ?thesis by simp qed qed then show "P (LEAST x. P x)" and "(LEAST x. P x) \ k" by auto qed \ \The following 3 lemmas are due to Brian Huffman\ lemma LeastI_ex: "\x. P x \ P (Least P)" by (erule exE) (erule LeastI) lemma LeastI2: "P a \ (\x. P x \ Q x) \ Q (Least P)" by (blast intro: LeastI) lemma LeastI2_ex: "\a. P a \ (\x. P x \ Q x) \ Q (Least P)" by (blast intro: LeastI_ex) lemma LeastI2_wellorder: assumes "P a" and "\a. \ P a; \b. P b \ a \ b \ \ Q a" shows "Q (Least P)" proof (rule LeastI2_order) show "P (Least P)" using \P a\ by (rule LeastI) next fix y assume "P y" thus "Least P \ y" by (rule Least_le) next fix x assume "P x" "\y. P y \ x \ y" thus "Q x" by (rule assms(2)) qed lemma LeastI2_wellorder_ex: assumes "\x. P x" and "\a. \ P a; \b. P b \ a \ b \ \ Q a" shows "Q (Least P)" using assms by clarify (blast intro!: LeastI2_wellorder) lemma not_less_Least: "k < (LEAST x. P x) \ \ P k" apply (simp add: not_le [symmetric]) apply (erule contrapos_nn) apply (erule Least_le) done lemma exists_least_iff: "(\n. P n) \ (\n. P n \ (\m < n. \ P m))" (is "?lhs \ ?rhs") proof assume ?rhs thus ?lhs by blast next assume H: ?lhs then obtain n where n: "P n" by blast let ?x = "Least P" { fix m assume m: "m < ?x" from not_less_Least[OF m] have "\ P m" . } with LeastI_ex[OF H] show ?rhs by blast qed end subsection \Order on \<^typ>\bool\\ instantiation bool :: "{order_bot, order_top, linorder}" begin definition le_bool_def [simp]: "P \ Q \ P \ Q" definition [simp]: "(P::bool) < Q \ \ P \ Q" definition [simp]: "\ \ False" definition [simp]: "\ \ True" instance proof qed auto end lemma le_boolI: "(P \ Q) \ P \ Q" by simp lemma le_boolI': "P \ Q \ P \ Q" by simp lemma le_boolE: "P \ Q \ P \ (Q \ R) \ R" by simp lemma le_boolD: "P \ Q \ P \ Q" by simp lemma bot_boolE: "\ \ P" by simp lemma top_boolI: \ by simp lemma [code]: "False \ b \ True" "True \ b \ b" "False < b \ b" "True < b \ False" by simp_all subsection \Order on \<^typ>\_ \ _\\ instantiation "fun" :: (type, ord) ord begin definition le_fun_def: "f \ g \ (\x. f x \ g x)" definition "(f::'a \ 'b) < g \ f \ g \ \ (g \ f)" instance .. end instance "fun" :: (type, preorder) preorder proof qed (auto simp add: le_fun_def less_fun_def - intro: order_trans antisym) + intro: order_trans order.antisym) instance "fun" :: (type, order) order proof -qed (auto simp add: le_fun_def intro: antisym) +qed (auto simp add: le_fun_def intro: order.antisym) instantiation "fun" :: (type, bot) bot begin definition "\ = (\x. \)" instance .. end instantiation "fun" :: (type, order_bot) order_bot begin lemma bot_apply [simp, code]: "\ x = \" by (simp add: bot_fun_def) instance proof qed (simp add: le_fun_def) end instantiation "fun" :: (type, top) top begin definition [no_atp]: "\ = (\x. \)" instance .. end instantiation "fun" :: (type, order_top) order_top begin lemma top_apply [simp, code]: "\ x = \" by (simp add: top_fun_def) instance proof qed (simp add: le_fun_def) end lemma le_funI: "(\x. f x \ g x) \ f \ g" unfolding le_fun_def by simp lemma le_funE: "f \ g \ (f x \ g x \ P) \ P" unfolding le_fun_def by simp lemma le_funD: "f \ g \ f x \ g x" by (rule le_funE) lemma mono_compose: "mono Q \ mono (\i x. Q i (f x))" unfolding mono_def le_fun_def by auto subsection \Order on unary and binary predicates\ lemma predicate1I: assumes PQ: "\x. P x \ Q x" shows "P \ Q" apply (rule le_funI) apply (rule le_boolI) apply (rule PQ) apply assumption done lemma predicate1D: "P \ Q \ P x \ Q x" apply (erule le_funE) apply (erule le_boolE) apply assumption+ done lemma rev_predicate1D: "P x \ P \ Q \ Q x" by (rule predicate1D) lemma predicate2I: assumes PQ: "\x y. P x y \ Q x y" shows "P \ Q" apply (rule le_funI)+ apply (rule le_boolI) apply (rule PQ) apply assumption done lemma predicate2D: "P \ Q \ P x y \ Q x y" apply (erule le_funE)+ apply (erule le_boolE) apply assumption+ done lemma rev_predicate2D: "P x y \ P \ Q \ Q x y" by (rule predicate2D) lemma bot1E [no_atp]: "\ x \ P" by (simp add: bot_fun_def) lemma bot2E: "\ x y \ P" by (simp add: bot_fun_def) lemma top1I: "\ x" by (simp add: top_fun_def) lemma top2I: "\ x y" by (simp add: top_fun_def) subsection \Name duplicates\ +lemmas antisym = order.antisym +lemmas eq_iff = order.eq_iff + lemmas order_eq_refl = preorder_class.eq_refl lemmas order_less_irrefl = preorder_class.less_irrefl lemmas order_less_imp_le = preorder_class.less_imp_le lemmas order_less_not_sym = preorder_class.less_not_sym lemmas order_less_asym = preorder_class.less_asym lemmas order_less_trans = preorder_class.less_trans lemmas order_le_less_trans = preorder_class.le_less_trans lemmas order_less_le_trans = preorder_class.less_le_trans lemmas order_less_imp_not_less = preorder_class.less_imp_not_less lemmas order_less_imp_triv = preorder_class.less_imp_triv lemmas order_less_asym' = preorder_class.less_asym' lemmas order_less_le = order_class.less_le lemmas order_le_less = order_class.le_less lemmas order_le_imp_less_or_eq = order_class.le_imp_less_or_eq lemmas order_less_imp_not_eq = order_class.less_imp_not_eq lemmas order_less_imp_not_eq2 = order_class.less_imp_not_eq2 lemmas order_neq_le_trans = order_class.neq_le_trans lemmas order_le_neq_trans = order_class.le_neq_trans -lemmas order_antisym = order_class.antisym -lemmas order_eq_iff = order_class.eq_iff +lemmas order_eq_iff = order_class.order.eq_iff lemmas order_antisym_conv = order_class.antisym_conv lemmas linorder_linear = linorder_class.linear lemmas linorder_less_linear = linorder_class.less_linear lemmas linorder_le_less_linear = linorder_class.le_less_linear lemmas linorder_le_cases = linorder_class.le_cases lemmas linorder_not_less = linorder_class.not_less lemmas linorder_not_le = linorder_class.not_le lemmas linorder_neq_iff = linorder_class.neq_iff lemmas linorder_neqE = linorder_class.neqE end diff --git a/src/HOL/Partial_Function.thy b/src/HOL/Partial_Function.thy --- a/src/HOL/Partial_Function.thy +++ b/src/HOL/Partial_Function.thy @@ -1,459 +1,459 @@ (* Title: HOL/Partial_Function.thy Author: Alexander Krauss, TU Muenchen *) section \Partial Function Definitions\ theory Partial_Function imports Complete_Partial_Order Option keywords "partial_function" :: thy_defn begin named_theorems partial_function_mono "monotonicity rules for partial function definitions" ML_file \Tools/Function/partial_function.ML\ lemma (in ccpo) in_chain_finite: assumes "Complete_Partial_Order.chain (\) A" "finite A" "A \ {}" shows "\A \ A" using assms(2,1,3) proof induction case empty thus ?case by simp next case (insert x A) note chain = \Complete_Partial_Order.chain (\) (insert x A)\ show ?case proof(cases "A = {}") case True thus ?thesis by simp next case False from chain have chain': "Complete_Partial_Order.chain (\) A" by(rule chain_subset) blast hence "\A \ A" using False by(rule insert.IH) show ?thesis proof(cases "x \ \A") case True have "\(insert x A) \ \A" using chain by(rule ccpo_Sup_least)(auto simp add: True intro: ccpo_Sup_upper[OF chain']) hence "\(insert x A) = \A" - by(rule antisym)(blast intro: ccpo_Sup_upper[OF chain] ccpo_Sup_least[OF chain']) + by(rule order.antisym)(blast intro: ccpo_Sup_upper[OF chain] ccpo_Sup_least[OF chain']) with \\A \ A\ show ?thesis by simp next case False with chainD[OF chain, of x "\A"] \\A \ A\ have "\(insert x A) = x" - by(auto intro: antisym ccpo_Sup_least[OF chain] order_trans[OF ccpo_Sup_upper[OF chain']] ccpo_Sup_upper[OF chain]) + by(auto intro: order.antisym ccpo_Sup_least[OF chain] order_trans[OF ccpo_Sup_upper[OF chain']] ccpo_Sup_upper[OF chain]) thus ?thesis by simp qed qed qed lemma (in ccpo) admissible_chfin: "(\S. Complete_Partial_Order.chain (\) S \ finite S) \ ccpo.admissible Sup (\) P" using in_chain_finite by (blast intro: ccpo.admissibleI) subsection \Axiomatic setup\ text \This techical locale constains the requirements for function definitions with ccpo fixed points.\ definition "fun_ord ord f g \ (\x. ord (f x) (g x))" definition "fun_lub L A = (\x. L {y. \f\A. y = f x})" definition "img_ord f ord = (\x y. ord (f x) (f y))" definition "img_lub f g Lub = (\A. g (Lub (f ` A)))" lemma chain_fun: assumes A: "chain (fun_ord ord) A" shows "chain ord {y. \f\A. y = f a}" (is "chain ord ?C") proof (rule chainI) fix x y assume "x \ ?C" "y \ ?C" then obtain f g where fg: "f \ A" "g \ A" and [simp]: "x = f a" "y = g a" by blast from chainD[OF A fg] show "ord x y \ ord y x" unfolding fun_ord_def by auto qed lemma call_mono[partial_function_mono]: "monotone (fun_ord ord) ord (\f. f t)" by (rule monotoneI) (auto simp: fun_ord_def) lemma let_mono[partial_function_mono]: "(\x. monotone orda ordb (\f. b f x)) \ monotone orda ordb (\f. Let t (b f))" by (simp add: Let_def) lemma if_mono[partial_function_mono]: "monotone orda ordb F \ monotone orda ordb G \ monotone orda ordb (\f. if c then F f else G f)" unfolding monotone_def by simp definition "mk_less R = (\x y. R x y \ \ R y x)" locale partial_function_definitions = fixes leq :: "'a \ 'a \ bool" fixes lub :: "'a set \ 'a" assumes leq_refl: "leq x x" assumes leq_trans: "leq x y \ leq y z \ leq x z" assumes leq_antisym: "leq x y \ leq y x \ x = y" assumes lub_upper: "chain leq A \ x \ A \ leq x (lub A)" assumes lub_least: "chain leq A \ (\x. x \ A \ leq x z) \ leq (lub A) z" lemma partial_function_lift: assumes "partial_function_definitions ord lb" shows "partial_function_definitions (fun_ord ord) (fun_lub lb)" (is "partial_function_definitions ?ordf ?lubf") proof - interpret partial_function_definitions ord lb by fact show ?thesis proof fix x show "?ordf x x" unfolding fun_ord_def by (auto simp: leq_refl) next fix x y z assume "?ordf x y" "?ordf y z" thus "?ordf x z" unfolding fun_ord_def by (force dest: leq_trans) next fix x y assume "?ordf x y" "?ordf y x" thus "x = y" unfolding fun_ord_def by (force intro!: dest: leq_antisym) next fix A f assume f: "f \ A" and A: "chain ?ordf A" thus "?ordf f (?lubf A)" unfolding fun_lub_def fun_ord_def by (blast intro: lub_upper chain_fun[OF A] f) next fix A :: "('b \ 'a) set" and g :: "'b \ 'a" assume A: "chain ?ordf A" and g: "\f. f \ A \ ?ordf f g" show "?ordf (?lubf A) g" unfolding fun_lub_def fun_ord_def by (blast intro: lub_least chain_fun[OF A] dest: g[unfolded fun_ord_def]) qed qed lemma ccpo: assumes "partial_function_definitions ord lb" shows "class.ccpo lb ord (mk_less ord)" using assms unfolding partial_function_definitions_def mk_less_def by unfold_locales blast+ lemma partial_function_image: assumes "partial_function_definitions ord Lub" assumes inj: "\x y. f x = f y \ x = y" assumes inv: "\x. f (g x) = x" shows "partial_function_definitions (img_ord f ord) (img_lub f g Lub)" proof - let ?iord = "img_ord f ord" let ?ilub = "img_lub f g Lub" interpret partial_function_definitions ord Lub by fact show ?thesis proof fix A x assume "chain ?iord A" "x \ A" then have "chain ord (f ` A)" "f x \ f ` A" by (auto simp: img_ord_def intro: chainI dest: chainD) thus "?iord x (?ilub A)" unfolding inv img_lub_def img_ord_def by (rule lub_upper) next fix A x assume "chain ?iord A" and 1: "\z. z \ A \ ?iord z x" then have "chain ord (f ` A)" by (auto simp: img_ord_def intro: chainI dest: chainD) thus "?iord (?ilub A) x" unfolding inv img_lub_def img_ord_def by (rule lub_least) (auto dest: 1[unfolded img_ord_def]) qed (auto simp: img_ord_def intro: leq_refl dest: leq_trans leq_antisym inj) qed context partial_function_definitions begin abbreviation "le_fun \ fun_ord leq" abbreviation "lub_fun \ fun_lub lub" abbreviation "fixp_fun \ ccpo.fixp lub_fun le_fun" abbreviation "mono_body \ monotone le_fun leq" abbreviation "admissible \ ccpo.admissible lub_fun le_fun" text \Interpret manually, to avoid flooding everything with facts about orders\ lemma ccpo: "class.ccpo lub_fun le_fun (mk_less le_fun)" apply (rule ccpo) apply (rule partial_function_lift) apply (rule partial_function_definitions_axioms) done text \The crucial fixed-point theorem\ lemma mono_body_fixp: "(\x. mono_body (\f. F f x)) \ fixp_fun F = F (fixp_fun F)" by (rule ccpo.fixp_unfold[OF ccpo]) (auto simp: monotone_def fun_ord_def) text \Version with curry/uncurry combinators, to be used by package\ lemma fixp_rule_uc: fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a" and C :: "('b \ 'a) \ 'c" assumes mono: "\x. mono_body (\f. U (F (C f)) x)" assumes eq: "f \ C (fixp_fun (\f. U (F (C f))))" assumes inverse: "\f. C (U f) = f" shows "f = F f" proof - have "f = C (fixp_fun (\f. U (F (C f))))" by (simp add: eq) also have "... = C (U (F (C (fixp_fun (\f. U (F (C f)))))))" by (subst mono_body_fixp[of "%f. U (F (C f))", OF mono]) (rule refl) also have "... = F (C (fixp_fun (\f. U (F (C f)))))" by (rule inverse) also have "... = F f" by (simp add: eq) finally show "f = F f" . qed text \Fixpoint induction rule\ lemma fixp_induct_uc: fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a" and C :: "('b \ 'a) \ 'c" and P :: "('b \ 'a) \ bool" assumes mono: "\x. mono_body (\f. U (F (C f)) x)" and eq: "f \ C (fixp_fun (\f. U (F (C f))))" and inverse: "\f. U (C f) = f" and adm: "ccpo.admissible lub_fun le_fun P" and bot: "P (\_. lub {})" and step: "\f. P (U f) \ P (U (F f))" shows "P (U f)" unfolding eq inverse apply (rule ccpo.fixp_induct[OF ccpo adm]) apply (insert mono, auto simp: monotone_def fun_ord_def bot fun_lub_def)[2] apply (rule_tac f5="C x" in step) apply (simp add: inverse) done text \Rules for \<^term>\mono_body\:\ lemma const_mono[partial_function_mono]: "monotone ord leq (\f. c)" by (rule monotoneI) (rule leq_refl) end subsection \Flat interpretation: tailrec and option\ definition "flat_ord b x y \ x = b \ x = y" definition "flat_lub b A = (if A \ {b} then b else (THE x. x \ A - {b}))" lemma flat_interpretation: "partial_function_definitions (flat_ord b) (flat_lub b)" proof fix A x assume 1: "chain (flat_ord b) A" "x \ A" show "flat_ord b x (flat_lub b A)" proof cases assume "x = b" thus ?thesis by (simp add: flat_ord_def) next assume "x \ b" with 1 have "A - {b} = {x}" by (auto elim: chainE simp: flat_ord_def) then have "flat_lub b A = x" by (auto simp: flat_lub_def) thus ?thesis by (auto simp: flat_ord_def) qed next fix A z assume A: "chain (flat_ord b) A" and z: "\x. x \ A \ flat_ord b x z" show "flat_ord b (flat_lub b A) z" proof cases assume "A \ {b}" thus ?thesis by (auto simp: flat_lub_def flat_ord_def) next assume nb: "\ A \ {b}" then obtain y where y: "y \ A" "y \ b" by auto with A have "A - {b} = {y}" by (auto elim: chainE simp: flat_ord_def) with nb have "flat_lub b A = y" by (auto simp: flat_lub_def) with z y show ?thesis by auto qed qed (auto simp: flat_ord_def) lemma flat_ordI: "(x \ a \ x = y) \ flat_ord a x y" by(auto simp add: flat_ord_def) lemma flat_ord_antisym: "\ flat_ord a x y; flat_ord a y x \ \ x = y" by(auto simp add: flat_ord_def) lemma antisymp_flat_ord: "antisymp (flat_ord a)" by(rule antisympI)(auto dest: flat_ord_antisym) interpretation tailrec: partial_function_definitions "flat_ord undefined" "flat_lub undefined" rewrites "flat_lub undefined {} \ undefined" by (rule flat_interpretation)(simp add: flat_lub_def) interpretation option: partial_function_definitions "flat_ord None" "flat_lub None" rewrites "flat_lub None {} \ None" by (rule flat_interpretation)(simp add: flat_lub_def) abbreviation "tailrec_ord \ flat_ord undefined" abbreviation "mono_tailrec \ monotone (fun_ord tailrec_ord) tailrec_ord" lemma tailrec_admissible: "ccpo.admissible (fun_lub (flat_lub c)) (fun_ord (flat_ord c)) (\a. \x. a x \ c \ P x (a x))" proof(intro ccpo.admissibleI strip) fix A x assume chain: "Complete_Partial_Order.chain (fun_ord (flat_ord c)) A" and P [rule_format]: "\f\A. \x. f x \ c \ P x (f x)" and defined: "fun_lub (flat_lub c) A x \ c" from defined obtain f where f: "f \ A" "f x \ c" by(auto simp add: fun_lub_def flat_lub_def split: if_split_asm) hence "P x (f x)" by(rule P) moreover from chain f have "\f' \ A. f' x = c \ f' x = f x" by(auto 4 4 simp add: Complete_Partial_Order.chain_def flat_ord_def fun_ord_def) hence "fun_lub (flat_lub c) A x = f x" using f by(auto simp add: fun_lub_def flat_lub_def) ultimately show "P x (fun_lub (flat_lub c) A x)" by simp qed lemma fixp_induct_tailrec: fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a" and C :: "('b \ 'a) \ 'c" and P :: "'b \ 'a \ bool" and x :: "'b" assumes mono: "\x. monotone (fun_ord (flat_ord c)) (flat_ord c) (\f. U (F (C f)) x)" assumes eq: "f \ C (ccpo.fixp (fun_lub (flat_lub c)) (fun_ord (flat_ord c)) (\f. U (F (C f))))" assumes inverse2: "\f. U (C f) = f" assumes step: "\f x y. (\x y. U f x = y \ y \ c \ P x y) \ U (F f) x = y \ y \ c \ P x y" assumes result: "U f x = y" assumes defined: "y \ c" shows "P x y" proof - have "\x y. U f x = y \ y \ c \ P x y" by(rule partial_function_definitions.fixp_induct_uc[OF flat_interpretation, of _ U F C, OF mono eq inverse2]) (auto intro: step tailrec_admissible simp add: fun_lub_def flat_lub_def) thus ?thesis using result defined by blast qed lemma admissible_image: assumes pfun: "partial_function_definitions le lub" assumes adm: "ccpo.admissible lub le (P \ g)" assumes inj: "\x y. f x = f y \ x = y" assumes inv: "\x. f (g x) = x" shows "ccpo.admissible (img_lub f g lub) (img_ord f le) P" proof (rule ccpo.admissibleI) fix A assume "chain (img_ord f le) A" then have ch': "chain le (f ` A)" by (auto simp: img_ord_def intro: chainI dest: chainD) assume "A \ {}" assume P_A: "\x\A. P x" have "(P \ g) (lub (f ` A))" using adm ch' proof (rule ccpo.admissibleD) fix x assume "x \ f ` A" with P_A show "(P \ g) x" by (auto simp: inj[OF inv]) qed(simp add: \A \ {}\) thus "P (img_lub f g lub A)" unfolding img_lub_def by simp qed lemma admissible_fun: assumes pfun: "partial_function_definitions le lub" assumes adm: "\x. ccpo.admissible lub le (Q x)" shows "ccpo.admissible (fun_lub lub) (fun_ord le) (\f. \x. Q x (f x))" proof (rule ccpo.admissibleI) fix A :: "('b \ 'a) set" assume Q: "\f\A. \x. Q x (f x)" assume ch: "chain (fun_ord le) A" assume "A \ {}" hence non_empty: "\a. {y. \f\A. y = f a} \ {}" by auto show "\x. Q x (fun_lub lub A x)" unfolding fun_lub_def by (rule allI, rule ccpo.admissibleD[OF adm chain_fun[OF ch] non_empty]) (auto simp: Q) qed abbreviation "option_ord \ flat_ord None" abbreviation "mono_option \ monotone (fun_ord option_ord) option_ord" lemma bind_mono[partial_function_mono]: assumes mf: "mono_option B" and mg: "\y. mono_option (\f. C y f)" shows "mono_option (\f. Option.bind (B f) (\y. C y f))" proof (rule monotoneI) fix f g :: "'a \ 'b option" assume fg: "fun_ord option_ord f g" with mf have "option_ord (B f) (B g)" by (rule monotoneD[of _ _ _ f g]) then have "option_ord (Option.bind (B f) (\y. C y f)) (Option.bind (B g) (\y. C y f))" unfolding flat_ord_def by auto also from mg have "\y'. option_ord (C y' f) (C y' g)" by (rule monotoneD) (rule fg) then have "option_ord (Option.bind (B g) (\y'. C y' f)) (Option.bind (B g) (\y'. C y' g))" unfolding flat_ord_def by (cases "B g") auto finally (option.leq_trans) show "option_ord (Option.bind (B f) (\y. C y f)) (Option.bind (B g) (\y'. C y' g))" . qed lemma flat_lub_in_chain: assumes ch: "chain (flat_ord b) A " assumes lub: "flat_lub b A = a" shows "a = b \ a \ A" proof (cases "A \ {b}") case True then have "flat_lub b A = b" unfolding flat_lub_def by simp with lub show ?thesis by simp next case False then obtain c where "c \ A" and "c \ b" by auto { fix z assume "z \ A" from chainD[OF ch \c \ A\ this] have "z = c \ z = b" unfolding flat_ord_def using \c \ b\ by auto } with False have "A - {b} = {c}" by auto with False have "flat_lub b A = c" by (auto simp: flat_lub_def) with \c \ A\ lub show ?thesis by simp qed lemma option_admissible: "option.admissible (%(f::'a \ 'b option). (\x y. f x = Some y \ P x y))" proof (rule ccpo.admissibleI) fix A :: "('a \ 'b option) set" assume ch: "chain option.le_fun A" and IH: "\f\A. \x y. f x = Some y \ P x y" from ch have ch': "\x. chain option_ord {y. \f\A. y = f x}" by (rule chain_fun) show "\x y. option.lub_fun A x = Some y \ P x y" proof (intro allI impI) fix x y assume "option.lub_fun A x = Some y" from flat_lub_in_chain[OF ch' this[unfolded fun_lub_def]] have "Some y \ {y. \f\A. y = f x}" by simp then have "\f\A. f x = Some y" by auto with IH show "P x y" by auto qed qed lemma fixp_induct_option: fixes F :: "'c \ 'c" and U :: "'c \ 'b \ 'a option" and C :: "('b \ 'a option) \ 'c" and P :: "'b \ 'a \ bool" assumes mono: "\x. mono_option (\f. U (F (C f)) x)" assumes eq: "f \ C (ccpo.fixp (fun_lub (flat_lub None)) (fun_ord option_ord) (\f. U (F (C f))))" assumes inverse2: "\f. U (C f) = f" assumes step: "\f x y. (\x y. U f x = Some y \ P x y) \ U (F f) x = Some y \ P x y" assumes defined: "U f x = Some y" shows "P x y" using step defined option.fixp_induct_uc[of U F C, OF mono eq inverse2 option_admissible] unfolding fun_lub_def flat_lub_def by(auto 9 2) declaration \Partial_Function.init "tailrec" \<^term>\tailrec.fixp_fun\ \<^term>\tailrec.mono_body\ @{thm tailrec.fixp_rule_uc} @{thm tailrec.fixp_induct_uc} (SOME @{thm fixp_induct_tailrec[where c = undefined]})\ declaration \Partial_Function.init "option" \<^term>\option.fixp_fun\ \<^term>\option.mono_body\ @{thm option.fixp_rule_uc} @{thm option.fixp_induct_uc} (SOME @{thm fixp_induct_option})\ hide_const (open) chain end diff --git a/src/HOL/Power.thy b/src/HOL/Power.thy --- a/src/HOL/Power.thy +++ b/src/HOL/Power.thy @@ -1,1020 +1,1021 @@ (* Title: HOL/Power.thy Author: Lawrence C Paulson, Cambridge University Computer Laboratory Copyright 1997 University of Cambridge *) section \Exponentiation\ theory Power imports Num begin subsection \Powers for Arbitrary Monoids\ class power = one + times begin primrec power :: "'a \ nat \ 'a" (infixr "^" 80) where power_0: "a ^ 0 = 1" | power_Suc: "a ^ Suc n = a * a ^ n" notation (latex output) power ("(_\<^bsup>_\<^esup>)" [1000] 1000) text \Special syntax for squares.\ abbreviation power2 :: "'a \ 'a" ("(_\<^sup>2)" [1000] 999) where "x\<^sup>2 \ x ^ 2" end context includes lifting_syntax begin lemma power_transfer [transfer_rule]: \(R ===> (=) ===> R) (^) (^)\ if [transfer_rule]: \R 1 1\ \(R ===> R ===> R) (*) (*)\ for R :: \'a::power \ 'b::power \ bool\ by (simp only: power_def [abs_def]) transfer_prover end context monoid_mult begin subclass power . lemma power_one [simp]: "1 ^ n = 1" by (induct n) simp_all lemma power_one_right [simp]: "a ^ 1 = a" by simp lemma power_Suc0_right [simp]: "a ^ Suc 0 = a" by simp lemma power_commutes: "a ^ n * a = a * a ^ n" by (induct n) (simp_all add: mult.assoc) lemma power_Suc2: "a ^ Suc n = a ^ n * a" by (simp add: power_commutes) lemma power_add: "a ^ (m + n) = a ^ m * a ^ n" by (induct m) (simp_all add: algebra_simps) lemma power_mult: "a ^ (m * n) = (a ^ m) ^ n" by (induct n) (simp_all add: power_add) lemma power_even_eq: "a ^ (2 * n) = (a ^ n)\<^sup>2" by (subst mult.commute) (simp add: power_mult) lemma power_odd_eq: "a ^ Suc (2*n) = a * (a ^ n)\<^sup>2" by (simp add: power_even_eq) lemma power_numeral_even: "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)" by (simp only: numeral_Bit0 power_add Let_def) lemma power_numeral_odd: "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)" by (simp only: numeral_Bit1 One_nat_def add_Suc_right add_0_right power_Suc power_add Let_def mult.assoc) lemma power2_eq_square: "a\<^sup>2 = a * a" by (simp add: numeral_2_eq_2) lemma power3_eq_cube: "a ^ 3 = a * a * a" by (simp add: numeral_3_eq_3 mult.assoc) lemma power4_eq_xxxx: "x^4 = x * x * x * x" by (simp add: mult.assoc power_numeral_even) lemma funpow_times_power: "(times x ^^ f x) = times (x ^ f x)" proof (induct "f x" arbitrary: f) case 0 then show ?case by (simp add: fun_eq_iff) next case (Suc n) define g where "g x = f x - 1" for x with Suc have "n = g x" by simp with Suc have "times x ^^ g x = times (x ^ g x)" by simp moreover from Suc g_def have "f x = g x + 1" by simp ultimately show ?case by (simp add: power_add funpow_add fun_eq_iff mult.assoc) qed lemma power_commuting_commutes: assumes "x * y = y * x" shows "x ^ n * y = y * x ^n" proof (induct n) case 0 then show ?case by simp next case (Suc n) have "x ^ Suc n * y = x ^ n * y * x" by (subst power_Suc2) (simp add: assms ac_simps) also have "\ = y * x ^ Suc n" by (simp only: Suc power_Suc2) (simp add: ac_simps) finally show ?case . qed lemma power_minus_mult: "0 < n \ a ^ (n - 1) * a = a ^ n" by (simp add: power_commutes split: nat_diff_split) lemma left_right_inverse_power: assumes "x * y = 1" shows "x ^ n * y ^ n = 1" proof (induct n) case (Suc n) moreover have "x ^ Suc n * y ^ Suc n = x^n * (x * y) * y^n" by (simp add: power_Suc2[symmetric] mult.assoc[symmetric]) ultimately show ?case by (simp add: assms) qed simp end context comm_monoid_mult begin lemma power_mult_distrib [algebra_simps, algebra_split_simps, field_simps, field_split_simps, divide_simps]: "(a * b) ^ n = (a ^ n) * (b ^ n)" by (induction n) (simp_all add: ac_simps) end text \Extract constant factors from powers.\ declare power_mult_distrib [where a = "numeral w" for w, simp] declare power_mult_distrib [where b = "numeral w" for w, simp] lemma power_add_numeral [simp]: "a^numeral m * a^numeral n = a^numeral (m + n)" for a :: "'a::monoid_mult" by (simp add: power_add [symmetric]) lemma power_add_numeral2 [simp]: "a^numeral m * (a^numeral n * b) = a^numeral (m + n) * b" for a :: "'a::monoid_mult" by (simp add: mult.assoc [symmetric]) lemma power_mult_numeral [simp]: "(a^numeral m)^numeral n = a^numeral (m * n)" for a :: "'a::monoid_mult" by (simp only: numeral_mult power_mult) context semiring_numeral begin lemma numeral_sqr: "numeral (Num.sqr k) = numeral k * numeral k" by (simp only: sqr_conv_mult numeral_mult) lemma numeral_pow: "numeral (Num.pow k l) = numeral k ^ numeral l" by (induct l) (simp_all only: numeral_class.numeral.simps pow.simps numeral_sqr numeral_mult power_add power_one_right) lemma power_numeral [simp]: "numeral k ^ numeral l = numeral (Num.pow k l)" by (rule numeral_pow [symmetric]) end context semiring_1 begin lemma of_nat_power [simp]: "of_nat (m ^ n) = of_nat m ^ n" by (induct n) simp_all lemma zero_power: "0 < n \ 0 ^ n = 0" by (cases n) simp_all lemma power_zero_numeral [simp]: "0 ^ numeral k = 0" by (simp add: numeral_eq_Suc) lemma zero_power2: "0\<^sup>2 = 0" (* delete? *) by (rule power_zero_numeral) lemma one_power2: "1\<^sup>2 = 1" (* delete? *) by (rule power_one) lemma power_0_Suc [simp]: "0 ^ Suc n = 0" by simp text \It looks plausible as a simprule, but its effect can be strange.\ lemma power_0_left: "0 ^ n = (if n = 0 then 1 else 0)" by (cases n) simp_all end context semiring_char_0 begin lemma numeral_power_eq_of_nat_cancel_iff [simp]: "numeral x ^ n = of_nat y \ numeral x ^ n = y" using of_nat_eq_iff by fastforce lemma real_of_nat_eq_numeral_power_cancel_iff [simp]: "of_nat y = numeral x ^ n \ y = numeral x ^ n" using numeral_power_eq_of_nat_cancel_iff [of x n y] by (metis (mono_tags)) lemma of_nat_eq_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w = of_nat x \ b ^ w = x" by (metis of_nat_power of_nat_eq_iff) lemma of_nat_power_eq_of_nat_cancel_iff[simp]: "of_nat x = (of_nat b) ^ w \ x = b ^ w" by (metis of_nat_eq_of_nat_power_cancel_iff) end context comm_semiring_1 begin text \The divides relation.\ lemma le_imp_power_dvd: assumes "m \ n" shows "a ^ m dvd a ^ n" proof from assms have "a ^ n = a ^ (m + (n - m))" by simp also have "\ = a ^ m * a ^ (n - m)" by (rule power_add) finally show "a ^ n = a ^ m * a ^ (n - m)" . qed lemma power_le_dvd: "a ^ n dvd b \ m \ n \ a ^ m dvd b" by (rule dvd_trans [OF le_imp_power_dvd]) lemma dvd_power_same: "x dvd y \ x ^ n dvd y ^ n" by (induct n) (auto simp add: mult_dvd_mono) lemma dvd_power_le: "x dvd y \ m \ n \ x ^ n dvd y ^ m" by (rule power_le_dvd [OF dvd_power_same]) lemma dvd_power [simp]: fixes n :: nat assumes "n > 0 \ x = 1" shows "x dvd (x ^ n)" using assms proof assume "0 < n" then have "x ^ n = x ^ Suc (n - 1)" by simp then show "x dvd (x ^ n)" by simp next assume "x = 1" then show "x dvd (x ^ n)" by simp qed end context semiring_1_no_zero_divisors begin subclass power . lemma power_eq_0_iff [simp]: "a ^ n = 0 \ a = 0 \ n > 0" by (induct n) auto lemma power_not_zero: "a \ 0 \ a ^ n \ 0" by (induct n) auto lemma zero_eq_power2 [simp]: "a\<^sup>2 = 0 \ a = 0" unfolding power2_eq_square by simp end context ring_1 begin lemma power_minus: "(- a) ^ n = (- 1) ^ n * a ^ n" proof (induct n) case 0 show ?case by simp next case (Suc n) then show ?case by (simp del: power_Suc add: power_Suc2 mult.assoc) qed lemma power_minus': "NO_MATCH 1 x \ (-x) ^ n = (-1)^n * x ^ n" by (rule power_minus) lemma power_minus_Bit0: "(- x) ^ numeral (Num.Bit0 k) = x ^ numeral (Num.Bit0 k)" by (induct k, simp_all only: numeral_class.numeral.simps power_add power_one_right mult_minus_left mult_minus_right minus_minus) lemma power_minus_Bit1: "(- x) ^ numeral (Num.Bit1 k) = - (x ^ numeral (Num.Bit1 k))" by (simp only: eval_nat_numeral(3) power_Suc power_minus_Bit0 mult_minus_left) lemma power2_minus [simp]: "(- a)\<^sup>2 = a\<^sup>2" by (fact power_minus_Bit0) lemma power_minus1_even [simp]: "(- 1) ^ (2*n) = 1" proof (induct n) case 0 show ?case by simp next case (Suc n) then show ?case by (simp add: power_add power2_eq_square) qed lemma power_minus1_odd: "(- 1) ^ Suc (2*n) = -1" by simp lemma power_minus_even [simp]: "(-a) ^ (2*n) = a ^ (2*n)" by (simp add: power_minus [of a]) end context ring_1_no_zero_divisors begin lemma power2_eq_1_iff: "a\<^sup>2 = 1 \ a = 1 \ a = - 1" using square_eq_1_iff [of a] by (simp add: power2_eq_square) end context idom begin lemma power2_eq_iff: "x\<^sup>2 = y\<^sup>2 \ x = y \ x = - y" unfolding power2_eq_square by (rule square_eq_iff) end context semidom_divide begin lemma power_diff: "a ^ (m - n) = (a ^ m) div (a ^ n)" if "a \ 0" and "n \ m" proof - define q where "q = m - n" with \n \ m\ have "m = q + n" by simp with \a \ 0\ q_def show ?thesis by (simp add: power_add) qed end context algebraic_semidom begin lemma div_power: "b dvd a \ (a div b) ^ n = a ^ n div b ^ n" by (induct n) (simp_all add: div_mult_div_if_dvd dvd_power_same) lemma is_unit_power_iff: "is_unit (a ^ n) \ is_unit a \ n = 0" by (induct n) (auto simp add: is_unit_mult_iff) lemma dvd_power_iff: assumes "x \ 0" shows "x ^ m dvd x ^ n \ is_unit x \ m \ n" proof assume *: "x ^ m dvd x ^ n" { assume "m > n" note * also have "x ^ n = x ^ n * 1" by simp also from \m > n\ have "m = n + (m - n)" by simp also have "x ^ \ = x ^ n * x ^ (m - n)" by (rule power_add) finally have "x ^ (m - n) dvd 1" by (subst (asm) dvd_times_left_cancel_iff) (insert assms, simp_all) with \m > n\ have "is_unit x" by (simp add: is_unit_power_iff) } thus "is_unit x \ m \ n" by force qed (auto intro: unit_imp_dvd simp: is_unit_power_iff le_imp_power_dvd) end context normalization_semidom_multiplicative begin lemma normalize_power: "normalize (a ^ n) = normalize a ^ n" by (induct n) (simp_all add: normalize_mult) lemma unit_factor_power: "unit_factor (a ^ n) = unit_factor a ^ n" by (induct n) (simp_all add: unit_factor_mult) end context division_ring begin text \Perhaps these should be simprules.\ lemma power_inverse [field_simps, field_split_simps, divide_simps]: "inverse a ^ n = inverse (a ^ n)" proof (cases "a = 0") case True then show ?thesis by (simp add: power_0_left) next case False then have "inverse (a ^ n) = inverse a ^ n" by (induct n) (simp_all add: nonzero_inverse_mult_distrib power_commutes) then show ?thesis by simp qed lemma power_one_over [field_simps, field_split_simps, divide_simps]: "(1 / a) ^ n = 1 / a ^ n" using power_inverse [of a] by (simp add: divide_inverse) end context field begin lemma power_divide [field_simps, field_split_simps, divide_simps]: "(a / b) ^ n = a ^ n / b ^ n" by (induct n) simp_all end subsection \Exponentiation on ordered types\ context linordered_semidom begin lemma zero_less_power [simp]: "0 < a \ 0 < a ^ n" by (induct n) simp_all lemma zero_le_power [simp]: "0 \ a \ 0 \ a ^ n" by (induct n) simp_all lemma power_mono: "a \ b \ 0 \ a \ a ^ n \ b ^ n" by (induct n) (auto intro: mult_mono order_trans [of 0 a b]) lemma one_le_power [simp]: "1 \ a \ 1 \ a ^ n" using power_mono [of 1 a n] by simp lemma power_le_one: "0 \ a \ a \ 1 \ a ^ n \ 1" using power_mono [of a 1 n] by simp lemma power_gt1_lemma: assumes gt1: "1 < a" shows "1 < a * a ^ n" proof - from gt1 have "0 \ a" by (fact order_trans [OF zero_le_one less_imp_le]) from gt1 have "1 * 1 < a * 1" by simp also from gt1 have "\ \ a * a ^ n" by (simp only: mult_mono \0 \ a\ one_le_power order_less_imp_le zero_le_one order_refl) finally show ?thesis by simp qed lemma power_gt1: "1 < a \ 1 < a ^ Suc n" by (simp add: power_gt1_lemma) lemma one_less_power [simp]: "1 < a \ 0 < n \ 1 < a ^ n" by (cases n) (simp_all add: power_gt1_lemma) lemma power_le_imp_le_exp: assumes gt1: "1 < a" shows "a ^ m \ a ^ n \ m \ n" proof (induct m arbitrary: n) case 0 show ?case by simp next case (Suc m) show ?case proof (cases n) case 0 with Suc have "a * a ^ m \ 1" by simp with gt1 show ?thesis by (force simp only: power_gt1_lemma not_less [symmetric]) next case (Suc n) with Suc.prems Suc.hyps show ?thesis by (force dest: mult_left_le_imp_le simp add: less_trans [OF zero_less_one gt1]) qed qed lemma of_nat_zero_less_power_iff [simp]: "of_nat x ^ n > 0 \ x > 0 \ n = 0" by (induct n) auto text \Surely we can strengthen this? It holds for \0 too.\ -lemma power_inject_exp [simp]: "1 < a \ a ^ m = a ^ n \ m = n" - by (force simp add: order_antisym power_le_imp_le_exp) +lemma power_inject_exp [simp]: + \a ^ m = a ^ n \ m = n\ if \1 < a\ + using that by (force simp add: order_class.order.antisym power_le_imp_le_exp) text \ Can relax the first premise to \<^term>\0 in the case of the natural numbers. \ lemma power_less_imp_less_exp: "1 < a \ a ^ m < a ^ n \ m < n" by (simp add: order_less_le [of m n] less_le [of "a^m" "a^n"] power_le_imp_le_exp) lemma power_strict_mono [rule_format]: "a < b \ 0 \ a \ 0 < n \ a ^ n < b ^ n" by (induct n) (auto simp: mult_strict_mono le_less_trans [of 0 a b]) lemma power_mono_iff [simp]: shows "\a \ 0; b \ 0; n>0\ \ a ^ n \ b ^ n \ a \ b" using power_mono [of a b] power_strict_mono [of b a] not_le by auto text\Lemma for \power_strict_decreasing\\ lemma power_Suc_less: "0 < a \ a < 1 \ a * a ^ n < a ^ n" by (induct n) (auto simp: mult_strict_left_mono) lemma power_strict_decreasing [rule_format]: "n < N \ 0 < a \ a < 1 \ a ^ N < a ^ n" proof (induct N) case 0 then show ?case by simp next case (Suc N) then show ?case apply (auto simp add: power_Suc_less less_Suc_eq) apply (subgoal_tac "a * a^N < 1 * a^n") apply simp apply (rule mult_strict_mono) apply auto done qed text \Proof resembles that of \power_strict_decreasing\.\ lemma power_decreasing: "n \ N \ 0 \ a \ a \ 1 \ a ^ N \ a ^ n" proof (induct N) case 0 then show ?case by simp next case (Suc N) then show ?case apply (auto simp add: le_Suc_eq) apply (subgoal_tac "a * a^N \ 1 * a^n") apply simp apply (rule mult_mono) apply auto done qed lemma power_decreasing_iff [simp]: "\0 < b; b < 1\ \ b ^ m \ b ^ n \ n \ m" using power_strict_decreasing [of m n b] by (auto intro: power_decreasing ccontr) lemma power_strict_decreasing_iff [simp]: "\0 < b; b < 1\ \ b ^ m < b ^ n \ n < m" using power_decreasing_iff [of b m n] unfolding le_less by (auto dest: power_strict_decreasing le_neq_implies_less) lemma power_Suc_less_one: "0 < a \ a < 1 \ a ^ Suc n < 1" using power_strict_decreasing [of 0 "Suc n" a] by simp text \Proof again resembles that of \power_strict_decreasing\.\ lemma power_increasing: "n \ N \ 1 \ a \ a ^ n \ a ^ N" proof (induct N) case 0 then show ?case by simp next case (Suc N) then show ?case apply (auto simp add: le_Suc_eq) apply (subgoal_tac "1 * a^n \ a * a^N") apply simp apply (rule mult_mono) apply (auto simp add: order_trans [OF zero_le_one]) done qed text \Lemma for \power_strict_increasing\.\ lemma power_less_power_Suc: "1 < a \ a ^ n < a * a ^ n" by (induct n) (auto simp: mult_strict_left_mono less_trans [OF zero_less_one]) lemma power_strict_increasing: "n < N \ 1 < a \ a ^ n < a ^ N" proof (induct N) case 0 then show ?case by simp next case (Suc N) then show ?case apply (auto simp add: power_less_power_Suc less_Suc_eq) apply (subgoal_tac "1 * a^n < a * a^N") apply simp apply (rule mult_strict_mono) apply (auto simp add: less_trans [OF zero_less_one] less_imp_le) done qed lemma power_increasing_iff [simp]: "1 < b \ b ^ x \ b ^ y \ x \ y" by (blast intro: power_le_imp_le_exp power_increasing less_imp_le) lemma power_strict_increasing_iff [simp]: "1 < b \ b ^ x < b ^ y \ x < y" by (blast intro: power_less_imp_less_exp power_strict_increasing) lemma power_le_imp_le_base: assumes le: "a ^ Suc n \ b ^ Suc n" and "0 \ b" shows "a \ b" proof (rule ccontr) assume "\ ?thesis" then have "b < a" by (simp only: linorder_not_le) then have "b ^ Suc n < a ^ Suc n" by (simp only: assms(2) power_strict_mono) with le show False by (simp add: linorder_not_less [symmetric]) qed lemma power_less_imp_less_base: assumes less: "a ^ n < b ^ n" assumes nonneg: "0 \ b" shows "a < b" proof (rule contrapos_pp [OF less]) assume "\ ?thesis" then have "b \ a" by (simp only: linorder_not_less) from this nonneg have "b ^ n \ a ^ n" by (rule power_mono) then show "\ a ^ n < b ^ n" by (simp only: linorder_not_less) qed lemma power_inject_base: "a ^ Suc n = b ^ Suc n \ 0 \ a \ 0 \ b \ a = b" - by (blast intro: power_le_imp_le_base antisym eq_refl sym) + by (blast intro: power_le_imp_le_base order.antisym eq_refl sym) lemma power_eq_imp_eq_base: "a ^ n = b ^ n \ 0 \ a \ 0 \ b \ 0 < n \ a = b" by (cases n) (simp_all del: power_Suc, rule power_inject_base) lemma power_eq_iff_eq_base: "0 < n \ 0 \ a \ 0 \ b \ a ^ n = b ^ n \ a = b" using power_eq_imp_eq_base [of a n b] by auto lemma power2_le_imp_le: "x\<^sup>2 \ y\<^sup>2 \ 0 \ y \ x \ y" unfolding numeral_2_eq_2 by (rule power_le_imp_le_base) lemma power2_less_imp_less: "x\<^sup>2 < y\<^sup>2 \ 0 \ y \ x < y" by (rule power_less_imp_less_base) lemma power2_eq_imp_eq: "x\<^sup>2 = y\<^sup>2 \ 0 \ x \ 0 \ y \ x = y" unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base) simp lemma power_Suc_le_self: "0 \ a \ a \ 1 \ a ^ Suc n \ a" using power_decreasing [of 1 "Suc n" a] by simp lemma power2_eq_iff_nonneg [simp]: assumes "0 \ x" "0 \ y" shows "(x ^ 2 = y ^ 2) \ x = y" using assms power2_eq_imp_eq by blast lemma of_nat_less_numeral_power_cancel_iff[simp]: "of_nat x < numeral i ^ n \ x < numeral i ^ n" using of_nat_less_iff[of x "numeral i ^ n", unfolded of_nat_numeral of_nat_power] . lemma of_nat_le_numeral_power_cancel_iff[simp]: "of_nat x \ numeral i ^ n \ x \ numeral i ^ n" using of_nat_le_iff[of x "numeral i ^ n", unfolded of_nat_numeral of_nat_power] . lemma numeral_power_less_of_nat_cancel_iff[simp]: "numeral i ^ n < of_nat x \ numeral i ^ n < x" using of_nat_less_iff[of "numeral i ^ n" x, unfolded of_nat_numeral of_nat_power] . lemma numeral_power_le_of_nat_cancel_iff[simp]: "numeral i ^ n \ of_nat x \ numeral i ^ n \ x" using of_nat_le_iff[of "numeral i ^ n" x, unfolded of_nat_numeral of_nat_power] . lemma of_nat_le_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w \ of_nat x \ b ^ w \ x" by (metis of_nat_le_iff of_nat_power) lemma of_nat_power_le_of_nat_cancel_iff[simp]: "of_nat x \ (of_nat b) ^ w \ x \ b ^ w" by (metis of_nat_le_iff of_nat_power) lemma of_nat_less_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w < of_nat x \ b ^ w < x" by (metis of_nat_less_iff of_nat_power) lemma of_nat_power_less_of_nat_cancel_iff[simp]: "of_nat x < (of_nat b) ^ w \ x < b ^ w" by (metis of_nat_less_iff of_nat_power) end text \Some @{typ nat}-specific lemmas:\ lemma mono_ge2_power_minus_self: assumes "k \ 2" shows "mono (\m. k ^ m - m)" unfolding mono_iff_le_Suc proof fix n have "k ^ n < k ^ Suc n" using power_strict_increasing_iff[of k "n" "Suc n"] assms by linarith thus "k ^ n - n \ k ^ Suc n - Suc n" by linarith qed lemma self_le_ge2_pow[simp]: assumes "k \ 2" shows "m \ k ^ m" proof (induction m) case 0 show ?case by simp next case (Suc m) hence "Suc m \ Suc (k ^ m)" by simp also have "... \ k^m + k^m" using one_le_power[of k m] assms by linarith also have "... \ k * k^m" by (metis mult_2 mult_le_mono1[OF assms]) finally show ?case by simp qed lemma diff_le_diff_pow[simp]: assumes "k \ 2" shows "m - n \ k ^ m - k ^ n" proof (cases "n \ m") case True thus ?thesis using monoD[OF mono_ge2_power_minus_self[OF assms] True] self_le_ge2_pow[OF assms, of m] by (simp add: le_diff_conv le_diff_conv2) qed auto context linordered_ring_strict begin lemma sum_squares_eq_zero_iff: "x * x + y * y = 0 \ x = 0 \ y = 0" by (simp add: add_nonneg_eq_0_iff) lemma sum_squares_le_zero_iff: "x * x + y * y \ 0 \ x = 0 \ y = 0" by (simp add: le_less not_sum_squares_lt_zero sum_squares_eq_zero_iff) lemma sum_squares_gt_zero_iff: "0 < x * x + y * y \ x \ 0 \ y \ 0" by (simp add: not_le [symmetric] sum_squares_le_zero_iff) end context linordered_idom begin lemma zero_le_power2 [simp]: "0 \ a\<^sup>2" by (simp add: power2_eq_square) lemma zero_less_power2 [simp]: "0 < a\<^sup>2 \ a \ 0" by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff) lemma power2_less_0 [simp]: "\ a\<^sup>2 < 0" by (force simp add: power2_eq_square mult_less_0_iff) lemma power_abs: "\a ^ n\ = \a\ ^ n" \ \FIXME simp?\ by (induct n) (simp_all add: abs_mult) lemma power_sgn [simp]: "sgn (a ^ n) = sgn a ^ n" by (induct n) (simp_all add: sgn_mult) lemma abs_power_minus [simp]: "\(- a) ^ n\ = \a ^ n\" by (simp add: power_abs) lemma zero_less_power_abs_iff [simp]: "0 < \a\ ^ n \ a \ 0 \ n = 0" proof (induct n) case 0 show ?case by simp next case Suc then show ?case by (auto simp: zero_less_mult_iff) qed lemma zero_le_power_abs [simp]: "0 \ \a\ ^ n" by (rule zero_le_power [OF abs_ge_zero]) lemma power2_less_eq_zero_iff [simp]: "a\<^sup>2 \ 0 \ a = 0" by (simp add: le_less) lemma abs_power2 [simp]: "\a\<^sup>2\ = a\<^sup>2" by (simp add: power2_eq_square) lemma power2_abs [simp]: "\a\\<^sup>2 = a\<^sup>2" by (simp add: power2_eq_square) lemma odd_power_less_zero: "a < 0 \ a ^ Suc (2 * n) < 0" proof (induct n) case 0 then show ?case by simp next case (Suc n) have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)" by (simp add: ac_simps power_add power2_eq_square) then show ?case by (simp del: power_Suc add: Suc mult_less_0_iff mult_neg_neg) qed lemma odd_0_le_power_imp_0_le: "0 \ a ^ Suc (2 * n) \ 0 \ a" using odd_power_less_zero [of a n] by (force simp add: linorder_not_less [symmetric]) lemma zero_le_even_power'[simp]: "0 \ a ^ (2 * n)" proof (induct n) case 0 show ?case by simp next case (Suc n) have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)" by (simp add: ac_simps power_add power2_eq_square) then show ?case by (simp add: Suc zero_le_mult_iff) qed lemma sum_power2_ge_zero: "0 \ x\<^sup>2 + y\<^sup>2" by (intro add_nonneg_nonneg zero_le_power2) lemma not_sum_power2_lt_zero: "\ x\<^sup>2 + y\<^sup>2 < 0" unfolding not_less by (rule sum_power2_ge_zero) lemma sum_power2_eq_zero_iff: "x\<^sup>2 + y\<^sup>2 = 0 \ x = 0 \ y = 0" unfolding power2_eq_square by (simp add: add_nonneg_eq_0_iff) lemma sum_power2_le_zero_iff: "x\<^sup>2 + y\<^sup>2 \ 0 \ x = 0 \ y = 0" by (simp add: le_less sum_power2_eq_zero_iff not_sum_power2_lt_zero) lemma sum_power2_gt_zero_iff: "0 < x\<^sup>2 + y\<^sup>2 \ x \ 0 \ y \ 0" unfolding not_le [symmetric] by (simp add: sum_power2_le_zero_iff) lemma abs_le_square_iff: "\x\ \ \y\ \ x\<^sup>2 \ y\<^sup>2" (is "?lhs \ ?rhs") proof assume ?lhs then have "\x\\<^sup>2 \ \y\\<^sup>2" by (rule power_mono) simp then show ?rhs by simp next assume ?rhs then show ?lhs by (auto intro!: power2_le_imp_le [OF _ abs_ge_zero]) qed lemma abs_square_le_1:"x\<^sup>2 \ 1 \ \x\ \ 1" using abs_le_square_iff [of x 1] by simp lemma abs_square_eq_1: "x\<^sup>2 = 1 \ \x\ = 1" by (auto simp add: abs_if power2_eq_1_iff) lemma abs_square_less_1: "x\<^sup>2 < 1 \ \x\ < 1" using abs_square_eq_1 [of x] abs_square_le_1 [of x] by (auto simp add: le_less) lemma square_le_1: assumes "- 1 \ x" "x \ 1" shows "x\<^sup>2 \ 1" using assms by (metis add.inverse_inverse linear mult_le_one neg_equal_0_iff_equal neg_le_iff_le power2_eq_square power_minus_Bit0) end subsection \Miscellaneous rules\ lemma (in linordered_semidom) self_le_power: "1 \ a \ 0 < n \ a \ a ^ n" using power_increasing [of 1 n a] power_one_right [of a] by auto lemma (in power) power_eq_if: "p ^ m = (if m=0 then 1 else p * (p ^ (m - 1)))" unfolding One_nat_def by (cases m) simp_all lemma (in comm_semiring_1) power2_sum: "(x + y)\<^sup>2 = x\<^sup>2 + y\<^sup>2 + 2 * x * y" by (simp add: algebra_simps power2_eq_square mult_2_right) context comm_ring_1 begin lemma power2_diff: "(x - y)\<^sup>2 = x\<^sup>2 + y\<^sup>2 - 2 * x * y" by (simp add: algebra_simps power2_eq_square mult_2_right) lemma power2_commute: "(x - y)\<^sup>2 = (y - x)\<^sup>2" by (simp add: algebra_simps power2_eq_square) lemma minus_power_mult_self: "(- a) ^ n * (- a) ^ n = a ^ (2 * n)" by (simp add: power_mult_distrib [symmetric]) (simp add: power2_eq_square [symmetric] power_mult [symmetric]) lemma minus_one_mult_self [simp]: "(- 1) ^ n * (- 1) ^ n = 1" using minus_power_mult_self [of 1 n] by simp lemma left_minus_one_mult_self [simp]: "(- 1) ^ n * ((- 1) ^ n * a) = a" by (simp add: mult.assoc [symmetric]) end text \Simprules for comparisons where common factors can be cancelled.\ lemmas zero_compare_simps = add_strict_increasing add_strict_increasing2 add_increasing zero_le_mult_iff zero_le_divide_iff zero_less_mult_iff zero_less_divide_iff mult_le_0_iff divide_le_0_iff mult_less_0_iff divide_less_0_iff zero_le_power2 power2_less_0 subsection \Exponentiation for the Natural Numbers\ lemma nat_one_le_power [simp]: "Suc 0 \ i \ Suc 0 \ i ^ n" by (rule one_le_power [of i n, unfolded One_nat_def]) lemma nat_zero_less_power_iff [simp]: "x ^ n > 0 \ x > 0 \ n = 0" for x :: nat by (induct n) auto lemma nat_power_eq_Suc_0_iff [simp]: "x ^ m = Suc 0 \ m = 0 \ x = Suc 0" by (induct m) auto lemma power_Suc_0 [simp]: "Suc 0 ^ n = Suc 0" by simp text \ Valid for the naturals, but what if \0 < i < 1\? Premises cannot be weakened: consider the case where \i = 0\, \m = 1\ and \n = 0\. \ lemma nat_power_less_imp_less: fixes i :: nat assumes nonneg: "0 < i" assumes less: "i ^ m < i ^ n" shows "m < n" proof (cases "i = 1") case True with less power_one [where 'a = nat] show ?thesis by simp next case False with nonneg have "1 < i" by auto from power_strict_increasing_iff [OF this] less show ?thesis .. qed lemma power_gt_expt: "n > Suc 0 \ n^k > k" by (induction k) (auto simp: less_trans_Suc n_less_m_mult_n) lemma less_exp: \n < 2 ^ n\ by (simp add: power_gt_expt) lemma power_dvd_imp_le: fixes i :: nat assumes "i ^ m dvd i ^ n" "1 < i" shows "m \ n" using assms by (auto intro: power_le_imp_le_exp [OF \1 < i\ dvd_imp_le]) lemma dvd_power_iff_le: fixes k::nat shows "2 \ k \ ((k ^ m) dvd (k ^ n) \ m \ n)" using le_imp_power_dvd power_dvd_imp_le by force lemma power2_nat_le_eq_le: "m\<^sup>2 \ n\<^sup>2 \ m \ n" for m n :: nat by (auto intro: power2_le_imp_le power_mono) lemma power2_nat_le_imp_le: fixes m n :: nat assumes "m\<^sup>2 \ n" shows "m \ n" proof (cases m) case 0 then show ?thesis by simp next case (Suc k) show ?thesis proof (rule ccontr) assume "\ ?thesis" then have "n < m" by simp with assms Suc show False by (simp add: power2_eq_square) qed qed lemma ex_power_ivl1: fixes b k :: nat assumes "b \ 2" shows "k \ 1 \ \n. b^n \ k \ k < b^(n+1)" (is "_ \ \n. ?P k n") proof(induction k) case 0 thus ?case by simp next case (Suc k) show ?case proof cases assume "k=0" hence "?P (Suc k) 0" using assms by simp thus ?case .. next assume "k\0" with Suc obtain n where IH: "?P k n" by auto show ?case proof (cases "k = b^(n+1) - 1") case True hence "?P (Suc k) (n+1)" using assms by (simp add: power_less_power_Suc) thus ?thesis .. next case False hence "?P (Suc k) n" using IH by auto thus ?thesis .. qed qed qed lemma ex_power_ivl2: fixes b k :: nat assumes "b \ 2" "k \ 2" shows "\n. b^n < k \ k \ b^(n+1)" proof - have "1 \ k - 1" using assms(2) by arith from ex_power_ivl1[OF assms(1) this] obtain n where "b ^ n \ k - 1 \ k - 1 < b ^ (n + 1)" .. hence "b^n < k \ k \ b^(n+1)" using assms by auto thus ?thesis .. qed subsubsection \Cardinality of the Powerset\ lemma card_UNIV_bool [simp]: "card (UNIV :: bool set) = 2" unfolding UNIV_bool by simp lemma card_Pow: "finite A \ card (Pow A) = 2 ^ card A" proof (induct rule: finite_induct) case empty show ?case by simp next case (insert x A) from \x \ A\ have disjoint: "Pow A \ insert x ` Pow A = {}" by blast from \x \ A\ have inj_on: "inj_on (insert x) (Pow A)" unfolding inj_on_def by auto have "card (Pow (insert x A)) = card (Pow A \ insert x ` Pow A)" by (simp only: Pow_insert) also have "\ = card (Pow A) + card (insert x ` Pow A)" by (rule card_Un_disjoint) (use \finite A\ disjoint in simp_all) also from inj_on have "card (insert x ` Pow A) = card (Pow A)" by (rule card_image) also have "\ + \ = 2 * \" by (simp add: mult_2) also from insert(3) have "\ = 2 ^ Suc (card A)" by simp also from insert(1,2) have "Suc (card A) = card (insert x A)" by (rule card_insert_disjoint [symmetric]) finally show ?case . qed subsection \Code generator tweak\ code_identifier code_module Power \ (SML) Arith and (OCaml) Arith and (Haskell) Arith end diff --git a/src/HOL/Real_Vector_Spaces.thy b/src/HOL/Real_Vector_Spaces.thy --- a/src/HOL/Real_Vector_Spaces.thy +++ b/src/HOL/Real_Vector_Spaces.thy @@ -1,2399 +1,2401 @@ (* Title: HOL/Real_Vector_Spaces.thy Author: Brian Huffman Author: Johannes Hölzl *) section \Vector Spaces and Algebras over the Reals\ theory Real_Vector_Spaces imports Real Topological_Spaces Vector_Spaces begin subsection \Real vector spaces\ class scaleR = fixes scaleR :: "real \ 'a \ 'a" (infixr "*\<^sub>R" 75) begin abbreviation divideR :: "'a \ real \ 'a" (infixl "'/\<^sub>R" 70) where "x /\<^sub>R r \ inverse r *\<^sub>R x" end class real_vector = scaleR + ab_group_add + assumes scaleR_add_right: "a *\<^sub>R (x + y) = a *\<^sub>R x + a *\<^sub>R y" and scaleR_add_left: "(a + b) *\<^sub>R x = a *\<^sub>R x + b *\<^sub>R x" and scaleR_scaleR: "a *\<^sub>R b *\<^sub>R x = (a * b) *\<^sub>R x" and scaleR_one: "1 *\<^sub>R x = x" class real_algebra = real_vector + ring + assumes mult_scaleR_left [simp]: "a *\<^sub>R x * y = a *\<^sub>R (x * y)" and mult_scaleR_right [simp]: "x * a *\<^sub>R y = a *\<^sub>R (x * y)" class real_algebra_1 = real_algebra + ring_1 class real_div_algebra = real_algebra_1 + division_ring class real_field = real_div_algebra + field instantiation real :: real_field begin definition real_scaleR_def [simp]: "scaleR a x = a * x" instance by standard (simp_all add: algebra_simps) end locale linear = Vector_Spaces.linear "scaleR::_\_\'a::real_vector" "scaleR::_\_\'b::real_vector" begin lemmas scaleR = scale end global_interpretation real_vector?: vector_space "scaleR :: real \ 'a \ 'a :: real_vector" rewrites "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear" and "Vector_Spaces.linear (*) (*\<^sub>R) = linear" defines dependent_raw_def: dependent = real_vector.dependent and representation_raw_def: representation = real_vector.representation and subspace_raw_def: subspace = real_vector.subspace and span_raw_def: span = real_vector.span and extend_basis_raw_def: extend_basis = real_vector.extend_basis and dim_raw_def: dim = real_vector.dim proof unfold_locales show "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear" "Vector_Spaces.linear (*) (*\<^sub>R) = linear" by (force simp: linear_def real_scaleR_def[abs_def])+ qed (use scaleR_add_right scaleR_add_left scaleR_scaleR scaleR_one in auto) hide_const (open)\ \locale constants\ real_vector.dependent real_vector.independent real_vector.representation real_vector.subspace real_vector.span real_vector.extend_basis real_vector.dim abbreviation "independent x \ \ dependent x" global_interpretation real_vector?: vector_space_pair "scaleR::_\_\'a::real_vector" "scaleR::_\_\'b::real_vector" rewrites "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear" and "Vector_Spaces.linear (*) (*\<^sub>R) = linear" defines construct_raw_def: construct = real_vector.construct proof unfold_locales show "Vector_Spaces.linear (*) (*\<^sub>R) = linear" unfolding linear_def real_scaleR_def by auto qed (auto simp: linear_def) hide_const (open)\ \locale constants\ real_vector.construct lemma linear_compose: "linear f \ linear g \ linear (g \ f)" unfolding linear_def by (rule Vector_Spaces.linear_compose) text \Recover original theorem names\ lemmas scaleR_left_commute = real_vector.scale_left_commute lemmas scaleR_zero_left = real_vector.scale_zero_left lemmas scaleR_minus_left = real_vector.scale_minus_left lemmas scaleR_diff_left = real_vector.scale_left_diff_distrib lemmas scaleR_sum_left = real_vector.scale_sum_left lemmas scaleR_zero_right = real_vector.scale_zero_right lemmas scaleR_minus_right = real_vector.scale_minus_right lemmas scaleR_diff_right = real_vector.scale_right_diff_distrib lemmas scaleR_sum_right = real_vector.scale_sum_right lemmas scaleR_eq_0_iff = real_vector.scale_eq_0_iff lemmas scaleR_left_imp_eq = real_vector.scale_left_imp_eq lemmas scaleR_right_imp_eq = real_vector.scale_right_imp_eq lemmas scaleR_cancel_left = real_vector.scale_cancel_left lemmas scaleR_cancel_right = real_vector.scale_cancel_right lemma [field_simps]: "c \ 0 \ a = b /\<^sub>R c \ c *\<^sub>R a = b" "c \ 0 \ b /\<^sub>R c = a \ b = c *\<^sub>R a" "c \ 0 \ a + b /\<^sub>R c = (c *\<^sub>R a + b) /\<^sub>R c" "c \ 0 \ a /\<^sub>R c + b = (a + c *\<^sub>R b) /\<^sub>R c" "c \ 0 \ a - b /\<^sub>R c = (c *\<^sub>R a - b) /\<^sub>R c" "c \ 0 \ a /\<^sub>R c - b = (a - c *\<^sub>R b) /\<^sub>R c" "c \ 0 \ - (a /\<^sub>R c) + b = (- a + c *\<^sub>R b) /\<^sub>R c" "c \ 0 \ - (a /\<^sub>R c) - b = (- a - c *\<^sub>R b) /\<^sub>R c" for a b :: "'a :: real_vector" by (auto simp add: scaleR_add_right scaleR_add_left scaleR_diff_right scaleR_diff_left) text \Legacy names\ lemmas scaleR_left_distrib = scaleR_add_left lemmas scaleR_right_distrib = scaleR_add_right lemmas scaleR_left_diff_distrib = scaleR_diff_left lemmas scaleR_right_diff_distrib = scaleR_diff_right lemmas linear_injective_0 = linear_inj_iff_eq_0 and linear_injective_on_subspace_0 = linear_inj_on_iff_eq_0 and linear_cmul = linear_scale and linear_scaleR = linear_scale_self and subspace_mul = subspace_scale and span_linear_image = linear_span_image and span_0 = span_zero and span_mul = span_scale and injective_scaleR = injective_scale lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x" for x :: "'a::real_vector" using scaleR_minus_left [of 1 x] by simp lemma scaleR_2: fixes x :: "'a::real_vector" shows "scaleR 2 x = x + x" unfolding one_add_one [symmetric] scaleR_left_distrib by simp lemma scaleR_half_double [simp]: fixes a :: "'a::real_vector" shows "(1 / 2) *\<^sub>R (a + a) = a" proof - have "\r. r *\<^sub>R (a + a) = (r * 2) *\<^sub>R a" by (metis scaleR_2 scaleR_scaleR) then show ?thesis by simp qed lemma linear_scale_real: fixes r::real shows "linear f \ f (r * b) = r * f b" using linear_scale by fastforce interpretation scaleR_left: additive "(\a. scaleR a x :: 'a::real_vector)" by standard (rule scaleR_left_distrib) interpretation scaleR_right: additive "(\x. scaleR a x :: 'a::real_vector)" by standard (rule scaleR_right_distrib) lemma nonzero_inverse_scaleR_distrib: "a \ 0 \ x \ 0 \ inverse (scaleR a x) = scaleR (inverse a) (inverse x)" for x :: "'a::real_div_algebra" by (rule inverse_unique) simp lemma inverse_scaleR_distrib: "inverse (scaleR a x) = scaleR (inverse a) (inverse x)" for x :: "'a::{real_div_algebra,division_ring}" by (metis inverse_zero nonzero_inverse_scaleR_distrib scale_eq_0_iff) lemmas sum_constant_scaleR = real_vector.sum_constant_scale\ \legacy name\ named_theorems vector_add_divide_simps "to simplify sums of scaled vectors" lemma [vector_add_divide_simps]: "v + (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)" "a *\<^sub>R v + (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)" "(a / z) *\<^sub>R v + w = (if z = 0 then w else (a *\<^sub>R v + z *\<^sub>R w) /\<^sub>R z)" "(a / z) *\<^sub>R v + b *\<^sub>R w = (if z = 0 then b *\<^sub>R w else (a *\<^sub>R v + (b * z) *\<^sub>R w) /\<^sub>R z)" "v - (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)" "a *\<^sub>R v - (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)" "(a / z) *\<^sub>R v - w = (if z = 0 then -w else (a *\<^sub>R v - z *\<^sub>R w) /\<^sub>R z)" "(a / z) *\<^sub>R v - b *\<^sub>R w = (if z = 0 then -b *\<^sub>R w else (a *\<^sub>R v - (b * z) *\<^sub>R w) /\<^sub>R z)" for v :: "'a :: real_vector" by (simp_all add: divide_inverse_commute scaleR_add_right scaleR_diff_right) lemma eq_vector_fraction_iff [vector_add_divide_simps]: fixes x :: "'a :: real_vector" shows "(x = (u / v) *\<^sub>R a) \ (if v=0 then x = 0 else v *\<^sub>R x = u *\<^sub>R a)" by auto (metis (no_types) divide_eq_1_iff divide_inverse_commute scaleR_one scaleR_scaleR) lemma vector_fraction_eq_iff [vector_add_divide_simps]: fixes x :: "'a :: real_vector" shows "((u / v) *\<^sub>R a = x) \ (if v=0 then x = 0 else u *\<^sub>R a = v *\<^sub>R x)" by (metis eq_vector_fraction_iff) lemma real_vector_affinity_eq: fixes x :: "'a :: real_vector" assumes m0: "m \ 0" shows "m *\<^sub>R x + c = y \ x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)" (is "?lhs \ ?rhs") proof assume ?lhs then have "m *\<^sub>R x = y - c" by (simp add: field_simps) then have "inverse m *\<^sub>R (m *\<^sub>R x) = inverse m *\<^sub>R (y - c)" by simp then show "x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)" using m0 by (simp add: scaleR_diff_right) next assume ?rhs with m0 show "m *\<^sub>R x + c = y" by (simp add: scaleR_diff_right) qed lemma real_vector_eq_affinity: "m \ 0 \ y = m *\<^sub>R x + c \ inverse m *\<^sub>R y - (inverse m *\<^sub>R c) = x" for x :: "'a::real_vector" using real_vector_affinity_eq[where m=m and x=x and y=y and c=c] by metis lemma scaleR_eq_iff [simp]: "b + u *\<^sub>R a = a + u *\<^sub>R b \ a = b \ u = 1" for a :: "'a::real_vector" proof (cases "u = 1") case True then show ?thesis by auto next case False have "a = b" if "b + u *\<^sub>R a = a + u *\<^sub>R b" proof - from that have "(u - 1) *\<^sub>R a = (u - 1) *\<^sub>R b" by (simp add: algebra_simps) with False show ?thesis by auto qed then show ?thesis by auto qed lemma scaleR_collapse [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R a = a" for a :: "'a::real_vector" by (simp add: algebra_simps) subsection \Embedding of the Reals into any \real_algebra_1\: \of_real\\ definition of_real :: "real \ 'a::real_algebra_1" where "of_real r = scaleR r 1" lemma scaleR_conv_of_real: "scaleR r x = of_real r * x" by (simp add: of_real_def) lemma of_real_0 [simp]: "of_real 0 = 0" by (simp add: of_real_def) lemma of_real_1 [simp]: "of_real 1 = 1" by (simp add: of_real_def) lemma of_real_add [simp]: "of_real (x + y) = of_real x + of_real y" by (simp add: of_real_def scaleR_left_distrib) lemma of_real_minus [simp]: "of_real (- x) = - of_real x" by (simp add: of_real_def) lemma of_real_diff [simp]: "of_real (x - y) = of_real x - of_real y" by (simp add: of_real_def scaleR_left_diff_distrib) lemma of_real_mult [simp]: "of_real (x * y) = of_real x * of_real y" by (simp add: of_real_def) lemma of_real_sum[simp]: "of_real (sum f s) = (\x\s. of_real (f x))" by (induct s rule: infinite_finite_induct) auto lemma of_real_prod[simp]: "of_real (prod f s) = (\x\s. of_real (f x))" by (induct s rule: infinite_finite_induct) auto lemma nonzero_of_real_inverse: "x \ 0 \ of_real (inverse x) = inverse (of_real x :: 'a::real_div_algebra)" by (simp add: of_real_def nonzero_inverse_scaleR_distrib) lemma of_real_inverse [simp]: "of_real (inverse x) = inverse (of_real x :: 'a::{real_div_algebra,division_ring})" by (simp add: of_real_def inverse_scaleR_distrib) lemma nonzero_of_real_divide: "y \ 0 \ of_real (x / y) = (of_real x / of_real y :: 'a::real_field)" by (simp add: divide_inverse nonzero_of_real_inverse) lemma of_real_divide [simp]: "of_real (x / y) = (of_real x / of_real y :: 'a::real_div_algebra)" by (simp add: divide_inverse) lemma of_real_power [simp]: "of_real (x ^ n) = (of_real x :: 'a::{real_algebra_1}) ^ n" by (induct n) simp_all lemma of_real_power_int [simp]: "of_real (power_int x n) = power_int (of_real x :: 'a :: {real_div_algebra,division_ring}) n" by (auto simp: power_int_def) lemma of_real_eq_iff [simp]: "of_real x = of_real y \ x = y" by (simp add: of_real_def) lemma inj_of_real: "inj of_real" by (auto intro: injI) lemmas of_real_eq_0_iff [simp] = of_real_eq_iff [of _ 0, simplified] lemmas of_real_eq_1_iff [simp] = of_real_eq_iff [of _ 1, simplified] lemma minus_of_real_eq_of_real_iff [simp]: "-of_real x = of_real y \ -x = y" using of_real_eq_iff[of "-x" y] by (simp only: of_real_minus) lemma of_real_eq_minus_of_real_iff [simp]: "of_real x = -of_real y \ x = -y" using of_real_eq_iff[of x "-y"] by (simp only: of_real_minus) lemma of_real_eq_id [simp]: "of_real = (id :: real \ real)" by (rule ext) (simp add: of_real_def) text \Collapse nested embeddings.\ lemma of_real_of_nat_eq [simp]: "of_real (of_nat n) = of_nat n" by (induct n) auto lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z" by (cases z rule: int_diff_cases) simp lemma of_real_numeral [simp]: "of_real (numeral w) = numeral w" using of_real_of_int_eq [of "numeral w"] by simp lemma of_real_neg_numeral [simp]: "of_real (- numeral w) = - numeral w" using of_real_of_int_eq [of "- numeral w"] by simp lemma numeral_power_int_eq_of_real_cancel_iff [simp]: "power_int (numeral x) n = (of_real y :: 'a :: {real_div_algebra, division_ring}) \ power_int (numeral x) n = y" proof - have "power_int (numeral x) n = (of_real (power_int (numeral x) n) :: 'a)" by simp also have "\ = of_real y \ power_int (numeral x) n = y" by (subst of_real_eq_iff) auto finally show ?thesis . qed lemma of_real_eq_numeral_power_int_cancel_iff [simp]: "(of_real y :: 'a :: {real_div_algebra, division_ring}) = power_int (numeral x) n \ y = power_int (numeral x) n" by (subst (1 2) eq_commute) simp lemma of_real_eq_of_real_power_int_cancel_iff [simp]: "power_int (of_real b :: 'a :: {real_div_algebra, division_ring}) w = of_real x \ power_int b w = x" by (metis of_real_power_int of_real_eq_iff) lemma of_real_in_Ints_iff [simp]: "of_real x \ \ \ x \ \" proof safe fix x assume "(of_real x :: 'a) \ \" then obtain n where "(of_real x :: 'a) = of_int n" by (auto simp: Ints_def) also have "of_int n = of_real (real_of_int n)" by simp finally have "x = real_of_int n" by (subst (asm) of_real_eq_iff) thus "x \ \" by auto qed (auto simp: Ints_def) lemma Ints_of_real [intro]: "x \ \ \ of_real x \ \" by simp text \Every real algebra has characteristic zero.\ instance real_algebra_1 < ring_char_0 proof from inj_of_real inj_of_nat have "inj (of_real \ of_nat)" by (rule inj_compose) then show "inj (of_nat :: nat \ 'a)" by (simp add: comp_def) qed lemma fraction_scaleR_times [simp]: fixes a :: "'a::real_algebra_1" shows "(numeral u / numeral v) *\<^sub>R (numeral w * a) = (numeral u * numeral w / numeral v) *\<^sub>R a" by (metis (no_types, lifting) of_real_numeral scaleR_conv_of_real scaleR_scaleR times_divide_eq_left) lemma inverse_scaleR_times [simp]: fixes a :: "'a::real_algebra_1" shows "(1 / numeral v) *\<^sub>R (numeral w * a) = (numeral w / numeral v) *\<^sub>R a" by (metis divide_inverse_commute inverse_eq_divide of_real_numeral scaleR_conv_of_real scaleR_scaleR) lemma scaleR_times [simp]: fixes a :: "'a::real_algebra_1" shows "(numeral u) *\<^sub>R (numeral w * a) = (numeral u * numeral w) *\<^sub>R a" by (simp add: scaleR_conv_of_real) instance real_field < field_char_0 .. subsection \The Set of Real Numbers\ definition Reals :: "'a::real_algebra_1 set" ("\") where "\ = range of_real" lemma Reals_of_real [simp]: "of_real r \ \" by (simp add: Reals_def) lemma Reals_of_int [simp]: "of_int z \ \" by (subst of_real_of_int_eq [symmetric], rule Reals_of_real) lemma Reals_of_nat [simp]: "of_nat n \ \" by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real) lemma Reals_numeral [simp]: "numeral w \ \" by (subst of_real_numeral [symmetric], rule Reals_of_real) lemma Reals_0 [simp]: "0 \ \" and Reals_1 [simp]: "1 \ \" by (simp_all add: Reals_def) lemma Reals_add [simp]: "a \ \ \ b \ \ \ a + b \ \" by (metis (no_types, hide_lams) Reals_def Reals_of_real imageE of_real_add) lemma Reals_minus [simp]: "a \ \ \ - a \ \" by (auto simp: Reals_def) lemma Reals_minus_iff [simp]: "- a \ \ \ a \ \" using Reals_minus by fastforce lemma Reals_diff [simp]: "a \ \ \ b \ \ \ a - b \ \" by (metis Reals_add Reals_minus_iff add_uminus_conv_diff) lemma Reals_mult [simp]: "a \ \ \ b \ \ \ a * b \ \" by (metis (no_types, lifting) Reals_def Reals_of_real imageE of_real_mult) lemma nonzero_Reals_inverse: "a \ \ \ a \ 0 \ inverse a \ \" for a :: "'a::real_div_algebra" by (metis Reals_def Reals_of_real imageE of_real_inverse) lemma Reals_inverse: "a \ \ \ inverse a \ \" for a :: "'a::{real_div_algebra,division_ring}" using nonzero_Reals_inverse by fastforce lemma Reals_inverse_iff [simp]: "inverse x \ \ \ x \ \" for x :: "'a::{real_div_algebra,division_ring}" by (metis Reals_inverse inverse_inverse_eq) lemma nonzero_Reals_divide: "a \ \ \ b \ \ \ b \ 0 \ a / b \ \" for a b :: "'a::real_field" by (simp add: divide_inverse) lemma Reals_divide [simp]: "a \ \ \ b \ \ \ a / b \ \" for a b :: "'a::{real_field,field}" using nonzero_Reals_divide by fastforce lemma Reals_power [simp]: "a \ \ \ a ^ n \ \" for a :: "'a::real_algebra_1" by (metis Reals_def Reals_of_real imageE of_real_power) lemma Reals_cases [cases set: Reals]: assumes "q \ \" obtains (of_real) r where "q = of_real r" unfolding Reals_def proof - from \q \ \\ have "q \ range of_real" unfolding Reals_def . then obtain r where "q = of_real r" .. then show thesis .. qed lemma sum_in_Reals [intro,simp]: "(\i. i \ s \ f i \ \) \ sum f s \ \" proof (induct s rule: infinite_finite_induct) case infinite then show ?case by (metis Reals_0 sum.infinite) qed simp_all lemma prod_in_Reals [intro,simp]: "(\i. i \ s \ f i \ \) \ prod f s \ \" proof (induct s rule: infinite_finite_induct) case infinite then show ?case by (metis Reals_1 prod.infinite) qed simp_all lemma Reals_induct [case_names of_real, induct set: Reals]: "q \ \ \ (\r. P (of_real r)) \ P q" by (rule Reals_cases) auto subsection \Ordered real vector spaces\ class ordered_real_vector = real_vector + ordered_ab_group_add + assumes scaleR_left_mono: "x \ y \ 0 \ a \ a *\<^sub>R x \ a *\<^sub>R y" and scaleR_right_mono: "a \ b \ 0 \ x \ a *\<^sub>R x \ b *\<^sub>R x" begin lemma scaleR_mono: "a \ b \ x \ y \ 0 \ b \ 0 \ x \ a *\<^sub>R x \ b *\<^sub>R y" by (meson order_trans scaleR_left_mono scaleR_right_mono) lemma scaleR_mono': "a \ b \ c \ d \ 0 \ a \ 0 \ c \ a *\<^sub>R c \ b *\<^sub>R d" by (rule scaleR_mono) (auto intro: order.trans) lemma pos_le_divideR_eq [field_simps]: "a \ b /\<^sub>R c \ c *\<^sub>R a \ b" (is "?P \ ?Q") if "0 < c" proof assume ?P with scaleR_left_mono that have "c *\<^sub>R a \ c *\<^sub>R (b /\<^sub>R c)" by simp with that show ?Q by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide) next assume ?Q with scaleR_left_mono that have "c *\<^sub>R a /\<^sub>R c \ b /\<^sub>R c" by simp with that show ?P by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide) qed lemma pos_less_divideR_eq [field_simps]: "a < b /\<^sub>R c \ c *\<^sub>R a < b" if "c > 0" using that pos_le_divideR_eq [of c a b] by (auto simp add: le_less scaleR_scaleR scaleR_one) lemma pos_divideR_le_eq [field_simps]: "b /\<^sub>R c \ a \ b \ c *\<^sub>R a" if "c > 0" using that pos_le_divideR_eq [of "inverse c" b a] by simp lemma pos_divideR_less_eq [field_simps]: "b /\<^sub>R c < a \ b < c *\<^sub>R a" if "c > 0" using that pos_less_divideR_eq [of "inverse c" b a] by simp lemma pos_le_minus_divideR_eq [field_simps]: "a \ - (b /\<^sub>R c) \ c *\<^sub>R a \ - b" if "c > 0" using that by (metis add_minus_cancel diff_0 left_minus minus_minus neg_le_iff_le scaleR_add_right uminus_add_conv_diff pos_le_divideR_eq) lemma pos_less_minus_divideR_eq [field_simps]: "a < - (b /\<^sub>R c) \ c *\<^sub>R a < - b" if "c > 0" using that by (metis le_less less_le_not_le pos_divideR_le_eq pos_divideR_less_eq pos_le_minus_divideR_eq) lemma pos_minus_divideR_le_eq [field_simps]: "- (b /\<^sub>R c) \ a \ - b \ c *\<^sub>R a" if "c > 0" using that by (metis pos_divideR_le_eq pos_le_minus_divideR_eq that inverse_positive_iff_positive le_imp_neg_le minus_minus) lemma pos_minus_divideR_less_eq [field_simps]: "- (b /\<^sub>R c) < a \ - b < c *\<^sub>R a" if "c > 0" using that by (simp add: less_le_not_le pos_le_minus_divideR_eq pos_minus_divideR_le_eq) lemma scaleR_image_atLeastAtMost: "c > 0 \ scaleR c ` {x..y} = {c *\<^sub>R x..c *\<^sub>R y}" apply (auto intro!: scaleR_left_mono simp: image_iff Bex_def) - by (meson local.eq_iff pos_divideR_le_eq pos_le_divideR_eq) + using pos_divideR_le_eq [of c] pos_le_divideR_eq [of c] + apply (meson local.order_eq_iff) + done end lemma neg_le_divideR_eq [field_simps]: "a \ b /\<^sub>R c \ b \ c *\<^sub>R a" (is "?P \ ?Q") if "c < 0" for a b :: "'a :: ordered_real_vector" using that pos_le_divideR_eq [of "- c" a "- b"] by simp lemma neg_less_divideR_eq [field_simps]: "a < b /\<^sub>R c \ b < c *\<^sub>R a" if "c < 0" for a b :: "'a :: ordered_real_vector" using that neg_le_divideR_eq [of c a b] by (auto simp add: le_less) lemma neg_divideR_le_eq [field_simps]: "b /\<^sub>R c \ a \ c *\<^sub>R a \ b" if "c < 0" for a b :: "'a :: ordered_real_vector" using that pos_divideR_le_eq [of "- c" "- b" a] by simp lemma neg_divideR_less_eq [field_simps]: "b /\<^sub>R c < a \ c *\<^sub>R a < b" if "c < 0" for a b :: "'a :: ordered_real_vector" using that neg_divideR_le_eq [of c b a] by (auto simp add: le_less) lemma neg_le_minus_divideR_eq [field_simps]: "a \ - (b /\<^sub>R c) \ - b \ c *\<^sub>R a" if "c < 0" for a b :: "'a :: ordered_real_vector" using that pos_le_minus_divideR_eq [of "- c" a "- b"] by (simp add: minus_le_iff) lemma neg_less_minus_divideR_eq [field_simps]: "a < - (b /\<^sub>R c) \ - b < c *\<^sub>R a" if "c < 0" for a b :: "'a :: ordered_real_vector" proof - have *: "- b = c *\<^sub>R a \ b = - (c *\<^sub>R a)" by (metis add.inverse_inverse) from that neg_le_minus_divideR_eq [of c a b] show ?thesis by (auto simp add: le_less *) qed lemma neg_minus_divideR_le_eq [field_simps]: "- (b /\<^sub>R c) \ a \ c *\<^sub>R a \ - b" if "c < 0" for a b :: "'a :: ordered_real_vector" using that pos_minus_divideR_le_eq [of "- c" "- b" a] by (simp add: le_minus_iff) lemma neg_minus_divideR_less_eq [field_simps]: "- (b /\<^sub>R c) < a \ c *\<^sub>R a < - b" if "c < 0" for a b :: "'a :: ordered_real_vector" using that by (simp add: less_le_not_le neg_le_minus_divideR_eq neg_minus_divideR_le_eq) lemma [field_split_simps]: "a = b /\<^sub>R c \ (if c = 0 then a = 0 else c *\<^sub>R a = b)" "b /\<^sub>R c = a \ (if c = 0 then a = 0 else b = c *\<^sub>R a)" "a + b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a + b) /\<^sub>R c)" "a /\<^sub>R c + b = (if c = 0 then b else (a + c *\<^sub>R b) /\<^sub>R c)" "a - b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a - b) /\<^sub>R c)" "a /\<^sub>R c - b = (if c = 0 then - b else (a - c *\<^sub>R b) /\<^sub>R c)" "- (a /\<^sub>R c) + b = (if c = 0 then b else (- a + c *\<^sub>R b) /\<^sub>R c)" "- (a /\<^sub>R c) - b = (if c = 0 then - b else (- a - c *\<^sub>R b) /\<^sub>R c)" for a b :: "'a :: real_vector" by (auto simp add: field_simps) lemma [field_split_simps]: "0 < c \ a \ b /\<^sub>R c \ (if c > 0 then c *\<^sub>R a \ b else if c < 0 then b \ c *\<^sub>R a else a \ 0)" "0 < c \ a < b /\<^sub>R c \ (if c > 0 then c *\<^sub>R a < b else if c < 0 then b < c *\<^sub>R a else a < 0)" "0 < c \ b /\<^sub>R c \ a \ (if c > 0 then b \ c *\<^sub>R a else if c < 0 then c *\<^sub>R a \ b else a \ 0)" "0 < c \ b /\<^sub>R c < a \ (if c > 0 then b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < b else a > 0)" "0 < c \ a \ - (b /\<^sub>R c) \ (if c > 0 then c *\<^sub>R a \ - b else if c < 0 then - b \ c *\<^sub>R a else a \ 0)" "0 < c \ a < - (b /\<^sub>R c) \ (if c > 0 then c *\<^sub>R a < - b else if c < 0 then - b < c *\<^sub>R a else a < 0)" "0 < c \ - (b /\<^sub>R c) \ a \ (if c > 0 then - b \ c *\<^sub>R a else if c < 0 then c *\<^sub>R a \ - b else a \ 0)" "0 < c \ - (b /\<^sub>R c) < a \ (if c > 0 then - b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < - b else a > 0)" for a b :: "'a :: ordered_real_vector" by (clarsimp intro!: field_simps)+ lemma scaleR_nonneg_nonneg: "0 \ a \ 0 \ x \ 0 \ a *\<^sub>R x" for x :: "'a::ordered_real_vector" using scaleR_left_mono [of 0 x a] by simp lemma scaleR_nonneg_nonpos: "0 \ a \ x \ 0 \ a *\<^sub>R x \ 0" for x :: "'a::ordered_real_vector" using scaleR_left_mono [of x 0 a] by simp lemma scaleR_nonpos_nonneg: "a \ 0 \ 0 \ x \ a *\<^sub>R x \ 0" for x :: "'a::ordered_real_vector" using scaleR_right_mono [of a 0 x] by simp lemma split_scaleR_neg_le: "(0 \ a \ x \ 0) \ (a \ 0 \ 0 \ x) \ a *\<^sub>R x \ 0" for x :: "'a::ordered_real_vector" by (auto simp: scaleR_nonneg_nonpos scaleR_nonpos_nonneg) lemma le_add_iff1: "a *\<^sub>R e + c \ b *\<^sub>R e + d \ (a - b) *\<^sub>R e + c \ d" for c d e :: "'a::ordered_real_vector" by (simp add: algebra_simps) lemma le_add_iff2: "a *\<^sub>R e + c \ b *\<^sub>R e + d \ c \ (b - a) *\<^sub>R e + d" for c d e :: "'a::ordered_real_vector" by (simp add: algebra_simps) lemma scaleR_left_mono_neg: "b \ a \ c \ 0 \ c *\<^sub>R a \ c *\<^sub>R b" for a b :: "'a::ordered_real_vector" by (drule scaleR_left_mono [of _ _ "- c"], simp_all) lemma scaleR_right_mono_neg: "b \ a \ c \ 0 \ a *\<^sub>R c \ b *\<^sub>R c" for c :: "'a::ordered_real_vector" by (drule scaleR_right_mono [of _ _ "- c"], simp_all) lemma scaleR_nonpos_nonpos: "a \ 0 \ b \ 0 \ 0 \ a *\<^sub>R b" for b :: "'a::ordered_real_vector" using scaleR_right_mono_neg [of a 0 b] by simp lemma split_scaleR_pos_le: "(0 \ a \ 0 \ b) \ (a \ 0 \ b \ 0) \ 0 \ a *\<^sub>R b" for b :: "'a::ordered_real_vector" by (auto simp: scaleR_nonneg_nonneg scaleR_nonpos_nonpos) lemma zero_le_scaleR_iff: fixes b :: "'a::ordered_real_vector" shows "0 \ a *\<^sub>R b \ 0 < a \ 0 \ b \ a < 0 \ b \ 0 \ a = 0" (is "?lhs = ?rhs") proof (cases "a = 0") case True then show ?thesis by simp next case False show ?thesis proof assume ?lhs from \a \ 0\ consider "a > 0" | "a < 0" by arith then show ?rhs proof cases case 1 with \?lhs\ have "inverse a *\<^sub>R 0 \ inverse a *\<^sub>R (a *\<^sub>R b)" by (intro scaleR_mono) auto with 1 show ?thesis by simp next case 2 with \?lhs\ have "- inverse a *\<^sub>R 0 \ - inverse a *\<^sub>R (a *\<^sub>R b)" by (intro scaleR_mono) auto with 2 show ?thesis by simp qed next assume ?rhs then show ?lhs by (auto simp: not_le \a \ 0\ intro!: split_scaleR_pos_le) qed qed lemma scaleR_le_0_iff: "a *\<^sub>R b \ 0 \ 0 < a \ b \ 0 \ a < 0 \ 0 \ b \ a = 0" for b::"'a::ordered_real_vector" by (insert zero_le_scaleR_iff [of "-a" b]) force lemma scaleR_le_cancel_left: "c *\<^sub>R a \ c *\<^sub>R b \ (0 < c \ a \ b) \ (c < 0 \ b \ a)" for b :: "'a::ordered_real_vector" by (auto simp: neq_iff scaleR_left_mono scaleR_left_mono_neg dest: scaleR_left_mono[where a="inverse c"] scaleR_left_mono_neg[where c="inverse c"]) lemma scaleR_le_cancel_left_pos: "0 < c \ c *\<^sub>R a \ c *\<^sub>R b \ a \ b" for b :: "'a::ordered_real_vector" by (auto simp: scaleR_le_cancel_left) lemma scaleR_le_cancel_left_neg: "c < 0 \ c *\<^sub>R a \ c *\<^sub>R b \ b \ a" for b :: "'a::ordered_real_vector" by (auto simp: scaleR_le_cancel_left) lemma scaleR_left_le_one_le: "0 \ x \ a \ 1 \ a *\<^sub>R x \ x" for x :: "'a::ordered_real_vector" and a :: real using scaleR_right_mono[of a 1 x] by simp subsection \Real normed vector spaces\ class dist = fixes dist :: "'a \ 'a \ real" class norm = fixes norm :: "'a \ real" class sgn_div_norm = scaleR + norm + sgn + assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x" class dist_norm = dist + norm + minus + assumes dist_norm: "dist x y = norm (x - y)" class uniformity_dist = dist + uniformity + assumes uniformity_dist: "uniformity = (INF e\{0 <..}. principal {(x, y). dist x y < e})" begin lemma eventually_uniformity_metric: "eventually P uniformity \ (\e>0. \x y. dist x y < e \ P (x, y))" unfolding uniformity_dist by (subst eventually_INF_base) (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"]) end class real_normed_vector = real_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity + assumes norm_eq_zero [simp]: "norm x = 0 \ x = 0" and norm_triangle_ineq: "norm (x + y) \ norm x + norm y" and norm_scaleR [simp]: "norm (scaleR a x) = \a\ * norm x" begin lemma norm_ge_zero [simp]: "0 \ norm x" proof - have "0 = norm (x + -1 *\<^sub>R x)" using scaleR_add_left[of 1 "-1" x] norm_scaleR[of 0 x] by (simp add: scaleR_one) also have "\ \ norm x + norm (-1 *\<^sub>R x)" by (rule norm_triangle_ineq) finally show ?thesis by simp qed end class real_normed_algebra = real_algebra + real_normed_vector + assumes norm_mult_ineq: "norm (x * y) \ norm x * norm y" class real_normed_algebra_1 = real_algebra_1 + real_normed_algebra + assumes norm_one [simp]: "norm 1 = 1" lemma (in real_normed_algebra_1) scaleR_power [simp]: "(scaleR x y) ^ n = scaleR (x^n) (y^n)" by (induct n) (simp_all add: scaleR_one scaleR_scaleR mult_ac) class real_normed_div_algebra = real_div_algebra + real_normed_vector + assumes norm_mult: "norm (x * y) = norm x * norm y" class real_normed_field = real_field + real_normed_div_algebra instance real_normed_div_algebra < real_normed_algebra_1 proof show "norm (x * y) \ norm x * norm y" for x y :: 'a by (simp add: norm_mult) next have "norm (1 * 1::'a) = norm (1::'a) * norm (1::'a)" by (rule norm_mult) then show "norm (1::'a) = 1" by simp qed context real_normed_vector begin lemma norm_zero [simp]: "norm (0::'a) = 0" by simp lemma zero_less_norm_iff [simp]: "norm x > 0 \ x \ 0" by (simp add: order_less_le) lemma norm_not_less_zero [simp]: "\ norm x < 0" by (simp add: linorder_not_less) lemma norm_le_zero_iff [simp]: "norm x \ 0 \ x = 0" by (simp add: order_le_less) lemma norm_minus_cancel [simp]: "norm (- x) = norm x" proof - have "- 1 *\<^sub>R x = - (1 *\<^sub>R x)" unfolding add_eq_0_iff2[symmetric] scaleR_add_left[symmetric] using norm_eq_zero by fastforce then have "norm (- x) = norm (scaleR (- 1) x)" by (simp only: scaleR_one) also have "\ = \- 1\ * norm x" by (rule norm_scaleR) finally show ?thesis by simp qed lemma norm_minus_commute: "norm (a - b) = norm (b - a)" proof - have "norm (- (b - a)) = norm (b - a)" by (rule norm_minus_cancel) then show ?thesis by simp qed lemma dist_add_cancel [simp]: "dist (a + b) (a + c) = dist b c" by (simp add: dist_norm) lemma dist_add_cancel2 [simp]: "dist (b + a) (c + a) = dist b c" by (simp add: dist_norm) lemma norm_uminus_minus: "norm (- x - y) = norm (x + y)" by (subst (2) norm_minus_cancel[symmetric], subst minus_add_distrib) simp lemma norm_triangle_ineq2: "norm a - norm b \ norm (a - b)" proof - have "norm (a - b + b) \ norm (a - b) + norm b" by (rule norm_triangle_ineq) then show ?thesis by simp qed lemma norm_triangle_ineq3: "\norm a - norm b\ \ norm (a - b)" proof - have "norm a - norm b \ norm (a - b)" by (simp add: norm_triangle_ineq2) moreover have "norm b - norm a \ norm (a - b)" by (metis norm_minus_commute norm_triangle_ineq2) ultimately show ?thesis by (simp add: abs_le_iff) qed lemma norm_triangle_ineq4: "norm (a - b) \ norm a + norm b" proof - have "norm (a + - b) \ norm a + norm (- b)" by (rule norm_triangle_ineq) then show ?thesis by simp qed lemma norm_triangle_le_diff: "norm x + norm y \ e \ norm (x - y) \ e" by (meson norm_triangle_ineq4 order_trans) lemma norm_diff_ineq: "norm a - norm b \ norm (a + b)" proof - have "norm a - norm (- b) \ norm (a - - b)" by (rule norm_triangle_ineq2) then show ?thesis by simp qed lemma norm_triangle_sub: "norm x \ norm y + norm (x - y)" using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps) lemma norm_triangle_le: "norm x + norm y \ e \ norm (x + y) \ e" by (rule norm_triangle_ineq [THEN order_trans]) lemma norm_triangle_lt: "norm x + norm y < e \ norm (x + y) < e" by (rule norm_triangle_ineq [THEN le_less_trans]) lemma norm_add_leD: "norm (a + b) \ c \ norm b \ norm a + c" by (metis ab_semigroup_add_class.add.commute add_commute diff_le_eq norm_diff_ineq order_trans) lemma norm_diff_triangle_ineq: "norm ((a + b) - (c + d)) \ norm (a - c) + norm (b - d)" proof - have "norm ((a + b) - (c + d)) = norm ((a - c) + (b - d))" by (simp add: algebra_simps) also have "\ \ norm (a - c) + norm (b - d)" by (rule norm_triangle_ineq) finally show ?thesis . qed lemma norm_diff_triangle_le: "norm (x - z) \ e1 + e2" if "norm (x - y) \ e1" "norm (y - z) \ e2" proof - have "norm (x - (y + z - y)) \ norm (x - y) + norm (y - z)" using norm_diff_triangle_ineq that diff_diff_eq2 by presburger with that show ?thesis by simp qed lemma norm_diff_triangle_less: "norm (x - z) < e1 + e2" if "norm (x - y) < e1" "norm (y - z) < e2" proof - have "norm (x - z) \ norm (x - y) + norm (y - z)" by (metis norm_diff_triangle_ineq add_diff_cancel_left' diff_diff_eq2) with that show ?thesis by auto qed lemma norm_triangle_mono: "norm a \ r \ norm b \ s \ norm (a + b) \ r + s" by (metis (mono_tags) add_mono_thms_linordered_semiring(1) norm_triangle_ineq order.trans) lemma norm_sum: "norm (sum f A) \ (\i\A. norm (f i))" for f::"'b \ 'a" by (induct A rule: infinite_finite_induct) (auto intro: norm_triangle_mono) lemma sum_norm_le: "norm (sum f S) \ sum g S" if "\x. x \ S \ norm (f x) \ g x" for f::"'b \ 'a" by (rule order_trans [OF norm_sum sum_mono]) (simp add: that) lemma abs_norm_cancel [simp]: "\norm a\ = norm a" by (rule abs_of_nonneg [OF norm_ge_zero]) lemma sum_norm_bound: "norm (sum f S) \ of_nat (card S)*K" if "\x. x \ S \ norm (f x) \ K" for f :: "'b \ 'a" using sum_norm_le[OF that] sum_constant[symmetric] by simp lemma norm_add_less: "norm x < r \ norm y < s \ norm (x + y) < r + s" by (rule order_le_less_trans [OF norm_triangle_ineq add_strict_mono]) end lemma dist_scaleR [simp]: "dist (x *\<^sub>R a) (y *\<^sub>R a) = \x - y\ * norm a" for a :: "'a::real_normed_vector" by (metis dist_norm norm_scaleR scaleR_left.diff) lemma norm_mult_less: "norm x < r \ norm y < s \ norm (x * y) < r * s" for x y :: "'a::real_normed_algebra" by (rule order_le_less_trans [OF norm_mult_ineq]) (simp add: mult_strict_mono') lemma norm_of_real [simp]: "norm (of_real r :: 'a::real_normed_algebra_1) = \r\" by (simp add: of_real_def) lemma norm_numeral [simp]: "norm (numeral w::'a::real_normed_algebra_1) = numeral w" by (subst of_real_numeral [symmetric], subst norm_of_real, simp) lemma norm_neg_numeral [simp]: "norm (- numeral w::'a::real_normed_algebra_1) = numeral w" by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp) lemma norm_of_real_add1 [simp]: "norm (of_real x + 1 :: 'a :: real_normed_div_algebra) = \x + 1\" by (metis norm_of_real of_real_1 of_real_add) lemma norm_of_real_addn [simp]: "norm (of_real x + numeral b :: 'a :: real_normed_div_algebra) = \x + numeral b\" by (metis norm_of_real of_real_add of_real_numeral) lemma norm_of_int [simp]: "norm (of_int z::'a::real_normed_algebra_1) = \of_int z\" by (subst of_real_of_int_eq [symmetric], rule norm_of_real) lemma norm_of_nat [simp]: "norm (of_nat n::'a::real_normed_algebra_1) = of_nat n" by (metis abs_of_nat norm_of_real of_real_of_nat_eq) lemma nonzero_norm_inverse: "a \ 0 \ norm (inverse a) = inverse (norm a)" for a :: "'a::real_normed_div_algebra" by (metis inverse_unique norm_mult norm_one right_inverse) lemma norm_inverse: "norm (inverse a) = inverse (norm a)" for a :: "'a::{real_normed_div_algebra,division_ring}" by (metis inverse_zero nonzero_norm_inverse norm_zero) lemma nonzero_norm_divide: "b \ 0 \ norm (a / b) = norm a / norm b" for a b :: "'a::real_normed_field" by (simp add: divide_inverse norm_mult nonzero_norm_inverse) lemma norm_divide: "norm (a / b) = norm a / norm b" for a b :: "'a::{real_normed_field,field}" by (simp add: divide_inverse norm_mult norm_inverse) lemma norm_inverse_le_norm: fixes x :: "'a::real_normed_div_algebra" shows "r \ norm x \ 0 < r \ norm (inverse x) \ inverse r" by (simp add: le_imp_inverse_le norm_inverse) lemma norm_power_ineq: "norm (x ^ n) \ norm x ^ n" for x :: "'a::real_normed_algebra_1" proof (induct n) case 0 show "norm (x ^ 0) \ norm x ^ 0" by simp next case (Suc n) have "norm (x * x ^ n) \ norm x * norm (x ^ n)" by (rule norm_mult_ineq) also from Suc have "\ \ norm x * norm x ^ n" using norm_ge_zero by (rule mult_left_mono) finally show "norm (x ^ Suc n) \ norm x ^ Suc n" by simp qed lemma norm_power: "norm (x ^ n) = norm x ^ n" for x :: "'a::real_normed_div_algebra" by (induct n) (simp_all add: norm_mult) lemma norm_power_int: "norm (power_int x n) = power_int (norm x) n" for x :: "'a::real_normed_div_algebra" by (cases n rule: int_cases4) (auto simp: norm_power power_int_minus norm_inverse) lemma power_eq_imp_eq_norm: fixes w :: "'a::real_normed_div_algebra" assumes eq: "w ^ n = z ^ n" and "n > 0" shows "norm w = norm z" proof - have "norm w ^ n = norm z ^ n" by (metis (no_types) eq norm_power) then show ?thesis using assms by (force intro: power_eq_imp_eq_base) qed lemma power_eq_1_iff: fixes w :: "'a::real_normed_div_algebra" shows "w ^ n = 1 \ norm w = 1 \ n = 0" by (metis norm_one power_0_left power_eq_0_iff power_eq_imp_eq_norm power_one) lemma norm_mult_numeral1 [simp]: "norm (numeral w * a) = numeral w * norm a" for a b :: "'a::{real_normed_field,field}" by (simp add: norm_mult) lemma norm_mult_numeral2 [simp]: "norm (a * numeral w) = norm a * numeral w" for a b :: "'a::{real_normed_field,field}" by (simp add: norm_mult) lemma norm_divide_numeral [simp]: "norm (a / numeral w) = norm a / numeral w" for a b :: "'a::{real_normed_field,field}" by (simp add: norm_divide) lemma norm_of_real_diff [simp]: "norm (of_real b - of_real a :: 'a::real_normed_algebra_1) \ \b - a\" by (metis norm_of_real of_real_diff order_refl) text \Despite a superficial resemblance, \norm_eq_1\ is not relevant.\ lemma square_norm_one: fixes x :: "'a::real_normed_div_algebra" assumes "x\<^sup>2 = 1" shows "norm x = 1" by (metis assms norm_minus_cancel norm_one power2_eq_1_iff) lemma norm_less_p1: "norm x < norm (of_real (norm x) + 1 :: 'a)" for x :: "'a::real_normed_algebra_1" proof - have "norm x < norm (of_real (norm x + 1) :: 'a)" by (simp add: of_real_def) then show ?thesis by simp qed lemma prod_norm: "prod (\x. norm (f x)) A = norm (prod f A)" for f :: "'a \ 'b::{comm_semiring_1,real_normed_div_algebra}" by (induct A rule: infinite_finite_induct) (auto simp: norm_mult) lemma norm_prod_le: "norm (prod f A) \ (\a\A. norm (f a :: 'a :: {real_normed_algebra_1,comm_monoid_mult}))" proof (induct A rule: infinite_finite_induct) case empty then show ?case by simp next case (insert a A) then have "norm (prod f (insert a A)) \ norm (f a) * norm (prod f A)" by (simp add: norm_mult_ineq) also have "norm (prod f A) \ (\a\A. norm (f a))" by (rule insert) finally show ?case by (simp add: insert mult_left_mono) next case infinite then show ?case by simp qed lemma norm_prod_diff: fixes z w :: "'i \ 'a::{real_normed_algebra_1, comm_monoid_mult}" shows "(\i. i \ I \ norm (z i) \ 1) \ (\i. i \ I \ norm (w i) \ 1) \ norm ((\i\I. z i) - (\i\I. w i)) \ (\i\I. norm (z i - w i))" proof (induction I rule: infinite_finite_induct) case empty then show ?case by simp next case (insert i I) note insert.hyps[simp] have "norm ((\i\insert i I. z i) - (\i\insert i I. w i)) = norm ((\i\I. z i) * (z i - w i) + ((\i\I. z i) - (\i\I. w i)) * w i)" (is "_ = norm (?t1 + ?t2)") by (auto simp: field_simps) also have "\ \ norm ?t1 + norm ?t2" by (rule norm_triangle_ineq) also have "norm ?t1 \ norm (\i\I. z i) * norm (z i - w i)" by (rule norm_mult_ineq) also have "\ \ (\i\I. norm (z i)) * norm(z i - w i)" by (rule mult_right_mono) (auto intro: norm_prod_le) also have "(\i\I. norm (z i)) \ (\i\I. 1)" by (intro prod_mono) (auto intro!: insert) also have "norm ?t2 \ norm ((\i\I. z i) - (\i\I. w i)) * norm (w i)" by (rule norm_mult_ineq) also have "norm (w i) \ 1" by (auto intro: insert) also have "norm ((\i\I. z i) - (\i\I. w i)) \ (\i\I. norm (z i - w i))" using insert by auto finally show ?case by (auto simp: ac_simps mult_right_mono mult_left_mono) next case infinite then show ?case by simp qed lemma norm_power_diff: fixes z w :: "'a::{real_normed_algebra_1, comm_monoid_mult}" assumes "norm z \ 1" "norm w \ 1" shows "norm (z^m - w^m) \ m * norm (z - w)" proof - have "norm (z^m - w^m) = norm ((\ i < m. z) - (\ i < m. w))" by simp also have "\ \ (\i = m * norm (z - w)" by simp finally show ?thesis . qed subsection \Metric spaces\ class metric_space = uniformity_dist + open_uniformity + assumes dist_eq_0_iff [simp]: "dist x y = 0 \ x = y" and dist_triangle2: "dist x y \ dist x z + dist y z" begin lemma dist_self [simp]: "dist x x = 0" by simp lemma zero_le_dist [simp]: "0 \ dist x y" using dist_triangle2 [of x x y] by simp lemma zero_less_dist_iff: "0 < dist x y \ x \ y" by (simp add: less_le) lemma dist_not_less_zero [simp]: "\ dist x y < 0" by (simp add: not_less) lemma dist_le_zero_iff [simp]: "dist x y \ 0 \ x = y" by (simp add: le_less) lemma dist_commute: "dist x y = dist y x" proof (rule order_antisym) show "dist x y \ dist y x" using dist_triangle2 [of x y x] by simp show "dist y x \ dist x y" using dist_triangle2 [of y x y] by simp qed lemma dist_commute_lessI: "dist y x < e \ dist x y < e" by (simp add: dist_commute) lemma dist_triangle: "dist x z \ dist x y + dist y z" using dist_triangle2 [of x z y] by (simp add: dist_commute) lemma dist_triangle3: "dist x y \ dist a x + dist a y" using dist_triangle2 [of x y a] by (simp add: dist_commute) lemma abs_dist_diff_le: "\dist a b - dist b c\ \ dist a c" using dist_triangle3[of b c a] dist_triangle2[of a b c] by simp lemma dist_pos_lt: "x \ y \ 0 < dist x y" by (simp add: zero_less_dist_iff) lemma dist_nz: "x \ y \ 0 < dist x y" by (simp add: zero_less_dist_iff) declare dist_nz [symmetric, simp] lemma dist_triangle_le: "dist x z + dist y z \ e \ dist x y \ e" by (rule order_trans [OF dist_triangle2]) lemma dist_triangle_lt: "dist x z + dist y z < e \ dist x y < e" by (rule le_less_trans [OF dist_triangle2]) lemma dist_triangle_less_add: "dist x1 y < e1 \ dist x2 y < e2 \ dist x1 x2 < e1 + e2" by (rule dist_triangle_lt [where z=y]) simp lemma dist_triangle_half_l: "dist x1 y < e / 2 \ dist x2 y < e / 2 \ dist x1 x2 < e" by (rule dist_triangle_lt [where z=y]) simp lemma dist_triangle_half_r: "dist y x1 < e / 2 \ dist y x2 < e / 2 \ dist x1 x2 < e" by (rule dist_triangle_half_l) (simp_all add: dist_commute) lemma dist_triangle_third: assumes "dist x1 x2 < e/3" "dist x2 x3 < e/3" "dist x3 x4 < e/3" shows "dist x1 x4 < e" proof - have "dist x1 x3 < e/3 + e/3" by (metis assms(1) assms(2) dist_commute dist_triangle_less_add) then have "dist x1 x4 < (e/3 + e/3) + e/3" by (metis assms(3) dist_commute dist_triangle_less_add) then show ?thesis by simp qed subclass uniform_space proof fix E x assume "eventually E uniformity" then obtain e where E: "0 < e" "\x y. dist x y < e \ E (x, y)" by (auto simp: eventually_uniformity_metric) then show "E (x, x)" "\\<^sub>F (x, y) in uniformity. E (y, x)" by (auto simp: eventually_uniformity_metric dist_commute) show "\D. eventually D uniformity \ (\x y z. D (x, y) \ D (y, z) \ E (x, z))" using E dist_triangle_half_l[where e=e] unfolding eventually_uniformity_metric by (intro exI[of _ "\(x, y). dist x y < e / 2"] exI[of _ "e/2"] conjI) (auto simp: dist_commute) qed lemma open_dist: "open S \ (\x\S. \e>0. \y. dist y x < e \ y \ S)" by (simp add: dist_commute open_uniformity eventually_uniformity_metric) lemma open_ball: "open {y. dist x y < d}" unfolding open_dist proof (intro ballI) fix y assume *: "y \ {y. dist x y < d}" then show "\e>0. \z. dist z y < e \ z \ {y. dist x y < d}" by (auto intro!: exI[of _ "d - dist x y"] simp: field_simps dist_triangle_lt) qed subclass first_countable_topology proof fix x show "\A::nat \ 'a set. (\i. x \ A i \ open (A i)) \ (\S. open S \ x \ S \ (\i. A i \ S))" proof (safe intro!: exI[of _ "\n. {y. dist x y < inverse (Suc n)}"]) fix S assume "open S" "x \ S" then obtain e where e: "0 < e" and "{y. dist x y < e} \ S" by (auto simp: open_dist subset_eq dist_commute) moreover from e obtain i where "inverse (Suc i) < e" by (auto dest!: reals_Archimedean) then have "{y. dist x y < inverse (Suc i)} \ {y. dist x y < e}" by auto ultimately show "\i. {y. dist x y < inverse (Suc i)} \ S" by blast qed (auto intro: open_ball) qed end instance metric_space \ t2_space proof fix x y :: "'a::metric_space" assume xy: "x \ y" let ?U = "{y'. dist x y' < dist x y / 2}" let ?V = "{x'. dist y x' < dist x y / 2}" have *: "d x z \ d x y + d y z \ d y z = d z y \ \ (d x y * 2 < d x z \ d z y * 2 < d x z)" for d :: "'a \ 'a \ real" and x y z :: 'a by arith have "open ?U \ open ?V \ x \ ?U \ y \ ?V \ ?U \ ?V = {}" using dist_pos_lt[OF xy] *[of dist, OF dist_triangle dist_commute] using open_ball[of _ "dist x y / 2"] by auto then show "\U V. open U \ open V \ x \ U \ y \ V \ U \ V = {}" by blast qed text \Every normed vector space is a metric space.\ instance real_normed_vector < metric_space proof fix x y z :: 'a show "dist x y = 0 \ x = y" by (simp add: dist_norm) show "dist x y \ dist x z + dist y z" using norm_triangle_ineq4 [of "x - z" "y - z"] by (simp add: dist_norm) qed subsection \Class instances for real numbers\ instantiation real :: real_normed_field begin definition dist_real_def: "dist x y = \x - y\" definition uniformity_real_def [code del]: "(uniformity :: (real \ real) filter) = (INF e\{0 <..}. principal {(x, y). dist x y < e})" definition open_real_def [code del]: "open (U :: real set) \ (\x\U. eventually (\(x', y). x' = x \ y \ U) uniformity)" definition real_norm_def [simp]: "norm r = \r\" instance by intro_classes (auto simp: abs_mult open_real_def dist_real_def sgn_real_def uniformity_real_def) end declare uniformity_Abort[where 'a=real, code] lemma dist_of_real [simp]: "dist (of_real x :: 'a) (of_real y) = dist x y" for a :: "'a::real_normed_div_algebra" by (metis dist_norm norm_of_real of_real_diff real_norm_def) declare [[code abort: "open :: real set \ bool"]] instance real :: linorder_topology proof show "(open :: real set \ bool) = generate_topology (range lessThan \ range greaterThan)" proof (rule ext, safe) fix S :: "real set" assume "open S" then obtain f where "\x\S. 0 < f x \ (\y. dist y x < f x \ y \ S)" unfolding open_dist bchoice_iff .. then have *: "(\x\S. {x - f x <..} \ {..< x + f x}) = S" (is "?S = S") by (fastforce simp: dist_real_def) moreover have "generate_topology (range lessThan \ range greaterThan) ?S" by (force intro: generate_topology.Basis generate_topology_Union generate_topology.Int) ultimately show "generate_topology (range lessThan \ range greaterThan) S" by simp next fix S :: "real set" assume "generate_topology (range lessThan \ range greaterThan) S" moreover have "\a::real. open {.. (\y. \y - x\ < a - x \ y \ {..e>0. \y. \y - x\ < e \ y \ {..a::real. open {a <..}" unfolding open_dist dist_real_def proof clarify fix x a :: real assume "a < x" then have "0 < x - a \ (\y. \y - x\ < x - a \ y \ {a<..})" by auto then show "\e>0. \y. \y - x\ < e \ y \ {a<..}" .. qed ultimately show "open S" by induct auto qed qed instance real :: linear_continuum_topology .. lemmas open_real_greaterThan = open_greaterThan[where 'a=real] lemmas open_real_lessThan = open_lessThan[where 'a=real] lemmas open_real_greaterThanLessThan = open_greaterThanLessThan[where 'a=real] lemmas closed_real_atMost = closed_atMost[where 'a=real] lemmas closed_real_atLeast = closed_atLeast[where 'a=real] lemmas closed_real_atLeastAtMost = closed_atLeastAtMost[where 'a=real] instance real :: ordered_real_vector by standard (auto intro: mult_left_mono mult_right_mono) subsection \Extra type constraints\ text \Only allow \<^term>\open\ in class \topological_space\.\ setup \Sign.add_const_constraint (\<^const_name>\open\, SOME \<^typ>\'a::topological_space set \ bool\)\ text \Only allow \<^term>\uniformity\ in class \uniform_space\.\ setup \Sign.add_const_constraint (\<^const_name>\uniformity\, SOME \<^typ>\('a::uniformity \ 'a) filter\)\ text \Only allow \<^term>\dist\ in class \metric_space\.\ setup \Sign.add_const_constraint (\<^const_name>\dist\, SOME \<^typ>\'a::metric_space \ 'a \ real\)\ text \Only allow \<^term>\norm\ in class \real_normed_vector\.\ setup \Sign.add_const_constraint (\<^const_name>\norm\, SOME \<^typ>\'a::real_normed_vector \ real\)\ subsection \Sign function\ lemma norm_sgn: "norm (sgn x) = (if x = 0 then 0 else 1)" for x :: "'a::real_normed_vector" by (simp add: sgn_div_norm) lemma sgn_zero [simp]: "sgn (0::'a::real_normed_vector) = 0" by (simp add: sgn_div_norm) lemma sgn_zero_iff: "sgn x = 0 \ x = 0" for x :: "'a::real_normed_vector" by (simp add: sgn_div_norm) lemma sgn_minus: "sgn (- x) = - sgn x" for x :: "'a::real_normed_vector" by (simp add: sgn_div_norm) lemma sgn_scaleR: "sgn (scaleR r x) = scaleR (sgn r) (sgn x)" for x :: "'a::real_normed_vector" by (simp add: sgn_div_norm ac_simps) lemma sgn_one [simp]: "sgn (1::'a::real_normed_algebra_1) = 1" by (simp add: sgn_div_norm) lemma sgn_of_real: "sgn (of_real r :: 'a::real_normed_algebra_1) = of_real (sgn r)" unfolding of_real_def by (simp only: sgn_scaleR sgn_one) lemma sgn_mult: "sgn (x * y) = sgn x * sgn y" for x y :: "'a::real_normed_div_algebra" by (simp add: sgn_div_norm norm_mult) hide_fact (open) sgn_mult lemma real_sgn_eq: "sgn x = x / \x\" for x :: real by (simp add: sgn_div_norm divide_inverse) lemma zero_le_sgn_iff [simp]: "0 \ sgn x \ 0 \ x" for x :: real by (cases "0::real" x rule: linorder_cases) simp_all lemma sgn_le_0_iff [simp]: "sgn x \ 0 \ x \ 0" for x :: real by (cases "0::real" x rule: linorder_cases) simp_all lemma norm_conv_dist: "norm x = dist x 0" unfolding dist_norm by simp declare norm_conv_dist [symmetric, simp] lemma dist_0_norm [simp]: "dist 0 x = norm x" for x :: "'a::real_normed_vector" by (simp add: dist_norm) lemma dist_diff [simp]: "dist a (a - b) = norm b" "dist (a - b) a = norm b" by (simp_all add: dist_norm) lemma dist_of_int: "dist (of_int m) (of_int n :: 'a :: real_normed_algebra_1) = of_int \m - n\" proof - have "dist (of_int m) (of_int n :: 'a) = dist (of_int m :: 'a) (of_int m - (of_int (m - n)))" by simp also have "\ = of_int \m - n\" by (subst dist_diff, subst norm_of_int) simp finally show ?thesis . qed lemma dist_of_nat: "dist (of_nat m) (of_nat n :: 'a :: real_normed_algebra_1) = of_int \int m - int n\" by (subst (1 2) of_int_of_nat_eq [symmetric]) (rule dist_of_int) subsection \Bounded Linear and Bilinear Operators\ lemma linearI: "linear f" if "\b1 b2. f (b1 + b2) = f b1 + f b2" "\r b. f (r *\<^sub>R b) = r *\<^sub>R f b" using that by unfold_locales (auto simp: algebra_simps) lemma linear_iff: "linear f \ (\x y. f (x + y) = f x + f y) \ (\c x. f (c *\<^sub>R x) = c *\<^sub>R f x)" (is "linear f \ ?rhs") proof assume "linear f" then interpret f: linear f . show "?rhs" by (simp add: f.add f.scale) next assume "?rhs" then show "linear f" by (intro linearI) auto qed lemmas linear_scaleR_left = linear_scale_left lemmas linear_imp_scaleR = linear_imp_scale corollary real_linearD: fixes f :: "real \ real" assumes "linear f" obtains c where "f = (*) c" by (rule linear_imp_scaleR [OF assms]) (force simp: scaleR_conv_of_real) lemma linear_times_of_real: "linear (\x. a * of_real x)" by (auto intro!: linearI simp: distrib_left) (metis mult_scaleR_right scaleR_conv_of_real) locale bounded_linear = linear f for f :: "'a::real_normed_vector \ 'b::real_normed_vector" + assumes bounded: "\K. \x. norm (f x) \ norm x * K" begin lemma pos_bounded: "\K>0. \x. norm (f x) \ norm x * K" proof - obtain K where K: "\x. norm (f x) \ norm x * K" using bounded by blast show ?thesis proof (intro exI impI conjI allI) show "0 < max 1 K" by (rule order_less_le_trans [OF zero_less_one max.cobounded1]) next fix x have "norm (f x) \ norm x * K" using K . also have "\ \ norm x * max 1 K" by (rule mult_left_mono [OF max.cobounded2 norm_ge_zero]) finally show "norm (f x) \ norm x * max 1 K" . qed qed lemma nonneg_bounded: "\K\0. \x. norm (f x) \ norm x * K" using pos_bounded by (auto intro: order_less_imp_le) lemma linear: "linear f" by (fact local.linear_axioms) end lemma bounded_linear_intro: assumes "\x y. f (x + y) = f x + f y" and "\r x. f (scaleR r x) = scaleR r (f x)" and "\x. norm (f x) \ norm x * K" shows "bounded_linear f" by standard (blast intro: assms)+ locale bounded_bilinear = fixes prod :: "'a::real_normed_vector \ 'b::real_normed_vector \ 'c::real_normed_vector" (infixl "**" 70) assumes add_left: "prod (a + a') b = prod a b + prod a' b" and add_right: "prod a (b + b') = prod a b + prod a b'" and scaleR_left: "prod (scaleR r a) b = scaleR r (prod a b)" and scaleR_right: "prod a (scaleR r b) = scaleR r (prod a b)" and bounded: "\K. \a b. norm (prod a b) \ norm a * norm b * K" begin lemma pos_bounded: "\K>0. \a b. norm (a ** b) \ norm a * norm b * K" proof - obtain K where "\a b. norm (a ** b) \ norm a * norm b * K" using bounded by blast then have "norm (a ** b) \ norm a * norm b * (max 1 K)" for a b by (rule order.trans) (simp add: mult_left_mono) then show ?thesis by force qed lemma nonneg_bounded: "\K\0. \a b. norm (a ** b) \ norm a * norm b * K" using pos_bounded by (auto intro: order_less_imp_le) lemma additive_right: "additive (\b. prod a b)" by (rule additive.intro, rule add_right) lemma additive_left: "additive (\a. prod a b)" by (rule additive.intro, rule add_left) lemma zero_left: "prod 0 b = 0" by (rule additive.zero [OF additive_left]) lemma zero_right: "prod a 0 = 0" by (rule additive.zero [OF additive_right]) lemma minus_left: "prod (- a) b = - prod a b" by (rule additive.minus [OF additive_left]) lemma minus_right: "prod a (- b) = - prod a b" by (rule additive.minus [OF additive_right]) lemma diff_left: "prod (a - a') b = prod a b - prod a' b" by (rule additive.diff [OF additive_left]) lemma diff_right: "prod a (b - b') = prod a b - prod a b'" by (rule additive.diff [OF additive_right]) lemma sum_left: "prod (sum g S) x = sum ((\i. prod (g i) x)) S" by (rule additive.sum [OF additive_left]) lemma sum_right: "prod x (sum g S) = sum ((\i. (prod x (g i)))) S" by (rule additive.sum [OF additive_right]) lemma bounded_linear_left: "bounded_linear (\a. a ** b)" proof - obtain K where "\a b. norm (a ** b) \ norm a * norm b * K" using pos_bounded by blast then show ?thesis by (rule_tac K="norm b * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_left add_left) qed lemma bounded_linear_right: "bounded_linear (\b. a ** b)" proof - obtain K where "\a b. norm (a ** b) \ norm a * norm b * K" using pos_bounded by blast then show ?thesis by (rule_tac K="norm a * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_right add_right) qed lemma prod_diff_prod: "(x ** y - a ** b) = (x - a) ** (y - b) + (x - a) ** b + a ** (y - b)" by (simp add: diff_left diff_right) lemma flip: "bounded_bilinear (\x y. y ** x)" proof show "\K. \a b. norm (b ** a) \ norm a * norm b * K" by (metis bounded mult.commute) qed (simp_all add: add_right add_left scaleR_right scaleR_left) lemma comp1: assumes "bounded_linear g" shows "bounded_bilinear (\x. (**) (g x))" proof unfold_locales interpret g: bounded_linear g by fact show "\a a' b. g (a + a') ** b = g a ** b + g a' ** b" "\a b b'. g a ** (b + b') = g a ** b + g a ** b'" "\r a b. g (r *\<^sub>R a) ** b = r *\<^sub>R (g a ** b)" "\a r b. g a ** (r *\<^sub>R b) = r *\<^sub>R (g a ** b)" by (auto simp: g.add add_left add_right g.scaleR scaleR_left scaleR_right) from g.nonneg_bounded nonneg_bounded obtain K L where nn: "0 \ K" "0 \ L" and K: "\x. norm (g x) \ norm x * K" and L: "\a b. norm (a ** b) \ norm a * norm b * L" by auto have "norm (g a ** b) \ norm a * K * norm b * L" for a b by (auto intro!: order_trans[OF K] order_trans[OF L] mult_mono simp: nn) then show "\K. \a b. norm (g a ** b) \ norm a * norm b * K" by (auto intro!: exI[where x="K * L"] simp: ac_simps) qed lemma comp: "bounded_linear f \ bounded_linear g \ bounded_bilinear (\x y. f x ** g y)" by (rule bounded_bilinear.flip[OF bounded_bilinear.comp1[OF bounded_bilinear.flip[OF comp1]]]) end lemma bounded_linear_ident[simp]: "bounded_linear (\x. x)" by standard (auto intro!: exI[of _ 1]) lemma bounded_linear_zero[simp]: "bounded_linear (\x. 0)" by standard (auto intro!: exI[of _ 1]) lemma bounded_linear_add: assumes "bounded_linear f" and "bounded_linear g" shows "bounded_linear (\x. f x + g x)" proof - interpret f: bounded_linear f by fact interpret g: bounded_linear g by fact show ?thesis proof from f.bounded obtain Kf where Kf: "norm (f x) \ norm x * Kf" for x by blast from g.bounded obtain Kg where Kg: "norm (g x) \ norm x * Kg" for x by blast show "\K. \x. norm (f x + g x) \ norm x * K" using add_mono[OF Kf Kg] by (intro exI[of _ "Kf + Kg"]) (auto simp: field_simps intro: norm_triangle_ineq order_trans) qed (simp_all add: f.add g.add f.scaleR g.scaleR scaleR_right_distrib) qed lemma bounded_linear_minus: assumes "bounded_linear f" shows "bounded_linear (\x. - f x)" proof - interpret f: bounded_linear f by fact show ?thesis by unfold_locales (simp_all add: f.add f.scaleR f.bounded) qed lemma bounded_linear_sub: "bounded_linear f \ bounded_linear g \ bounded_linear (\x. f x - g x)" using bounded_linear_add[of f "\x. - g x"] bounded_linear_minus[of g] by (auto simp: algebra_simps) lemma bounded_linear_sum: fixes f :: "'i \ 'a::real_normed_vector \ 'b::real_normed_vector" shows "(\i. i \ I \ bounded_linear (f i)) \ bounded_linear (\x. \i\I. f i x)" by (induct I rule: infinite_finite_induct) (auto intro!: bounded_linear_add) lemma bounded_linear_compose: assumes "bounded_linear f" and "bounded_linear g" shows "bounded_linear (\x. f (g x))" proof - interpret f: bounded_linear f by fact interpret g: bounded_linear g by fact show ?thesis proof unfold_locales show "f (g (x + y)) = f (g x) + f (g y)" for x y by (simp only: f.add g.add) show "f (g (scaleR r x)) = scaleR r (f (g x))" for r x by (simp only: f.scaleR g.scaleR) from f.pos_bounded obtain Kf where f: "\x. norm (f x) \ norm x * Kf" and Kf: "0 < Kf" by blast from g.pos_bounded obtain Kg where g: "\x. norm (g x) \ norm x * Kg" by blast show "\K. \x. norm (f (g x)) \ norm x * K" proof (intro exI allI) fix x have "norm (f (g x)) \ norm (g x) * Kf" using f . also have "\ \ (norm x * Kg) * Kf" using g Kf [THEN order_less_imp_le] by (rule mult_right_mono) also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)" by (rule mult.assoc) finally show "norm (f (g x)) \ norm x * (Kg * Kf)" . qed qed qed lemma bounded_bilinear_mult: "bounded_bilinear ((*) :: 'a \ 'a \ 'a::real_normed_algebra)" proof (rule bounded_bilinear.intro) show "\K. \a b::'a. norm (a * b) \ norm a * norm b * K" by (rule_tac x=1 in exI) (simp add: norm_mult_ineq) qed (auto simp: algebra_simps) lemma bounded_linear_mult_left: "bounded_linear (\x::'a::real_normed_algebra. x * y)" using bounded_bilinear_mult by (rule bounded_bilinear.bounded_linear_left) lemma bounded_linear_mult_right: "bounded_linear (\y::'a::real_normed_algebra. x * y)" using bounded_bilinear_mult by (rule bounded_bilinear.bounded_linear_right) lemmas bounded_linear_mult_const = bounded_linear_mult_left [THEN bounded_linear_compose] lemmas bounded_linear_const_mult = bounded_linear_mult_right [THEN bounded_linear_compose] lemma bounded_linear_divide: "bounded_linear (\x. x / y)" for y :: "'a::real_normed_field" unfolding divide_inverse by (rule bounded_linear_mult_left) lemma bounded_bilinear_scaleR: "bounded_bilinear scaleR" proof (rule bounded_bilinear.intro) show "\K. \a b. norm (a *\<^sub>R b) \ norm a * norm b * K" using less_eq_real_def by auto qed (auto simp: algebra_simps) lemma bounded_linear_scaleR_left: "bounded_linear (\r. scaleR r x)" using bounded_bilinear_scaleR by (rule bounded_bilinear.bounded_linear_left) lemma bounded_linear_scaleR_right: "bounded_linear (\x. scaleR r x)" using bounded_bilinear_scaleR by (rule bounded_bilinear.bounded_linear_right) lemmas bounded_linear_scaleR_const = bounded_linear_scaleR_left[THEN bounded_linear_compose] lemmas bounded_linear_const_scaleR = bounded_linear_scaleR_right[THEN bounded_linear_compose] lemma bounded_linear_of_real: "bounded_linear (\r. of_real r)" unfolding of_real_def by (rule bounded_linear_scaleR_left) lemma real_bounded_linear: "bounded_linear f \ (\c::real. f = (\x. x * c))" for f :: "real \ real" proof - { fix x assume "bounded_linear f" then interpret bounded_linear f . from scaleR[of x 1] have "f x = x * f 1" by simp } then show ?thesis by (auto intro: exI[of _ "f 1"] bounded_linear_mult_left) qed instance real_normed_algebra_1 \ perfect_space proof fix x::'a have "\e. 0 < e \ \y. norm (y - x) < e \ y \ x" by (rule_tac x = "x + of_real (e/2)" in exI) auto then show "\ open {x}" by (clarsimp simp: open_dist dist_norm) qed subsection \Filters and Limits on Metric Space\ lemma (in metric_space) nhds_metric: "nhds x = (INF e\{0 <..}. principal {y. dist y x < e})" unfolding nhds_def proof (safe intro!: INF_eq) fix S assume "open S" "x \ S" then obtain e where "{y. dist y x < e} \ S" "0 < e" by (auto simp: open_dist subset_eq) then show "\e\{0<..}. principal {y. dist y x < e} \ principal S" by auto qed (auto intro!: exI[of _ "{y. dist x y < e}" for e] open_ball simp: dist_commute) lemma (in metric_space) tendsto_iff: "(f \ l) F \ (\e>0. eventually (\x. dist (f x) l < e) F)" unfolding nhds_metric filterlim_INF filterlim_principal by auto lemma tendsto_dist_iff: "((f \ l) F) \ (((\x. dist (f x) l) \ 0) F)" unfolding tendsto_iff by simp lemma (in metric_space) tendstoI [intro?]: "(\e. 0 < e \ eventually (\x. dist (f x) l < e) F) \ (f \ l) F" by (auto simp: tendsto_iff) lemma (in metric_space) tendstoD: "(f \ l) F \ 0 < e \ eventually (\x. dist (f x) l < e) F" by (auto simp: tendsto_iff) lemma (in metric_space) eventually_nhds_metric: "eventually P (nhds a) \ (\d>0. \x. dist x a < d \ P x)" unfolding nhds_metric by (subst eventually_INF_base) (auto simp: eventually_principal Bex_def subset_eq intro: exI[of _ "min a b" for a b]) lemma eventually_at: "eventually P (at a within S) \ (\d>0. \x\S. x \ a \ dist x a < d \ P x)" for a :: "'a :: metric_space" by (auto simp: eventually_at_filter eventually_nhds_metric) lemma frequently_at: "frequently P (at a within S) \ (\d>0. \x\S. x \ a \ dist x a < d \ P x)" for a :: "'a :: metric_space" unfolding frequently_def eventually_at by auto lemma eventually_at_le: "eventually P (at a within S) \ (\d>0. \x\S. x \ a \ dist x a \ d \ P x)" for a :: "'a::metric_space" unfolding eventually_at_filter eventually_nhds_metric apply safe apply (rule_tac x="d / 2" in exI, auto) done lemma eventually_at_left_real: "a > (b :: real) \ eventually (\x. x \ {b<.. eventually (\x. x \ {a<.. a) F" and le: "eventually (\x. dist (g x) b \ dist (f x) a) F" shows "(g \ b) F" proof (rule tendstoI) fix e :: real assume "0 < e" with f have "eventually (\x. dist (f x) a < e) F" by (rule tendstoD) with le show "eventually (\x. dist (g x) b < e) F" using le_less_trans by (rule eventually_elim2) qed lemma filterlim_real_sequentially: "LIM x sequentially. real x :> at_top" proof (clarsimp simp: filterlim_at_top) fix Z show "\\<^sub>F x in sequentially. Z \ real x" by (meson eventually_sequentiallyI nat_ceiling_le_eq) qed lemma filterlim_nat_sequentially: "filterlim nat sequentially at_top" proof - have "\\<^sub>F x in at_top. Z \ nat x" for Z by (auto intro!: eventually_at_top_linorderI[where c="int Z"]) then show ?thesis unfolding filterlim_at_top .. qed lemma filterlim_floor_sequentially: "filterlim floor at_top at_top" proof - have "\\<^sub>F x in at_top. Z \ \x\" for Z by (auto simp: le_floor_iff intro!: eventually_at_top_linorderI[where c="of_int Z"]) then show ?thesis unfolding filterlim_at_top .. qed lemma filterlim_sequentially_iff_filterlim_real: "filterlim f sequentially F \ filterlim (\x. real (f x)) at_top F" (is "?lhs = ?rhs") proof assume ?lhs then show ?rhs using filterlim_compose filterlim_real_sequentially by blast next assume R: ?rhs show ?lhs proof - have "filterlim (\x. nat (floor (real (f x)))) sequentially F" by (intro filterlim_compose[OF filterlim_nat_sequentially] filterlim_compose[OF filterlim_floor_sequentially] R) then show ?thesis by simp qed qed subsubsection \Limits of Sequences\ lemma lim_sequentially: "X \ L \ (\r>0. \no. \n\no. dist (X n) L < r)" for L :: "'a::metric_space" unfolding tendsto_iff eventually_sequentially .. lemmas LIMSEQ_def = lim_sequentially (*legacy binding*) lemma LIMSEQ_iff_nz: "X \ L \ (\r>0. \no>0. \n\no. dist (X n) L < r)" for L :: "'a::metric_space" unfolding lim_sequentially by (metis Suc_leD zero_less_Suc) lemma metric_LIMSEQ_I: "(\r. 0 < r \ \no. \n\no. dist (X n) L < r) \ X \ L" for L :: "'a::metric_space" by (simp add: lim_sequentially) lemma metric_LIMSEQ_D: "X \ L \ 0 < r \ \no. \n\no. dist (X n) L < r" for L :: "'a::metric_space" by (simp add: lim_sequentially) lemma LIMSEQ_norm_0: assumes "\n::nat. norm (f n) < 1 / real (Suc n)" shows "f \ 0" proof (rule metric_LIMSEQ_I) fix \ :: "real" assume "\ > 0" then obtain N::nat where "\ > inverse N" "N > 0" by (metis neq0_conv real_arch_inverse) then have "norm (f n) < \" if "n \ N" for n proof - have "1 / (Suc n) \ 1 / N" using \0 < N\ inverse_of_nat_le le_SucI that by blast also have "\ < \" by (metis (no_types) \inverse (real N) < \\ inverse_eq_divide) finally show ?thesis by (meson assms less_eq_real_def not_le order_trans) qed then show "\no. \n\no. dist (f n) 0 < \" by auto qed subsubsection \Limits of Functions\ lemma LIM_def: "f \a\ L \ (\r > 0. \s > 0. \x. x \ a \ dist x a < s \ dist (f x) L < r)" for a :: "'a::metric_space" and L :: "'b::metric_space" unfolding tendsto_iff eventually_at by simp lemma metric_LIM_I: "(\r. 0 < r \ \s>0. \x. x \ a \ dist x a < s \ dist (f x) L < r) \ f \a\ L" for a :: "'a::metric_space" and L :: "'b::metric_space" by (simp add: LIM_def) lemma metric_LIM_D: "f \a\ L \ 0 < r \ \s>0. \x. x \ a \ dist x a < s \ dist (f x) L < r" for a :: "'a::metric_space" and L :: "'b::metric_space" by (simp add: LIM_def) lemma metric_LIM_imp_LIM: fixes l :: "'a::metric_space" and m :: "'b::metric_space" assumes f: "f \a\ l" and le: "\x. x \ a \ dist (g x) m \ dist (f x) l" shows "g \a\ m" by (rule metric_tendsto_imp_tendsto [OF f]) (auto simp: eventually_at_topological le) lemma metric_LIM_equal2: fixes a :: "'a::metric_space" assumes "g \a\ l" "0 < R" and "\x. x \ a \ dist x a < R \ f x = g x" shows "f \a\ l" proof - have "\S. \open S; l \ S; \\<^sub>F x in at a. g x \ S\ \ \\<^sub>F x in at a. f x \ S" apply (simp add: eventually_at) by (metis assms(2) assms(3) dual_order.strict_trans linorder_neqE_linordered_idom) then show ?thesis using assms by (simp add: tendsto_def) qed lemma metric_LIM_compose2: fixes a :: "'a::metric_space" assumes f: "f \a\ b" and g: "g \b\ c" and inj: "\d>0. \x. x \ a \ dist x a < d \ f x \ b" shows "(\x. g (f x)) \a\ c" using inj by (intro tendsto_compose_eventually[OF g f]) (auto simp: eventually_at) lemma metric_isCont_LIM_compose2: fixes f :: "'a :: metric_space \ _" assumes f [unfolded isCont_def]: "isCont f a" and g: "g \f a\ l" and inj: "\d>0. \x. x \ a \ dist x a < d \ f x \ f a" shows "(\x. g (f x)) \a\ l" by (rule metric_LIM_compose2 [OF f g inj]) subsection \Complete metric spaces\ subsection \Cauchy sequences\ lemma (in metric_space) Cauchy_def: "Cauchy X = (\e>0. \M. \m\M. \n\M. dist (X m) (X n) < e)" proof - have *: "eventually P (INF M. principal {(X m, X n) | n m. m \ M \ n \ M}) \ (\M. \m\M. \n\M. P (X m, X n))" for P apply (subst eventually_INF_base) subgoal by simp subgoal for a b by (intro bexI[of _ "max a b"]) (auto simp: eventually_principal subset_eq) subgoal by (auto simp: eventually_principal, blast) done have "Cauchy X \ (INF M. principal {(X m, X n) | n m. m \ M \ n \ M}) \ uniformity" unfolding Cauchy_uniform_iff le_filter_def * .. also have "\ = (\e>0. \M. \m\M. \n\M. dist (X m) (X n) < e)" unfolding uniformity_dist le_INF_iff by (auto simp: * le_principal) finally show ?thesis . qed lemma (in metric_space) Cauchy_altdef: "Cauchy f \ (\e>0. \M. \m\M. \n>m. dist (f m) (f n) < e)" (is "?lhs \ ?rhs") proof assume ?rhs show ?lhs unfolding Cauchy_def proof (intro allI impI) fix e :: real assume e: "e > 0" with \?rhs\ obtain M where M: "m \ M \ n > m \ dist (f m) (f n) < e" for m n by blast have "dist (f m) (f n) < e" if "m \ M" "n \ M" for m n using M[of m n] M[of n m] e that by (cases m n rule: linorder_cases) (auto simp: dist_commute) then show "\M. \m\M. \n\M. dist (f m) (f n) < e" by blast qed next assume ?lhs show ?rhs proof (intro allI impI) fix e :: real assume e: "e > 0" with \Cauchy f\ obtain M where "\m n. m \ M \ n \ M \ dist (f m) (f n) < e" unfolding Cauchy_def by blast then show "\M. \m\M. \n>m. dist (f m) (f n) < e" by (intro exI[of _ M]) force qed qed lemma (in metric_space) Cauchy_altdef2: "Cauchy s \ (\e>0. \N::nat. \n\N. dist(s n)(s N) < e)" (is "?lhs = ?rhs") proof assume "Cauchy s" then show ?rhs by (force simp: Cauchy_def) next assume ?rhs { fix e::real assume "e>0" with \?rhs\ obtain N where N: "\n\N. dist (s n) (s N) < e/2" by (erule_tac x="e/2" in allE) auto { fix n m assume nm: "N \ m \ N \ n" then have "dist (s m) (s n) < e" using N using dist_triangle_half_l[of "s m" "s N" "e" "s n"] by blast } then have "\N. \m n. N \ m \ N \ n \ dist (s m) (s n) < e" by blast } then have ?lhs unfolding Cauchy_def by blast then show ?lhs by blast qed lemma (in metric_space) metric_CauchyI: "(\e. 0 < e \ \M. \m\M. \n\M. dist (X m) (X n) < e) \ Cauchy X" by (simp add: Cauchy_def) lemma (in metric_space) CauchyI': "(\e. 0 < e \ \M. \m\M. \n>m. dist (X m) (X n) < e) \ Cauchy X" unfolding Cauchy_altdef by blast lemma (in metric_space) metric_CauchyD: "Cauchy X \ 0 < e \ \M. \m\M. \n\M. dist (X m) (X n) < e" by (simp add: Cauchy_def) lemma (in metric_space) metric_Cauchy_iff2: "Cauchy X = (\j. (\M. \m \ M. \n \ M. dist (X m) (X n) < inverse(real (Suc j))))" apply (auto simp add: Cauchy_def) by (metis less_trans of_nat_Suc reals_Archimedean) lemma Cauchy_iff2: "Cauchy X \ (\j. (\M. \m \ M. \n \ M. \X m - X n\ < inverse (real (Suc j))))" by (simp only: metric_Cauchy_iff2 dist_real_def) lemma lim_1_over_n [tendsto_intros]: "((\n. 1 / of_nat n) \ (0::'a::real_normed_field)) sequentially" proof (subst lim_sequentially, intro allI impI exI) fix e::real and n assume e: "e > 0" have "inverse e < of_nat (nat \inverse e + 1\)" by linarith also assume "n \ nat \inverse e + 1\" finally show "dist (1 / of_nat n :: 'a) 0 < e" using e by (simp add: field_split_simps norm_divide) qed lemma (in metric_space) complete_def: shows "complete S = (\f. (\n. f n \ S) \ Cauchy f \ (\l\S. f \ l))" unfolding complete_uniform proof safe fix f :: "nat \ 'a" assume f: "\n. f n \ S" "Cauchy f" and *: "\F\principal S. F \ bot \ cauchy_filter F \ (\x\S. F \ nhds x)" then show "\l\S. f \ l" unfolding filterlim_def using f by (intro *[rule_format]) (auto simp: filtermap_sequentually_ne_bot le_principal eventually_filtermap Cauchy_uniform) next fix F :: "'a filter" assume "F \ principal S" "F \ bot" "cauchy_filter F" assume seq: "\f. (\n. f n \ S) \ Cauchy f \ (\l\S. f \ l)" from \F \ principal S\ \cauchy_filter F\ have FF_le: "F \\<^sub>F F \ uniformity_on S" by (simp add: cauchy_filter_def principal_prod_principal[symmetric] prod_filter_mono) let ?P = "\P e. eventually P F \ (\x. P x \ x \ S) \ (\x y. P x \ P y \ dist x y < e)" have P: "\P. ?P P \" if "0 < \" for \ :: real proof - from that have "eventually (\(x, y). x \ S \ y \ S \ dist x y < \) (uniformity_on S)" by (auto simp: eventually_inf_principal eventually_uniformity_metric) from filter_leD[OF FF_le this] show ?thesis by (auto simp: eventually_prod_same) qed have "\P. \n. ?P (P n) (1 / Suc n) \ P (Suc n) \ P n" proof (rule dependent_nat_choice) show "\P. ?P P (1 / Suc 0)" using P[of 1] by auto next fix P n assume "?P P (1/Suc n)" moreover obtain Q where "?P Q (1 / Suc (Suc n))" using P[of "1/Suc (Suc n)"] by auto ultimately show "\Q. ?P Q (1 / Suc (Suc n)) \ Q \ P" by (intro exI[of _ "\x. P x \ Q x"]) (auto simp: eventually_conj_iff) qed then obtain P where P: "eventually (P n) F" "P n x \ x \ S" "P n x \ P n y \ dist x y < 1 / Suc n" "P (Suc n) \ P n" for n x y by metis have "antimono P" using P(4) unfolding decseq_Suc_iff le_fun_def by blast obtain X where X: "P n (X n)" for n using P(1)[THEN eventually_happens'[OF \F \ bot\]] by metis have "Cauchy X" unfolding metric_Cauchy_iff2 inverse_eq_divide proof (intro exI allI impI) fix j m n :: nat assume "j \ m" "j \ n" with \antimono P\ X have "P j (X m)" "P j (X n)" by (auto simp: antimono_def) then show "dist (X m) (X n) < 1 / Suc j" by (rule P) qed moreover have "\n. X n \ S" using P(2) X by auto ultimately obtain x where "X \ x" "x \ S" using seq by blast show "\x\S. F \ nhds x" proof (rule bexI) have "eventually (\y. dist y x < e) F" if "0 < e" for e :: real proof - from that have "(\n. 1 / Suc n :: real) \ 0 \ 0 < e / 2" by (subst filterlim_sequentially_Suc) (auto intro!: lim_1_over_n) then have "\\<^sub>F n in sequentially. dist (X n) x < e / 2 \ 1 / Suc n < e / 2" using \X \ x\ unfolding tendsto_iff order_tendsto_iff[where 'a=real] eventually_conj_iff by blast then obtain n where "dist x (X n) < e / 2" "1 / Suc n < e / 2" by (auto simp: eventually_sequentially dist_commute) show ?thesis using \eventually (P n) F\ proof eventually_elim case (elim y) then have "dist y (X n) < 1 / Suc n" by (intro X P) also have "\ < e / 2" by fact finally show "dist y x < e" by (rule dist_triangle_half_l) fact qed qed then show "F \ nhds x" unfolding nhds_metric le_INF_iff le_principal by auto qed fact qed text\apparently unused\ lemma (in metric_space) totally_bounded_metric: "totally_bounded S \ (\e>0. \k. finite k \ S \ (\x\k. {y. dist x y < e}))" unfolding totally_bounded_def eventually_uniformity_metric imp_ex apply (subst all_comm) apply (intro arg_cong[where f=All] ext, safe) subgoal for e apply (erule allE[of _ "\(x, y). dist x y < e"]) apply auto done subgoal for e P k apply (intro exI[of _ k]) apply (force simp: subset_eq) done done subsubsection \Cauchy Sequences are Convergent\ (* TODO: update to uniform_space *) class complete_space = metric_space + assumes Cauchy_convergent: "Cauchy X \ convergent X" lemma Cauchy_convergent_iff: "Cauchy X \ convergent X" for X :: "nat \ 'a::complete_space" by (blast intro: Cauchy_convergent convergent_Cauchy) text \To prove that a Cauchy sequence converges, it suffices to show that a subsequence converges.\ lemma Cauchy_converges_subseq: fixes u::"nat \ 'a::metric_space" assumes "Cauchy u" "strict_mono r" "(u \ r) \ l" shows "u \ l" proof - have *: "eventually (\n. dist (u n) l < e) sequentially" if "e > 0" for e proof - have "e/2 > 0" using that by auto then obtain N1 where N1: "\m n. m \ N1 \ n \ N1 \ dist (u m) (u n) < e/2" using \Cauchy u\ unfolding Cauchy_def by blast obtain N2 where N2: "\n. n \ N2 \ dist ((u \ r) n) l < e / 2" using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff \(u \ r) \ l\] \e/2 > 0\] unfolding eventually_sequentially by auto have "dist (u n) l < e" if "n \ max N1 N2" for n proof - have "dist (u n) l \ dist (u n) ((u \ r) n) + dist ((u \ r) n) l" by (rule dist_triangle) also have "\ < e/2 + e/2" proof (intro add_strict_mono) show "dist (u n) ((u \ r) n) < e / 2" using N1[of n "r n"] N2[of n] that unfolding comp_def by (meson assms(2) le_trans max.bounded_iff strict_mono_imp_increasing) show "dist ((u \ r) n) l < e / 2" using N2 that by auto qed finally show ?thesis by simp qed then show ?thesis unfolding eventually_sequentially by blast qed have "(\n. dist (u n) l) \ 0" by (simp add: less_le_trans * order_tendstoI) then show ?thesis using tendsto_dist_iff by auto qed subsection \The set of real numbers is a complete metric space\ text \ Proof that Cauchy sequences converge based on the one from \<^url>\http://pirate.shu.edu/~wachsmut/ira/numseq/proofs/cauconv.html\ \ text \ If sequence \<^term>\X\ is Cauchy, then its limit is the lub of \<^term>\{r::real. \N. \n\N. r < X n}\ \ lemma increasing_LIMSEQ: fixes f :: "nat \ real" assumes inc: "\n. f n \ f (Suc n)" and bdd: "\n. f n \ l" and en: "\e. 0 < e \ \n. l \ f n + e" shows "f \ l" proof (rule increasing_tendsto) fix x assume "x < l" with dense[of 0 "l - x"] obtain e where "0 < e" "e < l - x" by auto from en[OF \0 < e\] obtain n where "l - e \ f n" by (auto simp: field_simps) with \e < l - x\ \0 < e\ have "x < f n" by simp with incseq_SucI[of f, OF inc] show "eventually (\n. x < f n) sequentially" by (auto simp: eventually_sequentially incseq_def intro: less_le_trans) qed (use bdd in auto) lemma real_Cauchy_convergent: fixes X :: "nat \ real" assumes X: "Cauchy X" shows "convergent X" proof - define S :: "real set" where "S = {x. \N. \n\N. x < X n}" then have mem_S: "\N x. \n\N. x < X n \ x \ S" by auto have bound_isUb: "y \ x" if N: "\n\N. X n < x" and "y \ S" for N and x y :: real proof - from that have "\M. \n\M. y < X n" by (simp add: S_def) then obtain M where "\n\M. y < X n" .. then have "y < X (max M N)" by simp also have "\ < x" using N by simp finally show ?thesis by (rule order_less_imp_le) qed obtain N where "\m\N. \n\N. dist (X m) (X n) < 1" using X[THEN metric_CauchyD, OF zero_less_one] by auto then have N: "\n\N. dist (X n) (X N) < 1" by simp have [simp]: "S \ {}" proof (intro exI ex_in_conv[THEN iffD1]) from N have "\n\N. X N - 1 < X n" by (simp add: abs_diff_less_iff dist_real_def) then show "X N - 1 \ S" by (rule mem_S) qed have [simp]: "bdd_above S" proof from N have "\n\N. X n < X N + 1" by (simp add: abs_diff_less_iff dist_real_def) then show "\s. s \ S \ s \ X N + 1" by (rule bound_isUb) qed have "X \ Sup S" proof (rule metric_LIMSEQ_I) fix r :: real assume "0 < r" then have r: "0 < r/2" by simp obtain N where "\n\N. \m\N. dist (X n) (X m) < r/2" using metric_CauchyD [OF X r] by auto then have "\n\N. dist (X n) (X N) < r/2" by simp then have N: "\n\N. X N - r/2 < X n \ X n < X N + r/2" by (simp only: dist_real_def abs_diff_less_iff) from N have "\n\N. X N - r/2 < X n" by blast then have "X N - r/2 \ S" by (rule mem_S) then have 1: "X N - r/2 \ Sup S" by (simp add: cSup_upper) from N have "\n\N. X n < X N + r/2" by blast from bound_isUb[OF this] have 2: "Sup S \ X N + r/2" by (intro cSup_least) simp_all show "\N. \n\N. dist (X n) (Sup S) < r" proof (intro exI allI impI) fix n assume n: "N \ n" from N n have "X n < X N + r/2" and "X N - r/2 < X n" by simp_all then show "dist (X n) (Sup S) < r" using 1 2 by (simp add: abs_diff_less_iff dist_real_def) qed qed then show ?thesis by (auto simp: convergent_def) qed instance real :: complete_space by intro_classes (rule real_Cauchy_convergent) class banach = real_normed_vector + complete_space instance real :: banach .. lemma tendsto_at_topI_sequentially: fixes f :: "real \ 'b::first_countable_topology" assumes *: "\X. filterlim X at_top sequentially \ (\n. f (X n)) \ y" shows "(f \ y) at_top" proof - obtain A where A: "decseq A" "open (A n)" "y \ A n" "nhds y = (INF n. principal (A n))" for n by (rule nhds_countable[of y]) (rule that) have "\m. \k. \x\k. f x \ A m" proof (rule ccontr) assume "\ (\m. \k. \x\k. f x \ A m)" then obtain m where "\k. \x\k. f x \ A m" by auto then have "\X. \n. (f (X n) \ A m) \ max n (X n) + 1 \ X (Suc n)" by (intro dependent_nat_choice) (auto simp del: max.bounded_iff) then obtain X where X: "\n. f (X n) \ A m" "\n. max n (X n) + 1 \ X (Suc n)" by auto have "1 \ n \ real n \ X n" for n using X[of "n - 1"] by auto then have "filterlim X at_top sequentially" by (force intro!: filterlim_at_top_mono[OF filterlim_real_sequentially] simp: eventually_sequentially) from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False by auto qed then obtain k where "k m \ x \ f x \ A m" for m x by metis then show ?thesis unfolding at_top_def A by (intro filterlim_base[where i=k]) auto qed lemma tendsto_at_topI_sequentially_real: fixes f :: "real \ real" assumes mono: "mono f" and limseq: "(\n. f (real n)) \ y" shows "(f \ y) at_top" proof (rule tendstoI) fix e :: real assume "0 < e" with limseq obtain N :: nat where N: "N \ n \ \f (real n) - y\ < e" for n by (auto simp: lim_sequentially dist_real_def) have le: "f x \ y" for x :: real proof - obtain n where "x \ real_of_nat n" using real_arch_simple[of x] .. note monoD[OF mono this] also have "f (real_of_nat n) \ y" by (rule LIMSEQ_le_const[OF limseq]) (auto intro!: exI[of _ n] monoD[OF mono]) finally show ?thesis . qed have "eventually (\x. real N \ x) at_top" by (rule eventually_ge_at_top) then show "eventually (\x. dist (f x) y < e) at_top" proof eventually_elim case (elim x) with N[of N] le have "y - f (real N) < e" by auto moreover note monoD[OF mono elim] ultimately show "dist (f x) y < e" using le[of x] by (auto simp: dist_real_def field_simps) qed qed end diff --git a/src/HOL/Set_Interval.thy b/src/HOL/Set_Interval.thy --- a/src/HOL/Set_Interval.thy +++ b/src/HOL/Set_Interval.thy @@ -1,2558 +1,2569 @@ (* Title: HOL/Set_Interval.thy Author: Tobias Nipkow, Clemens Ballarin, Jeremy Avigad lessThan, greaterThan, atLeast, atMost and two-sided intervals Modern convention: Ixy stands for an interval where x and y describe the lower and upper bound and x,y : {c,o,i} where c = closed, o = open, i = infinite. Examples: Ico = {_ ..< _} and Ici = {_ ..} *) section \Set intervals\ theory Set_Interval imports Divides begin (* Belongs in Finite_Set but 2 is not available there *) lemma card_2_iff: "card S = 2 \ (\x y. S = {x,y} \ x \ y)" by (auto simp: card_Suc_eq numeral_eq_Suc) lemma card_2_iff': "card S = 2 \ (\x\S. \y\S. x \ y \ (\z\S. z = x \ z = y))" by (auto simp: card_Suc_eq numeral_eq_Suc) context ord begin definition lessThan :: "'a => 'a set" ("(1{..<_})") where "{.. 'a set" ("(1{.._})") where "{..u} == {x. x \ u}" definition greaterThan :: "'a => 'a set" ("(1{_<..})") where "{l<..} == {x. l 'a set" ("(1{_..})") where "{l..} == {x. l\x}" definition greaterThanLessThan :: "'a => 'a => 'a set" ("(1{_<..<_})") where "{l<.. 'a => 'a set" ("(1{_..<_})") where "{l.. 'a => 'a set" ("(1{_<.._})") where "{l<..u} == {l<..} Int {..u}" definition atLeastAtMost :: "'a => 'a => 'a set" ("(1{_.._})") where "{l..u} == {l..} Int {..u}" end text\A note of warning when using \<^term>\{.. on type \<^typ>\nat\: it is equivalent to \<^term>\{0::nat.. but some lemmas involving \<^term>\{m.. may not exist in \<^term>\{..-form as well.\ syntax (ASCII) "_UNION_le" :: "'a => 'a => 'b set => 'b set" ("(3UN _<=_./ _)" [0, 0, 10] 10) "_UNION_less" :: "'a => 'a => 'b set => 'b set" ("(3UN _<_./ _)" [0, 0, 10] 10) "_INTER_le" :: "'a => 'a => 'b set => 'b set" ("(3INT _<=_./ _)" [0, 0, 10] 10) "_INTER_less" :: "'a => 'a => 'b set => 'b set" ("(3INT _<_./ _)" [0, 0, 10] 10) syntax (latex output) "_UNION_le" :: "'a \ 'a => 'b set => 'b set" ("(3\(\unbreakable\_ \ _)/ _)" [0, 0, 10] 10) "_UNION_less" :: "'a \ 'a => 'b set => 'b set" ("(3\(\unbreakable\_ < _)/ _)" [0, 0, 10] 10) "_INTER_le" :: "'a \ 'a => 'b set => 'b set" ("(3\(\unbreakable\_ \ _)/ _)" [0, 0, 10] 10) "_INTER_less" :: "'a \ 'a => 'b set => 'b set" ("(3\(\unbreakable\_ < _)/ _)" [0, 0, 10] 10) syntax "_UNION_le" :: "'a => 'a => 'b set => 'b set" ("(3\_\_./ _)" [0, 0, 10] 10) "_UNION_less" :: "'a => 'a => 'b set => 'b set" ("(3\_<_./ _)" [0, 0, 10] 10) "_INTER_le" :: "'a => 'a => 'b set => 'b set" ("(3\_\_./ _)" [0, 0, 10] 10) "_INTER_less" :: "'a => 'a => 'b set => 'b set" ("(3\_<_./ _)" [0, 0, 10] 10) translations "\i\n. A" \ "\i\{..n}. A" "\i "\i\{..i\n. A" \ "\i\{..n}. A" "\i "\i\{..Various equivalences\ lemma (in ord) lessThan_iff [iff]: "(i \ lessThan k) = (i greaterThan k) = (k atLeast k) = (k<=i)" by (simp add: atLeast_def) lemma Compl_atLeast [simp]: "!!k:: 'a::linorder. -atLeast k = lessThan k" by (auto simp add: lessThan_def atLeast_def) lemma (in ord) atMost_iff [iff]: "(i \ atMost k) = (i<=k)" by (simp add: atMost_def) lemma atMost_Int_atLeast: "!!n:: 'a::order. atMost n Int atLeast n = {n}" by (blast intro: order_antisym) lemma (in linorder) lessThan_Int_lessThan: "{ a <..} \ { b <..} = { max a b <..}" by auto lemma (in linorder) greaterThan_Int_greaterThan: "{..< a} \ {..< b} = {..< min a b}" by auto subsection \Logical Equivalences for Set Inclusion and Equality\ lemma atLeast_empty_triv [simp]: "{{}..} = UNIV" by auto lemma atMost_UNIV_triv [simp]: "{..UNIV} = UNIV" by auto lemma atLeast_subset_iff [iff]: "(atLeast x \ atLeast y) = (y \ (x::'a::preorder))" by (blast intro: order_trans) lemma atLeast_eq_iff [iff]: "(atLeast x = atLeast y) = (x = (y::'a::order))" by (blast intro: order_antisym order_trans) lemma greaterThan_subset_iff [iff]: "(greaterThan x \ greaterThan y) = (y \ (x::'a::linorder))" unfolding greaterThan_def by (auto simp: linorder_not_less [symmetric]) lemma greaterThan_eq_iff [iff]: "(greaterThan x = greaterThan y) = (x = (y::'a::linorder))" by (auto simp: elim!: equalityE) lemma atMost_subset_iff [iff]: "(atMost x \ atMost y) = (x \ (y::'a::preorder))" by (blast intro: order_trans) lemma atMost_eq_iff [iff]: "(atMost x = atMost y) = (x = (y::'a::order))" by (blast intro: order_antisym order_trans) lemma lessThan_subset_iff [iff]: "(lessThan x \ lessThan y) = (x \ (y::'a::linorder))" unfolding lessThan_def by (auto simp: linorder_not_less [symmetric]) lemma lessThan_eq_iff [iff]: "(lessThan x = lessThan y) = (x = (y::'a::linorder))" by (auto simp: elim!: equalityE) lemma lessThan_strict_subset_iff: fixes m n :: "'a::linorder" shows "{.. m < n" by (metis leD lessThan_subset_iff linorder_linear not_less_iff_gr_or_eq psubset_eq) lemma (in linorder) Ici_subset_Ioi_iff: "{a ..} \ {b <..} \ b < a" by auto lemma (in linorder) Iic_subset_Iio_iff: "{.. a} \ {..< b} \ a < b" by auto lemma (in preorder) Ioi_le_Ico: "{a <..} \ {a ..}" by (auto intro: less_imp_le) subsection \Two-sided intervals\ context ord begin lemma greaterThanLessThan_iff [simp]: "(i \ {l<.. i < u)" by (simp add: greaterThanLessThan_def) lemma atLeastLessThan_iff [simp]: "(i \ {l.. i \ i < u)" by (simp add: atLeastLessThan_def) lemma greaterThanAtMost_iff [simp]: "(i \ {l<..u}) = (l < i \ i \ u)" by (simp add: greaterThanAtMost_def) lemma atLeastAtMost_iff [simp]: "(i \ {l..u}) = (l \ i \ i \ u)" by (simp add: atLeastAtMost_def) text \The above four lemmas could be declared as iffs. Unfortunately this breaks many proofs. Since it only helps blast, it is better to leave them alone.\ lemma greaterThanLessThan_eq: "{ a <..< b} = { a <..} \ {..< b }" by auto lemma (in order) atLeastLessThan_eq_atLeastAtMost_diff: "{a..Emptyness, singletons, subset\ context preorder begin lemma atLeastatMost_empty_iff[simp]: "{a..b} = {} \ (\ a \ b)" by auto (blast intro: order_trans) lemma atLeastatMost_empty_iff2[simp]: "{} = {a..b} \ (\ a \ b)" by auto (blast intro: order_trans) lemma atLeastLessThan_empty_iff[simp]: "{a.. (\ a < b)" by auto (blast intro: le_less_trans) lemma atLeastLessThan_empty_iff2[simp]: "{} = {a.. (\ a < b)" by auto (blast intro: le_less_trans) lemma greaterThanAtMost_empty_iff[simp]: "{k<..l} = {} \ \ k < l" by auto (blast intro: less_le_trans) lemma greaterThanAtMost_empty_iff2[simp]: "{} = {k<..l} \ \ k < l" by auto (blast intro: less_le_trans) lemma atLeastatMost_subset_iff[simp]: "{a..b} \ {c..d} \ (\ a \ b) \ c \ a \ b \ d" unfolding atLeastAtMost_def atLeast_def atMost_def by (blast intro: order_trans) lemma atLeastatMost_psubset_iff: "{a..b} < {c..d} \ ((\ a \ b) \ c \ a \ b \ d \ (c < a \ b < d)) \ c \ d" by(simp add: psubset_eq set_eq_iff less_le_not_le)(blast intro: order_trans) lemma atLeastAtMost_subseteq_atLeastLessThan_iff: "{a..b} \ {c ..< d} \ (a \ b \ c \ a \ b < d)" by auto (blast intro: local.order_trans local.le_less_trans elim: )+ lemma Icc_subset_Ici_iff[simp]: "{l..h} \ {l'..} = (\ l\h \ l\l')" by(auto simp: subset_eq intro: order_trans) lemma Icc_subset_Iic_iff[simp]: "{l..h} \ {..h'} = (\ l\h \ h\h')" by(auto simp: subset_eq intro: order_trans) lemma not_Ici_eq_empty[simp]: "{l..} \ {}" by(auto simp: set_eq_iff) lemma not_Iic_eq_empty[simp]: "{..h} \ {}" by(auto simp: set_eq_iff) lemmas not_empty_eq_Ici_eq_empty[simp] = not_Ici_eq_empty[symmetric] lemmas not_empty_eq_Iic_eq_empty[simp] = not_Iic_eq_empty[symmetric] end context order begin lemma atLeastatMost_empty[simp]: "b < a \ {a..b} = {}" by(auto simp: atLeastAtMost_def atLeast_def atMost_def) lemma atLeastLessThan_empty[simp]: "b \ a \ {a.. k ==> {k<..l} = {}" by(auto simp:greaterThanAtMost_def greaterThan_def atMost_def) lemma greaterThanLessThan_empty[simp]:"l \ k ==> {k<.. {a .. b} = {a}" by simp lemma Icc_eq_Icc[simp]: "{l..h} = {l'..h'} = (l=l' \ h=h' \ \ l\h \ \ l'\h')" - by(simp add: order_class.eq_iff)(auto intro: order_trans) + by (simp add: order_class.order.eq_iff) (auto intro: order_trans) lemma atLeastAtMost_singleton_iff[simp]: "{a .. b} = {c} \ a = b \ b = c" proof assume "{a..b} = {c}" hence *: "\ (\ a \ b)" unfolding atLeastatMost_empty_iff[symmetric] by simp with \{a..b} = {c}\ have "c \ a \ b \ c" by auto with * show "a = b \ b = c" by auto qed simp end context no_top begin (* also holds for no_bot but no_top should suffice *) lemma not_UNIV_le_Icc[simp]: "\ UNIV \ {l..h}" using gt_ex[of h] by(auto simp: subset_eq less_le_not_le) lemma not_UNIV_le_Iic[simp]: "\ UNIV \ {..h}" using gt_ex[of h] by(auto simp: subset_eq less_le_not_le) lemma not_Ici_le_Icc[simp]: "\ {l..} \ {l'..h'}" using gt_ex[of h'] by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans) lemma not_Ici_le_Iic[simp]: "\ {l..} \ {..h'}" using gt_ex[of h'] by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans) end context no_bot begin lemma not_UNIV_le_Ici[simp]: "\ UNIV \ {l..}" using lt_ex[of l] by(auto simp: subset_eq less_le_not_le) lemma not_Iic_le_Icc[simp]: "\ {..h} \ {l'..h'}" using lt_ex[of l'] by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans) lemma not_Iic_le_Ici[simp]: "\ {..h} \ {l'..}" using lt_ex[of l'] by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans) end context no_top begin (* also holds for no_bot but no_top should suffice *) lemma not_UNIV_eq_Icc[simp]: "\ UNIV = {l'..h'}" using gt_ex[of h'] by(auto simp: set_eq_iff less_le_not_le) lemmas not_Icc_eq_UNIV[simp] = not_UNIV_eq_Icc[symmetric] lemma not_UNIV_eq_Iic[simp]: "\ UNIV = {..h'}" using gt_ex[of h'] by(auto simp: set_eq_iff less_le_not_le) lemmas not_Iic_eq_UNIV[simp] = not_UNIV_eq_Iic[symmetric] lemma not_Icc_eq_Ici[simp]: "\ {l..h} = {l'..}" unfolding atLeastAtMost_def using not_Ici_le_Iic[of l'] by blast lemmas not_Ici_eq_Icc[simp] = not_Icc_eq_Ici[symmetric] (* also holds for no_bot but no_top should suffice *) lemma not_Iic_eq_Ici[simp]: "\ {..h} = {l'..}" using not_Ici_le_Iic[of l' h] by blast lemmas not_Ici_eq_Iic[simp] = not_Iic_eq_Ici[symmetric] end context no_bot begin lemma not_UNIV_eq_Ici[simp]: "\ UNIV = {l'..}" using lt_ex[of l'] by(auto simp: set_eq_iff less_le_not_le) lemmas not_Ici_eq_UNIV[simp] = not_UNIV_eq_Ici[symmetric] lemma not_Icc_eq_Iic[simp]: "\ {l..h} = {..h'}" unfolding atLeastAtMost_def using not_Iic_le_Ici[of h'] by blast lemmas not_Iic_eq_Icc[simp] = not_Icc_eq_Iic[symmetric] end context dense_linorder begin lemma greaterThanLessThan_empty_iff[simp]: "{ a <..< b } = {} \ b \ a" using dense[of a b] by (cases "a < b") auto lemma greaterThanLessThan_empty_iff2[simp]: "{} = { a <..< b } \ b \ a" using dense[of a b] by (cases "a < b") auto lemma atLeastLessThan_subseteq_atLeastAtMost_iff: "{a ..< b} \ { c .. d } \ (a < b \ c \ a \ b \ d)" using dense[of "max a d" "b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanAtMost_subseteq_atLeastAtMost_iff: "{a <.. b} \ { c .. d } \ (a < b \ c \ a \ b \ d)" using dense[of "a" "min c b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanLessThan_subseteq_atLeastAtMost_iff: "{a <..< b} \ { c .. d } \ (a < b \ c \ a \ b \ d)" using dense[of "a" "min c b"] dense[of "max a d" "b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanLessThan_subseteq_greaterThanLessThan: "{a <..< b} \ {c <..< d} \ (a < b \ a \ c \ b \ d)" using dense[of "a" "min c b"] dense[of "max a d" "b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanAtMost_subseteq_atLeastLessThan_iff: "{a <.. b} \ { c ..< d } \ (a < b \ c \ a \ b < d)" using dense[of "a" "min c b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanLessThan_subseteq_atLeastLessThan_iff: "{a <..< b} \ { c ..< d } \ (a < b \ c \ a \ b \ d)" using dense[of "a" "min c b"] dense[of "max a d" "b"] by (force simp: subset_eq Ball_def not_less[symmetric]) lemma greaterThanLessThan_subseteq_greaterThanAtMost_iff: "{a <..< b} \ { c <.. d } \ (a < b \ c \ a \ b \ d)" using dense[of "a" "min c b"] dense[of "max a d" "b"] by (force simp: subset_eq Ball_def not_less[symmetric]) end context no_top begin lemma greaterThan_non_empty[simp]: "{x <..} \ {}" using gt_ex[of x] by auto end context no_bot begin lemma lessThan_non_empty[simp]: "{..< x} \ {}" using lt_ex[of x] by auto end lemma (in linorder) atLeastLessThan_subset_iff: "{a.. {c.. b \ a \ c\a \ b\d" apply (auto simp:subset_eq Ball_def not_le) apply(frule_tac x=a in spec) apply(erule_tac x=d in allE) apply (auto simp: ) done lemma atLeastLessThan_inj: fixes a b c d :: "'a::linorder" assumes eq: "{a ..< b} = {c ..< d}" and "a < b" "c < d" shows "a = c" "b = d" using assms by (metis atLeastLessThan_subset_iff eq less_le_not_le antisym_conv2 subset_refl)+ lemma atLeastLessThan_eq_iff: fixes a b c d :: "'a::linorder" assumes "a < b" "c < d" shows "{a ..< b} = {c ..< d} \ a = c \ b = d" using atLeastLessThan_inj assms by auto -lemma (in linorder) Ioc_inj: "{a <.. b} = {c <.. d} \ (b \ a \ d \ c) \ a = c \ b = d" - by (metis eq_iff greaterThanAtMost_empty_iff2 greaterThanAtMost_iff le_cases not_le) +lemma (in linorder) Ioc_inj: + \{a <.. b} = {c <.. d} \ (b \ a \ d \ c) \ a = c \ b = d\ (is \?P \ ?Q\) +proof + assume ?Q + then show ?P + by auto +next + assume ?P + then have \a < x \ x \ b \ c < x \ x \ d\ for x + by (simp add: set_eq_iff) + from this [of a] this [of b] this [of c] this [of d] show ?Q + by auto +qed lemma (in order) Iio_Int_singleton: "{.. {x} = (if x < k then {x} else {})" by auto lemma (in linorder) Ioc_subset_iff: "{a<..b} \ {c<..d} \ (b \ a \ c \ a \ b \ d)" by (auto simp: subset_eq Ball_def) (metis less_le not_less) lemma (in order_bot) atLeast_eq_UNIV_iff: "{x..} = UNIV \ x = bot" by (auto simp: set_eq_iff intro: le_bot) lemma (in order_top) atMost_eq_UNIV_iff: "{..x} = UNIV \ x = top" by (auto simp: set_eq_iff intro: top_le) lemma (in bounded_lattice) atLeastAtMost_eq_UNIV_iff: "{x..y} = UNIV \ (x = bot \ y = top)" by (auto simp: set_eq_iff intro: top_le le_bot) lemma Iio_eq_empty_iff: "{..< n::'a::{linorder, order_bot}} = {} \ n = bot" by (auto simp: set_eq_iff not_less le_bot) lemma lessThan_empty_iff: "{..< n::nat} = {} \ n = 0" by (simp add: Iio_eq_empty_iff bot_nat_def) lemma mono_image_least: assumes f_mono: "mono f" and f_img: "f ` {m ..< n} = {m' ..< n'}" "m < n" shows "f m = m'" proof - from f_img have "{m' ..< n'} \ {}" by (metis atLeastLessThan_empty_iff image_is_empty) with f_img have "m' \ f ` {m ..< n}" by auto then obtain k where "f k = m'" "m \ k" by auto moreover have "m' \ f m" using f_img by auto ultimately show "f m = m'" using f_mono by (auto elim: monoE[where x=m and y=k]) qed subsection \Infinite intervals\ context dense_linorder begin lemma infinite_Ioo: assumes "a < b" shows "\ finite {a<.. {}" using \a < b\ by auto ultimately have "a < Max {a <..< b}" "Max {a <..< b} < b" using Max_in[of "{a <..< b}"] by auto then obtain x where "Max {a <..< b} < x" "x < b" using dense[of "Max {a<.. {a <..< b}" using \a < Max {a <..< b}\ by auto then have "x \ Max {a <..< b}" using fin by auto with \Max {a <..< b} < x\ show False by auto qed lemma infinite_Icc: "a < b \ \ finite {a .. b}" using greaterThanLessThan_subseteq_atLeastAtMost_iff[of a b a b] infinite_Ioo[of a b] by (auto dest: finite_subset) lemma infinite_Ico: "a < b \ \ finite {a ..< b}" using greaterThanLessThan_subseteq_atLeastLessThan_iff[of a b a b] infinite_Ioo[of a b] by (auto dest: finite_subset) lemma infinite_Ioc: "a < b \ \ finite {a <.. b}" using greaterThanLessThan_subseteq_greaterThanAtMost_iff[of a b a b] infinite_Ioo[of a b] by (auto dest: finite_subset) lemma infinite_Ioo_iff [simp]: "infinite {a<.. a < b" using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioo) lemma infinite_Icc_iff [simp]: "infinite {a .. b} \ a < b" using not_less_iff_gr_or_eq by (fastforce simp: infinite_Icc) lemma infinite_Ico_iff [simp]: "infinite {a.. a < b" using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ico) lemma infinite_Ioc_iff [simp]: "infinite {a<..b} \ a < b" using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioc) end lemma infinite_Iio: "\ finite {..< a :: 'a :: {no_bot, linorder}}" proof assume "finite {..< a}" then have *: "\x. x < a \ Min {..< a} \ x" by auto obtain x where "x < a" using lt_ex by auto obtain y where "y < Min {..< a}" using lt_ex by auto also have "Min {..< a} \ x" using \x < a\ by fact also note \x < a\ finally have "Min {..< a} \ y" by fact with \y < Min {..< a}\ show False by auto qed lemma infinite_Iic: "\ finite {.. a :: 'a :: {no_bot, linorder}}" using infinite_Iio[of a] finite_subset[of "{..< a}" "{.. a}"] by (auto simp: subset_eq less_imp_le) lemma infinite_Ioi: "\ finite {a :: 'a :: {no_top, linorder} <..}" proof assume "finite {a <..}" then have *: "\x. a < x \ x \ Max {a <..}" by auto obtain y where "Max {a <..} < y" using gt_ex by auto obtain x where x: "a < x" using gt_ex by auto also from x have "x \ Max {a <..}" by fact also note \Max {a <..} < y\ finally have "y \ Max { a <..}" by fact with \Max {a <..} < y\ show False by auto qed lemma infinite_Ici: "\ finite {a :: 'a :: {no_top, linorder} ..}" using infinite_Ioi[of a] finite_subset[of "{a <..}" "{a ..}"] by (auto simp: subset_eq less_imp_le) subsubsection \Intersection\ context linorder begin lemma Int_atLeastAtMost[simp]: "{a..b} Int {c..d} = {max a c .. min b d}" by auto lemma Int_atLeastAtMostR1[simp]: "{..b} Int {c..d} = {c .. min b d}" by auto lemma Int_atLeastAtMostR2[simp]: "{a..} Int {c..d} = {max a c .. d}" by auto lemma Int_atLeastAtMostL1[simp]: "{a..b} Int {..d} = {a .. min b d}" by auto lemma Int_atLeastAtMostL2[simp]: "{a..b} Int {c..} = {max a c .. b}" by auto lemma Int_atLeastLessThan[simp]: "{a.. {..b} = {.. min a b}" by (auto simp: min_def) lemma Ioc_disjoint: "{a<..b} \ {c<..d} = {} \ b \ a \ d \ c \ b \ c \ d \ a" by auto end context complete_lattice begin lemma shows Sup_atLeast[simp]: "Sup {x ..} = top" and Sup_greaterThanAtLeast[simp]: "x < top \ Sup {x <..} = top" and Sup_atMost[simp]: "Sup {.. y} = y" and Sup_atLeastAtMost[simp]: "x \ y \ Sup { x .. y} = y" and Sup_greaterThanAtMost[simp]: "x < y \ Sup { x <.. y} = y" by (auto intro!: Sup_eqI) lemma shows Inf_atMost[simp]: "Inf {.. x} = bot" and Inf_atMostLessThan[simp]: "top < x \ Inf {..< x} = bot" and Inf_atLeast[simp]: "Inf {x ..} = x" and Inf_atLeastAtMost[simp]: "x \ y \ Inf { x .. y} = x" and Inf_atLeastLessThan[simp]: "x < y \ Inf { x ..< y} = x" by (auto intro!: Inf_eqI) end lemma fixes x y :: "'a :: {complete_lattice, dense_linorder}" shows Sup_lessThan[simp]: "Sup {..< y} = y" and Sup_atLeastLessThan[simp]: "x < y \ Sup { x ..< y} = y" and Sup_greaterThanLessThan[simp]: "x < y \ Sup { x <..< y} = y" and Inf_greaterThan[simp]: "Inf {x <..} = x" and Inf_greaterThanAtMost[simp]: "x < y \ Inf { x <.. y} = x" and Inf_greaterThanLessThan[simp]: "x < y \ Inf { x <..< y} = x" by (auto intro!: Inf_eqI Sup_eqI intro: dense_le dense_le_bounded dense_ge dense_ge_bounded) subsection \Intervals of natural numbers\ subsubsection \The Constant \<^term>\lessThan\\ lemma lessThan_0 [simp]: "lessThan (0::nat) = {}" by (simp add: lessThan_def) lemma lessThan_Suc: "lessThan (Suc k) = insert k (lessThan k)" by (simp add: lessThan_def less_Suc_eq, blast) text \The following proof is convenient in induction proofs where new elements get indices at the beginning. So it is used to transform \<^term>\{.. to \<^term>\0::nat\ and \<^term>\{..< n}\.\ lemma zero_notin_Suc_image [simp]: "0 \ Suc ` A" by auto lemma lessThan_Suc_eq_insert_0: "{..m::nat. lessThan m) = UNIV" by blast subsubsection \The Constant \<^term>\greaterThan\\ lemma greaterThan_0: "greaterThan 0 = range Suc" unfolding greaterThan_def by (blast dest: gr0_conv_Suc [THEN iffD1]) lemma greaterThan_Suc: "greaterThan (Suc k) = greaterThan k - {Suc k}" unfolding greaterThan_def by (auto elim: linorder_neqE) lemma INT_greaterThan_UNIV: "(\m::nat. greaterThan m) = {}" by blast subsubsection \The Constant \<^term>\atLeast\\ lemma atLeast_0 [simp]: "atLeast (0::nat) = UNIV" by (unfold atLeast_def UNIV_def, simp) lemma atLeast_Suc: "atLeast (Suc k) = atLeast k - {k}" unfolding atLeast_def by (auto simp: order_le_less Suc_le_eq) lemma atLeast_Suc_greaterThan: "atLeast (Suc k) = greaterThan k" by (auto simp add: greaterThan_def atLeast_def less_Suc_eq_le) lemma UN_atLeast_UNIV: "(\m::nat. atLeast m) = UNIV" by blast subsubsection \The Constant \<^term>\atMost\\ lemma atMost_0 [simp]: "atMost (0::nat) = {0}" by (simp add: atMost_def) lemma atMost_Suc: "atMost (Suc k) = insert (Suc k) (atMost k)" unfolding atMost_def by (auto simp add: less_Suc_eq order_le_less) lemma UN_atMost_UNIV: "(\m::nat. atMost m) = UNIV" by blast subsubsection \The Constant \<^term>\atLeastLessThan\\ text\The orientation of the following 2 rules is tricky. The lhs is defined in terms of the rhs. Hence the chosen orientation makes sense in this theory --- the reverse orientation complicates proofs (eg nontermination). But outside, when the definition of the lhs is rarely used, the opposite orientation seems preferable because it reduces a specific concept to a more general one.\ lemma atLeast0LessThan [code_abbrev]: "{0::nat..The Constant \<^term>\atLeastAtMost\\ lemma Icc_eq_insert_lb_nat: "m \ n \ {m..n} = insert m {Suc m..n}" by auto lemma atLeast0_atMost_Suc: "{0..Suc n} = insert (Suc n) {0..n}" by (simp add: atLeast0AtMost atMost_Suc) lemma atLeast0_atMost_Suc_eq_insert_0: "{0..Suc n} = insert 0 (Suc ` {0..n})" by (simp add: atLeast0AtMost atMost_Suc_eq_insert_0) subsubsection \Intervals of nats with \<^term>\Suc\\ text\Not a simprule because the RHS is too messy.\ lemma atLeastLessThanSuc: "{m.. n then insert n {m.. Suc n \ {m..Suc n} = insert (Suc n) {m..n}" by auto lemma atLeastAtMost_insertL: "m \ n \ insert m {Suc m..n} = {m ..n}" by auto text \The analogous result is useful on \<^typ>\int\:\ (* here, because we don't have an own int section *) lemma atLeastAtMostPlus1_int_conv: "m \ 1+n \ {m..1+n} = insert (1+n) {m..n::int}" by (auto intro: set_eqI) lemma atLeastLessThan_add_Un: "i \ j \ {i.. {j..Intervals and numerals\ lemma lessThan_nat_numeral: \ \Evaluation for specific numerals\ "lessThan (numeral k :: nat) = insert (pred_numeral k) (lessThan (pred_numeral k))" by (simp add: numeral_eq_Suc lessThan_Suc) lemma atMost_nat_numeral: \ \Evaluation for specific numerals\ "atMost (numeral k :: nat) = insert (numeral k) (atMost (pred_numeral k))" by (simp add: numeral_eq_Suc atMost_Suc) lemma atLeastLessThan_nat_numeral: \ \Evaluation for specific numerals\ "atLeastLessThan m (numeral k :: nat) = (if m \ (pred_numeral k) then insert (pred_numeral k) (atLeastLessThan m (pred_numeral k)) else {})" by (simp add: numeral_eq_Suc atLeastLessThanSuc) subsubsection \Image\ context linordered_semidom begin lemma image_add_atLeast[simp]: "plus k ` {i..} = {k + i..}" proof - have "n = k + (n - k)" if "i + k \ n" for n proof - have "n = (n - (k + i)) + (k + i)" using that by (metis add_commute le_add_diff_inverse) then show "n = k + (n - k)" by (metis local.add_diff_cancel_left' add_assoc add_commute) qed then show ?thesis by (fastforce simp: add_le_imp_le_diff add.commute) qed lemma image_add_atLeastAtMost [simp]: "plus k ` {i..j} = {i + k..j + k}" (is "?A = ?B") proof show "?A \ ?B" by (auto simp add: ac_simps) next show "?B \ ?A" proof fix n assume "n \ ?B" then have "i \ n - k" by (simp add: add_le_imp_le_diff) have "n = n - k + k" proof - from \n \ ?B\ have "n = n - (i + k) + (i + k)" by simp also have "\ = n - k - i + i + k" by (simp add: algebra_simps) also have "\ = n - k + k" using \i \ n - k\ by simp finally show ?thesis . qed moreover have "n - k \ {i..j}" using \n \ ?B\ by (auto simp: add_le_imp_le_diff add_le_add_imp_diff_le) ultimately show "n \ ?A" by (simp add: ac_simps) qed qed lemma image_add_atLeastAtMost' [simp]: "(\n. n + k) ` {i..j} = {i + k..j + k}" by (simp add: add.commute [of _ k]) lemma image_add_atLeastLessThan [simp]: "plus k ` {i..n. n + k) ` {i.. uminus ` {x<..}" by (rule imageI) (simp add: *) thus "y \ uminus ` {x<..}" by simp next fix y assume "y \ -x" have "- (-y) \ uminus ` {x..}" by (rule imageI) (insert \y \ -x\[THEN le_imp_neg_le], simp) thus "y \ uminus ` {x..}" by simp qed simp_all lemma fixes x :: 'a shows image_uminus_lessThan[simp]: "uminus ` {.. = {c - b<..c - a}" by simp finally show ?thesis by simp qed lemma image_minus_const_greaterThanAtMost[simp]: fixes a b c::"'a::linordered_idom" shows "(-) c ` {a<..b} = {c - b.. = {c - b.. = {..c - a}" by simp finally show ?thesis by simp qed lemma image_minus_const_AtMost[simp]: fixes b c::"'a::linordered_idom" shows "(-) c ` {..b} = {c - b..}" proof - have "(-) c ` {..b} = (+) c ` uminus ` {..b}" unfolding image_image by simp also have "\ = {c - b..}" by simp finally show ?thesis by simp qed lemma image_minus_const_atLeastAtMost' [simp]: "(\t. t-d)`{a..b} = {a-d..b-d}" for d::"'a::linordered_idom" by (metis (no_types, lifting) diff_conv_add_uminus image_add_atLeastAtMost' image_cong) context linordered_field begin lemma image_mult_atLeastAtMost [simp]: "((*) d ` {a..b}) = {d*a..d*b}" if "d>0" using that by (auto simp: field_simps mult_le_cancel_right intro: rev_image_eqI [where x="x/d" for x]) lemma image_divide_atLeastAtMost [simp]: "((\c. c / d) ` {a..b}) = {a/d..b/d}" if "d>0" proof - from that have "inverse d > 0" by simp with image_mult_atLeastAtMost [of "inverse d" a b] have "(*) (inverse d) ` {a..b} = {inverse d * a..inverse d * b}" by blast moreover have "(*) (inverse d) = (\c. c / d)" by (simp add: fun_eq_iff field_simps) ultimately show ?thesis by simp qed lemma image_mult_atLeastAtMost_if: "(*) c ` {x .. y} = (if c > 0 then {c * x .. c * y} else if x \ y then {c * y .. c * x} else {})" proof (cases "c = 0 \ x > y") case True then show ?thesis by auto next case False then have "x \ y" by auto from False consider "c < 0"| "c > 0" by (auto simp add: neq_iff) then show ?thesis proof cases case 1 have "(*) c ` {x..y} = {c * y..c * x}" proof (rule set_eqI) fix d from 1 have "inj (\z. z / c)" by (auto intro: injI) then have "d \ (*) c ` {x..y} \ d / c \ (\z. z div c) ` (*) c ` {x..y}" by (subst inj_image_mem_iff) simp_all also have "\ \ d / c \ {x..y}" using 1 by (simp add: image_image) also have "\ \ d \ {c * y..c * x}" by (auto simp add: field_simps 1) finally show "d \ (*) c ` {x..y} \ d \ {c * y..c * x}" . qed with \x \ y\ show ?thesis by auto qed (simp add: mult_left_mono_neg) qed lemma image_mult_atLeastAtMost_if': "(\x. x * c) ` {x..y} = (if x \ y then if c > 0 then {x * c .. y * c} else {y * c .. x * c} else {})" using image_mult_atLeastAtMost_if [of c x y] by (auto simp add: ac_simps) lemma image_affinity_atLeastAtMost: "((\x. m * x + c) ` {a..b}) = (if {a..b} = {} then {} else if 0 \ m then {m * a + c .. m * b + c} else {m * b + c .. m * a + c})" proof - have *: "(\x. m * x + c) = ((\x. x + c) \ (*) m)" by (simp add: fun_eq_iff) show ?thesis by (simp only: * image_comp [symmetric] image_mult_atLeastAtMost_if) (auto simp add: mult_le_cancel_left) qed lemma image_affinity_atLeastAtMost_diff: "((\x. m*x - c) ` {a..b}) = (if {a..b}={} then {} else if 0 \ m then {m*a - c .. m*b - c} else {m*b - c .. m*a - c})" using image_affinity_atLeastAtMost [of m "-c" a b] by simp lemma image_affinity_atLeastAtMost_div: "((\x. x/m + c) ` {a..b}) = (if {a..b}={} then {} else if 0 \ m then {a/m + c .. b/m + c} else {b/m + c .. a/m + c})" using image_affinity_atLeastAtMost [of "inverse m" c a b] by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide) lemma image_affinity_atLeastAtMost_div_diff: "((\x. x/m - c) ` {a..b}) = (if {a..b}={} then {} else if 0 \ m then {a/m - c .. b/m - c} else {b/m - c .. a/m - c})" using image_affinity_atLeastAtMost_diff [of "inverse m" c a b] by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide) end lemma atLeast1_lessThan_eq_remove0: "{Suc 0..x. x + (l::int)) ` {0..i. i - c) ` {x ..< y} = (if c < y then {x - c ..< y - c} else if x < y then {0} else {})" (is "_ = ?right") proof safe fix a assume a: "a \ ?right" show "a \ (\i. i - c) ` {x ..< y}" proof cases assume "c < y" with a show ?thesis by (auto intro!: image_eqI[of _ _ "a + c"]) next assume "\ c < y" with a show ?thesis by (auto intro!: image_eqI[of _ _ x] split: if_split_asm) qed qed auto lemma image_int_atLeastLessThan: "int ` {a..Finiteness\ lemma finite_lessThan [iff]: fixes k :: nat shows "finite {..A bounded set of natural numbers is finite.\ lemma bounded_nat_set_is_finite: "(\i\N. i < (n::nat)) \ finite N" by (rule finite_subset [OF _ finite_lessThan]) auto text \A set of natural numbers is finite iff it is bounded.\ lemma finite_nat_set_iff_bounded: "finite(N::nat set) = (\m. \n\N. n?F\, simplified less_Suc_eq_le[symmetric]] by blast next assume ?B show ?F using \?B\ by(blast intro:bounded_nat_set_is_finite) qed lemma finite_nat_set_iff_bounded_le: "finite(N::nat set) = (\m. \n\N. n\m)" unfolding finite_nat_set_iff_bounded by (blast dest:less_imp_le_nat le_imp_less_Suc) lemma finite_less_ub: "!!f::nat=>nat. (!!n. n \ f n) ==> finite {n. f n \ u}" by (rule_tac B="{..u}" in finite_subset, auto intro: order_trans) lemma bounded_Max_nat: fixes P :: "nat \ bool" assumes x: "P x" and M: "\x. P x \ x \ M" obtains m where "P m" "\x. P x \ x \ m" proof - have "finite {x. P x}" using M finite_nat_set_iff_bounded_le by auto then have "Max {x. P x} \ {x. P x}" using Max_in x by auto then show ?thesis by (simp add: \finite {x. P x}\ that) qed text\Any subset of an interval of natural numbers the size of the subset is exactly that interval.\ lemma subset_card_intvl_is_intvl: assumes "A \ {k.. A" by auto with insert have "A \ {k..Proving Inclusions and Equalities between Unions\ lemma UN_le_eq_Un0: "(\i\n::nat. M i) = (\i\{1..n}. M i) \ M 0" (is "?A = ?B") proof show "?A \ ?B" proof fix x assume "x \ ?A" then obtain i where i: "i\n" "x \ M i" by auto show "x \ ?B" proof(cases i) case 0 with i show ?thesis by simp next case (Suc j) with i show ?thesis by auto qed qed next show "?B \ ?A" by fastforce qed lemma UN_le_add_shift: "(\i\n::nat. M(i+k)) = (\i\{k..n+k}. M i)" (is "?A = ?B") proof show "?A \ ?B" by fastforce next show "?B \ ?A" proof fix x assume "x \ ?B" then obtain i where i: "i \ {k..n+k}" "x \ M(i)" by auto hence "i-k\n \ x \ M((i-k)+k)" by auto thus "x \ ?A" by blast qed qed lemma UN_le_add_shift_strict: "(\ii\{k.. ?A" proof fix x assume "x \ ?B" then obtain i where i: "i \ {k.. M(i)" by auto then have "i - k < n \ x \ M((i-k) + k)" by auto then show "x \ ?A" using UN_le_add_shift by blast qed qed (fastforce) lemma UN_UN_finite_eq: "(\n::nat. \i\{0..n. A n)" by (auto simp add: atLeast0LessThan) lemma UN_finite_subset: "(\n::nat. (\i\{0.. C) \ (\n. A n) \ C" by (subst UN_UN_finite_eq [symmetric]) blast lemma UN_finite2_subset: assumes "\n::nat. (\i\{0.. (\i\{0..n. A n) \ (\n. B n)" proof (rule UN_finite_subset, rule) fix n and a from assms have "(\i\{0.. (\i\{0.. (\i\{0.. (\i\{0.. (\i. B i)" by (auto simp add: UN_UN_finite_eq) qed lemma UN_finite2_eq: "(\n::nat. (\i\{0..i\{0.. (\n. A n) = (\n. B n)" apply (rule subset_antisym [OF UN_finite_subset UN_finite2_subset]) apply auto apply (force simp add: atLeastLessThan_add_Un [of 0])+ done subsubsection \Cardinality\ lemma card_lessThan [simp]: "card {..x. x + l) ` {.. {0.. {0..n}" shows "finite N" using assms finite_atLeastAtMost by (rule finite_subset) lemma ex_bij_betw_nat_finite: "finite M \ \h. bij_betw h {0.. \h. bij_betw h M {0.. finite B \ card A = card B \ \h. bij_betw h A B" apply(drule ex_bij_betw_finite_nat) apply(drule ex_bij_betw_nat_finite) apply(auto intro!:bij_betw_trans) done lemma ex_bij_betw_nat_finite_1: "finite M \ \h. bij_betw h {1 .. card M} M" by (rule finite_same_card_bij) auto lemma bij_betw_iff_card: assumes "finite A" "finite B" shows "(\f. bij_betw f A B) \ (card A = card B)" proof assume "card A = card B" moreover obtain f where "bij_betw f A {0 ..< card A}" using assms ex_bij_betw_finite_nat by blast moreover obtain g where "bij_betw g {0 ..< card B} B" using assms ex_bij_betw_nat_finite by blast ultimately have "bij_betw (g \ f) A B" by (auto simp: bij_betw_trans) thus "(\f. bij_betw f A B)" by blast qed (auto simp: bij_betw_same_card) lemma subset_eq_atLeast0_lessThan_card: fixes n :: nat assumes "N \ {0.. n" proof - from assms finite_lessThan have "card N \ card {0..Relational version of @{thm [source] card_inj_on_le}:\ lemma card_le_if_inj_on_rel: assumes "finite B" "\a. a \ A \ \b. b\B \ r a b" "\a1 a2 b. \ a1 \ A; a2 \ A; b \ B; r a1 b; r a2 b \ \ a1 = a2" shows "card A \ card B" proof - let ?P = "\a b. b \ B \ r a b" let ?f = "\a. SOME b. ?P a b" have 1: "?f ` A \ B" by (auto intro: someI2_ex[OF assms(2)]) have "inj_on ?f A" proof (auto simp: inj_on_def) fix a1 a2 assume asms: "a1 \ A" "a2 \ A" "?f a1 = ?f a2" have 0: "?f a1 \ B" using "1" \a1 \ A\ by blast have 1: "r a1 (?f a1)" using someI_ex[OF assms(2)[OF \a1 \ A\]] by blast have 2: "r a2 (?f a1)" using someI_ex[OF assms(2)[OF \a2 \ A\]] asms(3) by auto show "a1 = a2" using assms(3)[OF asms(1,2) 0 1 2] . qed with 1 show ?thesis using card_inj_on_le[of ?f A B] assms(1) by simp qed subsection \Intervals of integers\ lemma atLeastLessThanPlusOne_atLeastAtMost_int: "{l..Finiteness\ lemma image_atLeastZeroLessThan_int: "0 \ u ==> {(0::int).. u") case True then show ?thesis by (auto simp: image_atLeastZeroLessThan_int) qed auto lemma finite_atLeastLessThan_int [iff]: "finite {l..Cardinality\ lemma card_atLeastZeroLessThan_int: "card {(0::int).. u") case True then show ?thesis by (auto simp: image_atLeastZeroLessThan_int card_image inj_on_def) qed auto lemma card_atLeastLessThan_int [simp]: "card {l.. k < (i::nat)}" proof - have "{k. P k \ k < i} \ {.. M" shows "card {k \ M. k < Suc i} \ 0" proof - from zero_in_M have "{k \ M. k < Suc i} \ {}" by auto with finite_M_bounded_by_nat show ?thesis by (auto simp add: card_eq_0_iff) qed lemma card_less_Suc2: assumes "0 \ M" shows "card {k. Suc k \ M \ k < i} = card {k \ M. k < Suc i}" proof - have *: "\j \ M; j < Suc i\ \ j - Suc 0 < i \ Suc (j - Suc 0) \ M \ Suc 0 \ j" for j by (cases j) (use assms in auto) show ?thesis proof (rule card_bij_eq) show "inj_on Suc {k. Suc k \ M \ k < i}" by force show "inj_on (\x. x - Suc 0) {k \ M. k < Suc i}" by (rule inj_on_diff_nat) (use * in blast) qed (use * in auto) qed lemma card_less_Suc: assumes "0 \ M" shows "Suc (card {k. Suc k \ M \ k < i}) = card {k \ M. k < Suc i}" proof - have "Suc (card {k. Suc k \ M \ k < i}) = Suc (card {k. Suc k \ M - {0} \ k < i})" by simp also have "\ = Suc (card {k \ M - {0}. k < Suc i})" apply (subst card_less_Suc2) using assms by auto also have "\ = Suc (card ({k \ M. k < Suc i} - {0}))" by (force intro: arg_cong [where f=card]) also have "\ = card (insert 0 ({k \ M. k < Suc i} - {0}))" by (simp add: card.insert_remove) also have "... = card {k \ M. k < Suc i}" using assms by (force simp add: intro: arg_cong [where f=card]) finally show ?thesis. qed lemma card_le_Suc_Max: "finite S \ card S \ Suc (Max S)" proof (rule classical) assume "finite S" and "\ Suc (Max S) \ card S" then have "Suc (Max S) < card S" by simp with `finite S` have "S \ {0..Max S}" by auto hence "card S \ card {0..Max S}" by (intro card_mono; auto) thus "card S \ Suc (Max S)" by simp qed subsection \Lemmas useful with the summation operator sum\ text \For examples, see Algebra/poly/UnivPoly2.thy\ subsubsection \Disjoint Unions\ text \Singletons and open intervals\ lemma ivl_disj_un_singleton: "{l::'a::linorder} Un {l<..} = {l..}" "{.. {l} Un {l<.. {l<.. u ==> {l} Un {l<..u} = {l..u}" "(l::'a::linorder) \ u ==> {l..One- and two-sided intervals\ lemma ivl_disj_un_one: "(l::'a::linorder) < u ==> {..l} Un {l<.. u ==> {.. u ==> {..l} Un {l<..u} = {..u}" "(l::'a::linorder) \ u ==> {.. u ==> {l<..u} Un {u<..} = {l<..}" "(l::'a::linorder) < u ==> {l<.. u ==> {l..u} Un {u<..} = {l..}" "(l::'a::linorder) \ u ==> {l..Two- and two-sided intervals\ lemma ivl_disj_un_two: "[| (l::'a::linorder) < m; m \ u |] ==> {l<.. m; m < u |] ==> {l<..m} Un {m<.. m; m \ u |] ==> {l.. m; m < u |] ==> {l..m} Un {m<.. u |] ==> {l<.. m; m \ u |] ==> {l<..m} Un {m<..u} = {l<..u}" "[| (l::'a::linorder) \ m; m \ u |] ==> {l.. m; m \ u |] ==> {l..m} Un {m<..u} = {l..u}" by auto lemma ivl_disj_un_two_touch: "[| (l::'a::linorder) < m; m < u |] ==> {l<..m} Un {m.. m; m < u |] ==> {l..m} Un {m.. u |] ==> {l<..m} Un {m..u} = {l<..u}" "[| (l::'a::linorder) \ m; m \ u |] ==> {l..m} Un {m..u} = {l..u}" by auto lemmas ivl_disj_un = ivl_disj_un_singleton ivl_disj_un_one ivl_disj_un_two ivl_disj_un_two_touch subsubsection \Disjoint Intersections\ text \One- and two-sided intervals\ lemma ivl_disj_int_one: "{..l::'a::order} Int {l<..Two- and two-sided intervals\ lemma ivl_disj_int_two: "{l::'a::order<..Some Differences\ lemma ivl_diff[simp]: "i \ n \ {i..Some Subset Conditions\ lemma ivl_subset [simp]: "({i.. {m.. i \ m \ i \ j \ (n::'a::linorder))" using linorder_class.le_less_linear[of i n] apply (auto simp: linorder_not_le) apply (force intro: leI)+ done lemma obtain_subset_with_card_n: assumes "n \ card S" obtains T where "T \ S" "card T = n" "finite T" proof - obtain n' where "card S = n + n'" by (metis assms le_add_diff_inverse) with that show thesis proof (induct n' arbitrary: S) case 0 then show ?case by (cases "finite S") auto next case Suc then show ?case by (simp add: card_Suc_eq) (metis subset_insertI2) qed qed subsection \Generic big monoid operation over intervals\ context semiring_char_0 begin lemma inj_on_of_nat [simp]: "inj_on of_nat N" by rule simp lemma bij_betw_of_nat [simp]: "bij_betw of_nat N A \ of_nat ` N = A" by (simp add: bij_betw_def) end context comm_monoid_set begin lemma atLeastLessThan_reindex: "F g {h m.. h) {m.. h) {m..n}" if "bij_betw h {m..n} {h m..h n}" for m n ::nat proof - from that have "inj_on h {m..n}" and "h ` {m..n} = {h m..h n}" by (simp_all add: bij_betw_def) then show ?thesis using reindex [of h "{m..n}" g] by simp qed lemma atLeastLessThan_shift_bounds: "F g {m + k.. plus k) {m.. plus k) {m..n}" for m n k :: nat using atLeastAtMost_reindex [of "plus k" m n g] by (simp add: ac_simps) lemma atLeast_Suc_lessThan_Suc_shift: "F g {Suc m.. Suc) {m.. Suc) {m..n}" using atLeastAtMost_shift_bounds [of _ _ 1] by (simp add: plus_1_eq_Suc) lemma atLeast_int_lessThan_int_shift: "F g {int m.. int) {m.. int) {m..n}" by (rule atLeastAtMost_reindex) (simp add: image_int_atLeastAtMost) lemma atLeast0_lessThan_Suc: "F g {0..* g n" by (simp add: atLeast0_lessThan_Suc ac_simps) lemma atLeast0_atMost_Suc: "F g {0..Suc n} = F g {0..n} \<^bold>* g (Suc n)" by (simp add: atLeast0_atMost_Suc ac_simps) lemma atLeast0_lessThan_Suc_shift: "F g {0..* F (g \ Suc) {0..* F (g \ Suc) {0..n}" by (simp add: atLeast0_atMost_Suc_eq_insert_0 atLeast_Suc_atMost_Suc_shift) lemma atLeast_Suc_lessThan: "F g {m..* F g {Suc m..* F g {Suc m..n}" if "m \ n" proof - from that have "{m..n} = insert m {Suc m..n}" by auto then show ?thesis by simp qed lemma ivl_cong: "a = c \ b = d \ (\x. c \ x \ x < d \ g x = h x) \ F g {a.. plus m) {0.. n") simp_all lemma atLeastAtMost_shift_0: fixes m n p :: nat assumes "m \ n" shows "F g {m..n} = F (g \ plus m) {0..n - m}" using assms atLeastAtMost_shift_bounds [of g 0 m "n - m"] by simp lemma atLeastLessThan_concat: fixes m n p :: nat shows "m \ n \ n \ p \ F g {m..* F g {n..i. g (m + n - Suc i)) {n..i. g (m + n - i)) {n..m}" by (rule reindex_bij_witness [where i="\i. m + n - i" and j="\i. m + n - i"]) auto lemma atLeastLessThan_rev_at_least_Suc_atMost: "F g {n..i. g (m + n - i)) {Suc n..m}" unfolding atLeastLessThan_rev [of g n m] by (cases m) (simp_all add: atLeast_Suc_atMost_Suc_shift atLeastLessThanSuc_atLeastAtMost) end subsection \Summation indexed over intervals\ syntax (ASCII) "_from_to_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(SUM _ = _.._./ _)" [0,0,0,10] 10) "_from_upto_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(SUM _ = _..<_./ _)" [0,0,0,10] 10) "_upt_sum" :: "idt \ 'a \ 'b \ 'b" ("(SUM _<_./ _)" [0,0,10] 10) "_upto_sum" :: "idt \ 'a \ 'b \ 'b" ("(SUM _<=_./ _)" [0,0,10] 10) syntax (latex_sum output) "_from_to_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\sum_{\_ = _\<^latex>\}^{\_\<^latex>\}$\ _)" [0,0,0,10] 10) "_from_upto_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\sum_{\_ = _\<^latex>\}^{<\_\<^latex>\}$\ _)" [0,0,0,10] 10) "_upt_sum" :: "idt \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\sum_{\_ < _\<^latex>\}$\ _)" [0,0,10] 10) "_upto_sum" :: "idt \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\sum_{\_ \ _\<^latex>\}$\ _)" [0,0,10] 10) syntax "_from_to_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\_ = _.._./ _)" [0,0,0,10] 10) "_from_upto_sum" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\_ = _..<_./ _)" [0,0,0,10] 10) "_upt_sum" :: "idt \ 'a \ 'b \ 'b" ("(3\_<_./ _)" [0,0,10] 10) "_upto_sum" :: "idt \ 'a \ 'b \ 'b" ("(3\_\_./ _)" [0,0,10] 10) translations "\x=a..b. t" == "CONST sum (\x. t) {a..b}" "\x=a..x. t) {a..i\n. t" == "CONST sum (\i. t) {..n}" "\ii. t) {..The above introduces some pretty alternative syntaxes for summation over intervals: \begin{center} \begin{tabular}{lll} Old & New & \LaTeX\\ @{term[source]"\x\{a..b}. e"} & \<^term>\\x=a..b. e\ & @{term[mode=latex_sum]"\x=a..b. e"}\\ @{term[source]"\x\{a..\\x=a.. & @{term[mode=latex_sum]"\x=a..x\{..b}. e"} & \<^term>\\x\b. e\ & @{term[mode=latex_sum]"\x\b. e"}\\ @{term[source]"\x\{..\\x & @{term[mode=latex_sum]"\xlatex_sum\ (e.g.\ via \mode = latex_sum\ in antiquotations). It is not the default \LaTeX\ output because it only works well with italic-style formulae, not tt-style. Note that for uniformity on \<^typ>\nat\ it is better to use \<^term>\\x::nat=0.. rather than \\x: \sum\ may not provide all lemmas available for \<^term>\{m.. also in the special form for \<^term>\{...\ text\This congruence rule should be used for sums over intervals as the standard theorem @{text[source]sum.cong} does not work well with the simplifier who adds the unsimplified premise \<^term>\x\B\ to the context.\ context comm_monoid_set begin lemma zero_middle: assumes "1 \ p" "k \ p" shows "F (\j. if j < k then g j else if j = k then \<^bold>1 else h (j - Suc 0)) {..p} = F (\j. if j < k then g j else h j) {..p - Suc 0}" (is "?lhs = ?rhs") proof - have [simp]: "{..p - Suc 0} \ {j. j < k} = {.. - {j. j < k} = {k..p - Suc 0}" using assms by auto have "?lhs = F g {..* F (\j. if j = k then \<^bold>1 else h (j - Suc 0)) {k..p}" using union_disjoint [of "{.. = F g {..* F (\j. h (j - Suc 0)) {Suc k..p}" by (simp add: atLeast_Suc_atMost [of k p] assms) also have "\ = F g {..* F h {k .. p - Suc 0}" using reindex [of Suc "{k..p - Suc 0}"] assms by simp also have "\ = ?rhs" by (simp add: If_cases) finally show ?thesis . qed lemma atMost_Suc [simp]: "F g {..Suc n} = F g {..n} \<^bold>* g (Suc n)" by (simp add: atMost_Suc ac_simps) lemma lessThan_Suc [simp]: "F g {..* g n" by (simp add: lessThan_Suc ac_simps) lemma cl_ivl_Suc [simp]: "F g {m..Suc n} = (if Suc n < m then \<^bold>1 else F g {m..n} \<^bold>* g(Suc n))" by (auto simp: ac_simps atLeastAtMostSuc_conv) lemma op_ivl_Suc [simp]: "F g {m..1 else F g {m..* g(n))" by (auto simp: ac_simps atLeastLessThanSuc) lemma head: fixes n :: nat assumes mn: "m \ n" shows "F g {m..n} = g m \<^bold>* F g {m<..n}" (is "?lhs = ?rhs") proof - from mn have "{m..n} = {m} \ {m<..n}" by (auto intro: ivl_disj_un_singleton) hence "?lhs = F g ({m} \ {m<..n})" by (simp add: atLeast0LessThan) also have "\ = ?rhs" by simp finally show ?thesis . qed lemma last_plus: fixes n::nat shows "m \ n \ F g {m..n} = g n \<^bold>* F g {m..1 else F g {m..* g(n))" by (simp add: commute last_plus) lemma ub_add_nat: assumes "(m::nat) \ n + 1" shows "F g {m..n + p} = F g {m..n} \<^bold>* F g {n + 1..n + p}" proof- have "{m .. n+p} = {m..n} \ {n+1..n+p}" using \m \ n+1\ by auto thus ?thesis by (auto simp: ivl_disj_int union_disjoint atLeastSucAtMost_greaterThanAtMost) qed lemma nat_group: fixes k::nat shows "F (\m. F g {m * k ..< m*k + k}) {.. 0" by auto then show ?thesis by (induct n) (simp_all add: atLeastLessThan_concat add.commute atLeast0LessThan[symmetric]) qed auto lemma triangle_reindex: fixes n :: nat shows "F (\(i,j). g i j) {(i,j). i+j < n} = F (\k. F (\i. g i (k - i)) {..k}) {..(i,j). g i j) {(i,j). i+j \ n} = F (\k. F (\i. g i (k - i)) {..k}) {..n}" using triangle_reindex [of g "Suc n"] by (simp only: Nat.less_Suc_eq_le lessThan_Suc_atMost) lemma nat_diff_reindex: "F (\i. g (n - Suc i)) {..i. g(i + k)){m..i. g(i + k)){m..n::nat}" by (rule reindex_bij_witness[where i="\i. i + k" and j="\i. i - k"]) auto corollary shift_bounds_cl_Suc_ivl: "F g {Suc m..Suc n} = F (\i. g(Suc i)){m..n}" by (simp add: shift_bounds_cl_nat_ivl[where k="Suc 0", simplified]) corollary Suc_reindex_ivl: "m \ n \ F g {m..n} \<^bold>* g (Suc n) = g m \<^bold>* F (\i. g (Suc i)) {m..n}" by (simp add: assoc atLeast_Suc_atMost flip: shift_bounds_cl_Suc_ivl) corollary shift_bounds_Suc_ivl: "F g {Suc m..i. g(Suc i)){m..* F (\i. g (Suc i)) {..n}" proof (induct n) case 0 show ?case by simp next case (Suc n) note IH = this have "F g {..Suc (Suc n)} = F g {..Suc n} \<^bold>* g (Suc (Suc n))" by (rule atMost_Suc) also have "F g {..Suc n} = g 0 \<^bold>* F (\i. g (Suc i)) {..n}" by (rule IH) also have "g 0 \<^bold>* F (\i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) = g 0 \<^bold>* (F (\i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)))" by (rule assoc) also have "F (\i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) = F (\i. g (Suc i)) {..Suc n}" by (rule atMost_Suc [symmetric]) finally show ?case . qed lemma lessThan_Suc_shift: "F g {..* F (\i. g (Suc i)) {..* F (\i. g (Suc i)) {..i. F (\j. a i j) {0..j. F (\i. a i j) {Suc j..n}) {0..i. F (\j. a i j) {..j. F (\i. a i j) {Suc j..n}) {..k. g (Suc k)) {.. = F (\k. g (Suc k)) {.. b \ F g {a..* g b" by (simp add: atLeastLessThanSuc commute) lemma nat_ivl_Suc': assumes "m \ Suc n" shows "F g {m..Suc n} = g (Suc n) \<^bold>* F g {m..n}" proof - from assms have "{m..Suc n} = insert (Suc n) {m..n}" by auto also have "F g \ = g (Suc n) \<^bold>* F g {m..n}" by simp finally show ?thesis . qed lemma in_pairs: "F g {2*m..Suc(2*n)} = F (\i. g(2*i) \<^bold>* g(Suc(2*i))) {m..n}" proof (induction n) case 0 show ?case by (cases "m=0") auto next case (Suc n) then show ?case by (auto simp: assoc split: if_split_asm) qed lemma in_pairs_0: "F g {..Suc(2*n)} = F (\i. g(2*i) \<^bold>* g(Suc(2*i))) {..n}" using in_pairs [of _ 0 n] by (simp add: atLeast0AtMost) end lemma card_sum_le_nat_sum: "\ {0.. \ S" proof (cases "finite S") case True then show ?thesis proof (induction "card S" arbitrary: S) case (Suc x) then have "Max S \ x" using card_le_Suc_Max by fastforce let ?S' = "S - {Max S}" from Suc have "Max S \ S" by (auto intro: Max_in) hence cards: "card S = Suc (card ?S')" using `finite S` by (intro card.remove; auto) hence "\ {0.. \ ?S'" using Suc by (intro Suc; auto) hence "\ {0.. \ ?S' + Max S" using `Max S \ x` by simp also have "... = \ S" using sum.remove[OF `finite S` `Max S \ S`, where g="\x. x"] by simp finally show ?case using cards Suc by auto qed simp qed simp lemma sum_natinterval_diff: fixes f:: "nat \ ('a::ab_group_add)" shows "sum (\k. f k - f(k + 1)) {(m::nat) .. n} = (if m \ n then f m - f(n + 1) else 0)" by (induct n, auto simp add: algebra_simps not_le le_Suc_eq) lemma sum_diff_nat_ivl: fixes f :: "nat \ 'a::ab_group_add" shows "\ m \ n; n \ p \ \ sum f {m..x. Q x \ P x \ (\xxxk = 0..k = 0..k = Suc 0..k = Suc 0..k = 0..Shifting bounds\ context comm_monoid_add begin context fixes f :: "nat \ 'a" assumes "f 0 = 0" begin lemma sum_shift_lb_Suc0_0_upt: "sum f {Suc 0..f 0 = 0\ by simp qed lemma sum_shift_lb_Suc0_0: "sum f {Suc 0..k} = sum f {0..k}" proof (cases k) case 0 with \f 0 = 0\ show ?thesis by simp next case (Suc k) moreover have "{0..Suc k} = insert 0 {Suc 0..Suc k}" by auto ultimately show ?thesis using \f 0 = 0\ by simp qed end end lemma sum_Suc_diff: fixes f :: "nat \ 'a::ab_group_add" assumes "m \ Suc n" shows "(\i = m..n. f(Suc i) - f i) = f (Suc n) - f m" using assms by (induct n) (auto simp: le_Suc_eq) lemma sum_Suc_diff': fixes f :: "nat \ 'a::ab_group_add" assumes "m \ n" shows "(\i = m..Telescoping\ lemma sum_telescope: fixes f::"nat \ 'a::ab_group_add" shows "sum (\i. f i - f (Suc i)) {.. i} = f 0 - f (Suc i)" by (induct i) simp_all lemma sum_telescope'': assumes "m \ n" shows "(\k\{Suc m..n}. f k - f (k - 1)) = f n - (f m :: 'a :: ab_group_add)" by (rule dec_induct[OF assms]) (simp_all add: algebra_simps) lemma sum_lessThan_telescope: "(\nnThe formula for geometric sums\ lemma sum_power2: "(\i=0.. 1" shows "(\i 0" by simp_all moreover have "(\iy \ 0\) ultimately show ?thesis by simp qed lemma diff_power_eq_sum: fixes y :: "'a::{comm_ring,monoid_mult}" shows "x ^ (Suc n) - y ^ (Suc n) = (x - y) * (\pppp \\COMPLEX_POLYFUN\ in HOL Light\ fixes x :: "'a::{comm_ring,monoid_mult}" shows "x^n - y^n = (x - y) * (\iiiii\n. x^i) = 1 - x^Suc n" by (simp only: one_diff_power_eq lessThan_Suc_atMost) lemma sum_power_shift: fixes x :: "'a::{comm_ring,monoid_mult}" assumes "m \ n" shows "(\i=m..n. x^i) = x^m * (\i\n-m. x^i)" proof - have "(\i=m..n. x^i) = x^m * (\i=m..n. x^(i-m))" by (simp add: sum_distrib_left power_add [symmetric]) also have "(\i=m..n. x^(i-m)) = (\i\n-m. x^i)" using \m \ n\ by (intro sum.reindex_bij_witness[where j="\i. i - m" and i="\i. i + m"]) auto finally show ?thesis . qed lemma sum_gp_multiplied: fixes x :: "'a::{comm_ring,monoid_mult}" assumes "m \ n" shows "(1 - x) * (\i=m..n. x^i) = x^m - x^Suc n" proof - have "(1 - x) * (\i=m..n. x^i) = x^m * (1 - x) * (\i\n-m. x^i)" by (metis mult.assoc mult.commute assms sum_power_shift) also have "... =x^m * (1 - x^Suc(n-m))" by (metis mult.assoc sum_gp_basic) also have "... = x^m - x^Suc n" using assms by (simp add: algebra_simps) (metis le_add_diff_inverse power_add) finally show ?thesis . qed lemma sum_gp: fixes x :: "'a::{comm_ring,division_ring}" shows "(\i=m..n. x^i) = (if n < m then 0 else if x = 1 then of_nat((n + 1) - m) else (x^m - x^Suc n) / (1 - x))" using sum_gp_multiplied [of m n x] apply auto by (metis eq_iff_diff_eq_0 mult.commute nonzero_divide_eq_eq) subsubsection\Geometric progressions\ lemma sum_gp0: fixes x :: "'a::{comm_ring,division_ring}" shows "(\i\n. x^i) = (if x = 1 then of_nat(n + 1) else (1 - x^Suc n) / (1 - x))" using sum_gp_basic[of x n] by (simp add: mult.commute field_split_simps) lemma sum_power_add: fixes x :: "'a::{comm_ring,monoid_mult}" shows "(\i\I. x^(m+i)) = x^m * (\i\I. x^i)" by (simp add: sum_distrib_left power_add) lemma sum_gp_offset: fixes x :: "'a::{comm_ring,division_ring}" shows "(\i=m..m+n. x^i) = (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))" using sum_gp [of x m "m+n"] by (auto simp: power_add algebra_simps) lemma sum_gp_strict: fixes x :: "'a::{comm_ring,division_ring}" shows "(\iThe formulae for arithmetic sums\ context comm_semiring_1 begin lemma double_gauss_sum: "2 * (\i = 0..n. of_nat i) = of_nat n * (of_nat n + 1)" by (induct n) (simp_all add: sum.atLeast0_atMost_Suc algebra_simps left_add_twice) lemma double_gauss_sum_from_Suc_0: "2 * (\i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1)" proof - have "sum of_nat {Suc 0..n} = sum of_nat (insert 0 {Suc 0..n})" by simp also have "\ = sum of_nat {0..n}" by (cases n) (simp_all add: atLeast0_atMost_Suc_eq_insert_0) finally show ?thesis by (simp add: double_gauss_sum) qed lemma double_arith_series: "2 * (\i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d)" proof - have "(\i = 0..n. a + of_nat i * d) = ((\i = 0..n. a) + (\i = 0..n. of_nat i * d))" by (rule sum.distrib) also have "\ = (of_nat (Suc n) * a + d * (\i = 0..n. of_nat i))" by (simp add: sum_distrib_left algebra_simps) finally show ?thesis by (simp add: algebra_simps double_gauss_sum left_add_twice) qed end context unique_euclidean_semiring_with_nat begin lemma gauss_sum: "(\i = 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2" using double_gauss_sum [of n, symmetric] by simp lemma gauss_sum_from_Suc_0: "(\i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2" using double_gauss_sum_from_Suc_0 [of n, symmetric] by simp lemma arith_series: "(\i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d) div 2" using double_arith_series [of a d n, symmetric] by simp end lemma gauss_sum_nat: "\{0..n} = (n * Suc n) div 2" using gauss_sum [of n, where ?'a = nat] by simp lemma arith_series_nat: "(\i = 0..n. a + i * d) = Suc n * (2 * a + n * d) div 2" using arith_series [of a d n] by simp lemma Sum_Icc_int: "\{m..n} = (n * (n + 1) - m * (m - 1)) div 2" if "m \ n" for m n :: int using that proof (induct i \ "nat (n - m)" arbitrary: m n) case 0 then have "m = n" by arith then show ?case by (simp add: algebra_simps mult_2 [symmetric]) next case (Suc i) have 0: "i = nat((n-1) - m)" "m \ n-1" using Suc(2,3) by arith+ have "\ {m..n} = \ {m..1+(n-1)}" by simp also have "\ = \ {m..n-1} + n" using \m \ n\ by(subst atLeastAtMostPlus1_int_conv) simp_all also have "\ = ((n-1)*(n-1+1) - m*(m-1)) div 2 + n" by(simp add: Suc(1)[OF 0]) also have "\ = ((n-1)*(n-1+1) - m*(m-1) + 2*n) div 2" by simp also have "\ = (n*(n+1) - m*(m-1)) div 2" by (simp add: algebra_simps mult_2_right) finally show ?case . qed lemma Sum_Icc_nat: "\{m..n} = (n * (n + 1) - m * (m - 1)) div 2" for m n :: nat proof (cases "m \ n") case True then have *: "m * (m - 1) \ n * (n + 1)" by (meson diff_le_self order_trans le_add1 mult_le_mono) have "int (\{m..n}) = (\{int m..int n})" by (simp add: sum.atLeast_int_atMost_int_shift) also have "\ = (int n * (int n + 1) - int m * (int m - 1)) div 2" using \m \ n\ by (simp add: Sum_Icc_int) also have "\ = int ((n * (n + 1) - m * (m - 1)) div 2)" using le_square * by (simp add: algebra_simps of_nat_div of_nat_diff) finally show ?thesis by (simp only: of_nat_eq_iff) next case False then show ?thesis by (auto dest: less_imp_Suc_add simp add: not_le algebra_simps) qed lemma Sum_Ico_nat: "\{m..Division remainder\ lemma range_mod: fixes n :: nat assumes "n > 0" shows "range (\m. m mod n) = {0.. ?A \ m \ ?B" proof assume "m \ ?A" with assms show "m \ ?B" by auto next assume "m \ ?B" moreover have "m mod n \ ?A" by (rule rangeI) ultimately show "m \ ?A" by simp qed qed subsection \Products indexed over intervals\ syntax (ASCII) "_from_to_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(PROD _ = _.._./ _)" [0,0,0,10] 10) "_from_upto_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(PROD _ = _..<_./ _)" [0,0,0,10] 10) "_upt_prod" :: "idt \ 'a \ 'b \ 'b" ("(PROD _<_./ _)" [0,0,10] 10) "_upto_prod" :: "idt \ 'a \ 'b \ 'b" ("(PROD _<=_./ _)" [0,0,10] 10) syntax (latex_prod output) "_from_to_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\prod_{\_ = _\<^latex>\}^{\_\<^latex>\}$\ _)" [0,0,0,10] 10) "_from_upto_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\prod_{\_ = _\<^latex>\}^{<\_\<^latex>\}$\ _)" [0,0,0,10] 10) "_upt_prod" :: "idt \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\prod_{\_ < _\<^latex>\}$\ _)" [0,0,10] 10) "_upto_prod" :: "idt \ 'a \ 'b \ 'b" ("(3\<^latex>\$\\prod_{\_ \ _\<^latex>\}$\ _)" [0,0,10] 10) syntax "_from_to_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\_ = _.._./ _)" [0,0,0,10] 10) "_from_upto_prod" :: "idt \ 'a \ 'a \ 'b \ 'b" ("(3\_ = _..<_./ _)" [0,0,0,10] 10) "_upt_prod" :: "idt \ 'a \ 'b \ 'b" ("(3\_<_./ _)" [0,0,10] 10) "_upto_prod" :: "idt \ 'a \ 'b \ 'b" ("(3\_\_./ _)" [0,0,10] 10) translations "\x=a..b. t" \ "CONST prod (\x. t) {a..b}" "\x=a.. "CONST prod (\x. t) {a..i\n. t" \ "CONST prod (\i. t) {..n}" "\i "CONST prod (\i. t) {..{int i..int (i+j)}" by (induct j) (auto simp add: atLeastAtMostSuc_conv atLeastAtMostPlus1_int_conv) lemma prod_int_eq: "prod int {i..j} = \{int i..int j}" proof (cases "i \ j") case True then show ?thesis by (metis le_iff_add prod_int_plus_eq) next case False then show ?thesis by auto qed subsection \Efficient folding over intervals\ function fold_atLeastAtMost_nat where [simp del]: "fold_atLeastAtMost_nat f a (b::nat) acc = (if a > b then acc else fold_atLeastAtMost_nat f (a+1) b (f a acc))" by pat_completeness auto termination by (relation "measure (\(_,a,b,_). Suc b - a)") auto lemma fold_atLeastAtMost_nat: assumes "comp_fun_commute f" shows "fold_atLeastAtMost_nat f a b acc = Finite_Set.fold f acc {a..b}" using assms proof (induction f a b acc rule: fold_atLeastAtMost_nat.induct, goal_cases) case (1 f a b acc) interpret comp_fun_commute f by fact show ?case proof (cases "a > b") case True thus ?thesis by (subst fold_atLeastAtMost_nat.simps) auto next case False with 1 show ?thesis by (subst fold_atLeastAtMost_nat.simps) (auto simp: atLeastAtMost_insertL[symmetric] fold_fun_left_comm) qed qed lemma sum_atLeastAtMost_code: "sum f {a..b} = fold_atLeastAtMost_nat (\a acc. f a + acc) a b 0" proof - have "comp_fun_commute (\a. (+) (f a))" by unfold_locales (auto simp: o_def add_ac) thus ?thesis by (simp add: sum.eq_fold fold_atLeastAtMost_nat o_def) qed lemma prod_atLeastAtMost_code: "prod f {a..b} = fold_atLeastAtMost_nat (\a acc. f a * acc) a b 1" proof - have "comp_fun_commute (\a. (*) (f a))" by unfold_locales (auto simp: o_def mult_ac) thus ?thesis by (simp add: prod.eq_fold fold_atLeastAtMost_nat o_def) qed (* TODO: Add support for folding over more kinds of intervals here *) end diff --git a/src/HOL/Topological_Spaces.thy b/src/HOL/Topological_Spaces.thy --- a/src/HOL/Topological_Spaces.thy +++ b/src/HOL/Topological_Spaces.thy @@ -1,3836 +1,3836 @@ (* Title: HOL/Topological_Spaces.thy Author: Brian Huffman Author: Johannes Hölzl *) section \Topological Spaces\ theory Topological_Spaces imports Main begin named_theorems continuous_intros "structural introduction rules for continuity" subsection \Topological space\ class "open" = fixes "open" :: "'a set \ bool" class topological_space = "open" + assumes open_UNIV [simp, intro]: "open UNIV" assumes open_Int [intro]: "open S \ open T \ open (S \ T)" assumes open_Union [intro]: "\S\K. open S \ open (\K)" begin definition closed :: "'a set \ bool" where "closed S \ open (- S)" lemma open_empty [continuous_intros, intro, simp]: "open {}" using open_Union [of "{}"] by simp lemma open_Un [continuous_intros, intro]: "open S \ open T \ open (S \ T)" using open_Union [of "{S, T}"] by simp lemma open_UN [continuous_intros, intro]: "\x\A. open (B x) \ open (\x\A. B x)" using open_Union [of "B ` A"] by simp lemma open_Inter [continuous_intros, intro]: "finite S \ \T\S. open T \ open (\S)" by (induct set: finite) auto lemma open_INT [continuous_intros, intro]: "finite A \ \x\A. open (B x) \ open (\x\A. B x)" using open_Inter [of "B ` A"] by simp lemma openI: assumes "\x. x \ S \ \T. open T \ x \ T \ T \ S" shows "open S" proof - have "open (\{T. open T \ T \ S})" by auto moreover have "\{T. open T \ T \ S} = S" by (auto dest!: assms) ultimately show "open S" by simp qed lemma open_subopen: "open S \ (\x\S. \T. open T \ x \ T \ T \ S)" by (auto intro: openI) lemma closed_empty [continuous_intros, intro, simp]: "closed {}" unfolding closed_def by simp lemma closed_Un [continuous_intros, intro]: "closed S \ closed T \ closed (S \ T)" unfolding closed_def by auto lemma closed_UNIV [continuous_intros, intro, simp]: "closed UNIV" unfolding closed_def by simp lemma closed_Int [continuous_intros, intro]: "closed S \ closed T \ closed (S \ T)" unfolding closed_def by auto lemma closed_INT [continuous_intros, intro]: "\x\A. closed (B x) \ closed (\x\A. B x)" unfolding closed_def by auto lemma closed_Inter [continuous_intros, intro]: "\S\K. closed S \ closed (\K)" unfolding closed_def uminus_Inf by auto lemma closed_Union [continuous_intros, intro]: "finite S \ \T\S. closed T \ closed (\S)" by (induct set: finite) auto lemma closed_UN [continuous_intros, intro]: "finite A \ \x\A. closed (B x) \ closed (\x\A. B x)" using closed_Union [of "B ` A"] by simp lemma open_closed: "open S \ closed (- S)" by (simp add: closed_def) lemma closed_open: "closed S \ open (- S)" by (rule closed_def) lemma open_Diff [continuous_intros, intro]: "open S \ closed T \ open (S - T)" by (simp add: closed_open Diff_eq open_Int) lemma closed_Diff [continuous_intros, intro]: "closed S \ open T \ closed (S - T)" by (simp add: open_closed Diff_eq closed_Int) lemma open_Compl [continuous_intros, intro]: "closed S \ open (- S)" by (simp add: closed_open) lemma closed_Compl [continuous_intros, intro]: "open S \ closed (- S)" by (simp add: open_closed) lemma open_Collect_neg: "closed {x. P x} \ open {x. \ P x}" unfolding Collect_neg_eq by (rule open_Compl) lemma open_Collect_conj: assumes "open {x. P x}" "open {x. Q x}" shows "open {x. P x \ Q x}" using open_Int[OF assms] by (simp add: Int_def) lemma open_Collect_disj: assumes "open {x. P x}" "open {x. Q x}" shows "open {x. P x \ Q x}" using open_Un[OF assms] by (simp add: Un_def) lemma open_Collect_ex: "(\i. open {x. P i x}) \ open {x. \i. P i x}" using open_UN[of UNIV "\i. {x. P i x}"] unfolding Collect_ex_eq by simp lemma open_Collect_imp: "closed {x. P x} \ open {x. Q x} \ open {x. P x \ Q x}" unfolding imp_conv_disj by (intro open_Collect_disj open_Collect_neg) lemma open_Collect_const: "open {x. P}" by (cases P) auto lemma closed_Collect_neg: "open {x. P x} \ closed {x. \ P x}" unfolding Collect_neg_eq by (rule closed_Compl) lemma closed_Collect_conj: assumes "closed {x. P x}" "closed {x. Q x}" shows "closed {x. P x \ Q x}" using closed_Int[OF assms] by (simp add: Int_def) lemma closed_Collect_disj: assumes "closed {x. P x}" "closed {x. Q x}" shows "closed {x. P x \ Q x}" using closed_Un[OF assms] by (simp add: Un_def) lemma closed_Collect_all: "(\i. closed {x. P i x}) \ closed {x. \i. P i x}" using closed_INT[of UNIV "\i. {x. P i x}"] by (simp add: Collect_all_eq) lemma closed_Collect_imp: "open {x. P x} \ closed {x. Q x} \ closed {x. P x \ Q x}" unfolding imp_conv_disj by (intro closed_Collect_disj closed_Collect_neg) lemma closed_Collect_const: "closed {x. P}" by (cases P) auto end subsection \Hausdorff and other separation properties\ class t0_space = topological_space + assumes t0_space: "x \ y \ \U. open U \ \ (x \ U \ y \ U)" class t1_space = topological_space + assumes t1_space: "x \ y \ \U. open U \ x \ U \ y \ U" instance t1_space \ t0_space by standard (fast dest: t1_space) context t1_space begin lemma separation_t1: "x \ y \ (\U. open U \ x \ U \ y \ U)" using t1_space[of x y] by blast lemma closed_singleton [iff]: "closed {a}" proof - let ?T = "\{S. open S \ a \ S}" have "open ?T" by (simp add: open_Union) also have "?T = - {a}" by (auto simp add: set_eq_iff separation_t1) finally show "closed {a}" by (simp only: closed_def) qed lemma closed_insert [continuous_intros, simp]: assumes "closed S" shows "closed (insert a S)" proof - from closed_singleton assms have "closed ({a} \ S)" by (rule closed_Un) then show "closed (insert a S)" by simp qed lemma finite_imp_closed: "finite S \ closed S" by (induct pred: finite) simp_all end text \T2 spaces are also known as Hausdorff spaces.\ class t2_space = topological_space + assumes hausdorff: "x \ y \ \U V. open U \ open V \ x \ U \ y \ V \ U \ V = {}" instance t2_space \ t1_space by standard (fast dest: hausdorff) lemma (in t2_space) separation_t2: "x \ y \ (\U V. open U \ open V \ x \ U \ y \ V \ U \ V = {})" using hausdorff [of x y] by blast lemma (in t0_space) separation_t0: "x \ y \ (\U. open U \ \ (x \ U \ y \ U))" using t0_space [of x y] by blast text \A classical separation axiom for topological space, the T3 axiom -- also called regularity: if a point is not in a closed set, then there are open sets separating them.\ class t3_space = t2_space + assumes t3_space: "closed S \ y \ S \ \U V. open U \ open V \ y \ U \ S \ V \ U \ V = {}" text \A classical separation axiom for topological space, the T4 axiom -- also called normality: if two closed sets are disjoint, then there are open sets separating them.\ class t4_space = t2_space + assumes t4_space: "closed S \ closed T \ S \ T = {} \ \U V. open U \ open V \ S \ U \ T \ V \ U \ V = {}" text \T4 is stronger than T3, and weaker than metric.\ instance t4_space \ t3_space proof fix S and y::'a assume "closed S" "y \ S" then show "\U V. open U \ open V \ y \ U \ S \ V \ U \ V = {}" using t4_space[of "{y}" S] by auto qed text \A perfect space is a topological space with no isolated points.\ class perfect_space = topological_space + assumes not_open_singleton: "\ open {x}" lemma (in perfect_space) UNIV_not_singleton: "UNIV \ {x}" for x::'a by (metis (no_types) open_UNIV not_open_singleton) subsection \Generators for toplogies\ inductive generate_topology :: "'a set set \ 'a set \ bool" for S :: "'a set set" where UNIV: "generate_topology S UNIV" | Int: "generate_topology S (a \ b)" if "generate_topology S a" and "generate_topology S b" | UN: "generate_topology S (\K)" if "(\k. k \ K \ generate_topology S k)" | Basis: "generate_topology S s" if "s \ S" hide_fact (open) UNIV Int UN Basis lemma generate_topology_Union: "(\k. k \ I \ generate_topology S (K k)) \ generate_topology S (\k\I. K k)" using generate_topology.UN [of "K ` I"] by auto lemma topological_space_generate_topology: "class.topological_space (generate_topology S)" by standard (auto intro: generate_topology.intros) subsection \Order topologies\ class order_topology = order + "open" + assumes open_generated_order: "open = generate_topology (range (\a. {..< a}) \ range (\a. {a <..}))" begin subclass topological_space unfolding open_generated_order by (rule topological_space_generate_topology) lemma open_greaterThan [continuous_intros, simp]: "open {a <..}" unfolding open_generated_order by (auto intro: generate_topology.Basis) lemma open_lessThan [continuous_intros, simp]: "open {..< a}" unfolding open_generated_order by (auto intro: generate_topology.Basis) lemma open_greaterThanLessThan [continuous_intros, simp]: "open {a <..< b}" unfolding greaterThanLessThan_eq by (simp add: open_Int) end class linorder_topology = linorder + order_topology lemma closed_atMost [continuous_intros, simp]: "closed {..a}" for a :: "'a::linorder_topology" by (simp add: closed_open) lemma closed_atLeast [continuous_intros, simp]: "closed {a..}" for a :: "'a::linorder_topology" by (simp add: closed_open) lemma closed_atLeastAtMost [continuous_intros, simp]: "closed {a..b}" for a b :: "'a::linorder_topology" proof - have "{a .. b} = {a ..} \ {.. b}" by auto then show ?thesis by (simp add: closed_Int) qed lemma (in order) less_separate: assumes "x < y" shows "\a b. x \ {..< a} \ y \ {b <..} \ {..< a} \ {b <..} = {}" proof (cases "\z. x < z \ z < y") case True then obtain z where "x < z \ z < y" .. then have "x \ {..< z} \ y \ {z <..} \ {z <..} \ {..< z} = {}" by auto then show ?thesis by blast next case False with \x < y\ have "x \ {..< y}" "y \ {x <..}" "{x <..} \ {..< y} = {}" by auto then show ?thesis by blast qed instance linorder_topology \ t2_space proof fix x y :: 'a show "x \ y \ \U V. open U \ open V \ x \ U \ y \ V \ U \ V = {}" using less_separate [of x y] less_separate [of y x] by (elim neqE; metis open_lessThan open_greaterThan Int_commute) qed lemma (in linorder_topology) open_right: assumes "open S" "x \ S" and gt_ex: "x < y" shows "\b>x. {x ..< b} \ S" using assms unfolding open_generated_order proof induct case UNIV then show ?case by blast next case (Int A B) then obtain a b where "a > x" "{x ..< a} \ A" "b > x" "{x ..< b} \ B" by auto then show ?case by (auto intro!: exI[of _ "min a b"]) next case UN then show ?case by blast next case Basis then show ?case by (fastforce intro: exI[of _ y] gt_ex) qed lemma (in linorder_topology) open_left: assumes "open S" "x \ S" and lt_ex: "y < x" shows "\b S" using assms unfolding open_generated_order proof induction case UNIV then show ?case by blast next case (Int A B) then obtain a b where "a < x" "{a <.. x} \ A" "b < x" "{b <.. x} \ B" by auto then show ?case by (auto intro!: exI[of _ "max a b"]) next case UN then show ?case by blast next case Basis then show ?case by (fastforce intro: exI[of _ y] lt_ex) qed subsection \Setup some topologies\ subsubsection \Boolean is an order topology\ class discrete_topology = topological_space + assumes open_discrete: "\A. open A" instance discrete_topology < t2_space proof fix x y :: 'a assume "x \ y" then show "\U V. open U \ open V \ x \ U \ y \ V \ U \ V = {}" by (intro exI[of _ "{_}"]) (auto intro!: open_discrete) qed instantiation bool :: linorder_topology begin definition open_bool :: "bool set \ bool" where "open_bool = generate_topology (range (\a. {..< a}) \ range (\a. {a <..}))" instance by standard (rule open_bool_def) end instance bool :: discrete_topology proof fix A :: "bool set" have *: "{False <..} = {True}" "{..< True} = {False}" by auto have "A = UNIV \ A = {} \ A = {False <..} \ A = {..< True}" using subset_UNIV[of A] unfolding UNIV_bool * by blast then show "open A" by auto qed instantiation nat :: linorder_topology begin definition open_nat :: "nat set \ bool" where "open_nat = generate_topology (range (\a. {..< a}) \ range (\a. {a <..}))" instance by standard (rule open_nat_def) end instance nat :: discrete_topology proof fix A :: "nat set" have "open {n}" for n :: nat proof (cases n) case 0 moreover have "{0} = {..<1::nat}" by auto ultimately show ?thesis by auto next case (Suc n') then have "{n} = {.. {n' <..}" by auto with Suc show ?thesis by (auto intro: open_lessThan open_greaterThan) qed then have "open (\a\A. {a})" by (intro open_UN) auto then show "open A" by simp qed instantiation int :: linorder_topology begin definition open_int :: "int set \ bool" where "open_int = generate_topology (range (\a. {..< a}) \ range (\a. {a <..}))" instance by standard (rule open_int_def) end instance int :: discrete_topology proof fix A :: "int set" have "{.. {i-1 <..} = {i}" for i :: int by auto then have "open {i}" for i :: int using open_Int[OF open_lessThan[of "i + 1"] open_greaterThan[of "i - 1"]] by auto then have "open (\a\A. {a})" by (intro open_UN) auto then show "open A" by simp qed subsubsection \Topological filters\ definition (in topological_space) nhds :: "'a \ 'a filter" where "nhds a = (INF S\{S. open S \ a \ S}. principal S)" definition (in topological_space) at_within :: "'a \ 'a set \ 'a filter" ("at (_)/ within (_)" [1000, 60] 60) where "at a within s = inf (nhds a) (principal (s - {a}))" abbreviation (in topological_space) at :: "'a \ 'a filter" ("at") where "at x \ at x within (CONST UNIV)" abbreviation (in order_topology) at_right :: "'a \ 'a filter" where "at_right x \ at x within {x <..}" abbreviation (in order_topology) at_left :: "'a \ 'a filter" where "at_left x \ at x within {..< x}" lemma (in topological_space) nhds_generated_topology: "open = generate_topology T \ nhds x = (INF S\{S\T. x \ S}. principal S)" unfolding nhds_def proof (safe intro!: antisym INF_greatest) fix S assume "generate_topology T S" "x \ S" then show "(INF S\{S \ T. x \ S}. principal S) \ principal S" by induct (auto intro: INF_lower order_trans simp: inf_principal[symmetric] simp del: inf_principal) qed (auto intro!: INF_lower intro: generate_topology.intros) lemma (in topological_space) eventually_nhds: "eventually P (nhds a) \ (\S. open S \ a \ S \ (\x\S. P x))" unfolding nhds_def by (subst eventually_INF_base) (auto simp: eventually_principal) lemma eventually_eventually: "eventually (\y. eventually P (nhds y)) (nhds x) = eventually P (nhds x)" by (auto simp: eventually_nhds) lemma (in topological_space) eventually_nhds_in_open: "open s \ x \ s \ eventually (\y. y \ s) (nhds x)" by (subst eventually_nhds) blast lemma (in topological_space) eventually_nhds_x_imp_x: "eventually P (nhds x) \ P x" by (subst (asm) eventually_nhds) blast lemma (in topological_space) nhds_neq_bot [simp]: "nhds a \ bot" by (simp add: trivial_limit_def eventually_nhds) lemma (in t1_space) t1_space_nhds: "x \ y \ (\\<^sub>F x in nhds x. x \ y)" by (drule t1_space) (auto simp: eventually_nhds) lemma (in topological_space) nhds_discrete_open: "open {x} \ nhds x = principal {x}" by (auto simp: nhds_def intro!: antisym INF_greatest INF_lower2[of "{x}"]) lemma (in discrete_topology) nhds_discrete: "nhds x = principal {x}" by (simp add: nhds_discrete_open open_discrete) lemma (in discrete_topology) at_discrete: "at x within S = bot" unfolding at_within_def nhds_discrete by simp lemma (in discrete_topology) tendsto_discrete: "filterlim (f :: 'b \ 'a) (nhds y) F \ eventually (\x. f x = y) F" by (auto simp: nhds_discrete filterlim_principal) lemma (in topological_space) at_within_eq: "at x within s = (INF S\{S. open S \ x \ S}. principal (S \ s - {x}))" unfolding nhds_def at_within_def by (subst INF_inf_const2[symmetric]) (auto simp: Diff_Int_distrib) lemma (in topological_space) eventually_at_filter: "eventually P (at a within s) \ eventually (\x. x \ a \ x \ s \ P x) (nhds a)" by (simp add: at_within_def eventually_inf_principal imp_conjL[symmetric] conj_commute) lemma (in topological_space) at_le: "s \ t \ at x within s \ at x within t" unfolding at_within_def by (intro inf_mono) auto lemma (in topological_space) eventually_at_topological: "eventually P (at a within s) \ (\S. open S \ a \ S \ (\x\S. x \ a \ x \ s \ P x))" by (simp add: eventually_nhds eventually_at_filter) lemma (in topological_space) at_within_open: "a \ S \ open S \ at a within S = at a" unfolding filter_eq_iff eventually_at_topological by (metis open_Int Int_iff UNIV_I) lemma (in topological_space) at_within_open_NO_MATCH: "a \ s \ open s \ NO_MATCH UNIV s \ at a within s = at a" by (simp only: at_within_open) lemma (in topological_space) at_within_open_subset: "a \ S \ open S \ S \ T \ at a within T = at a" by (metis at_le at_within_open dual_order.antisym subset_UNIV) lemma (in topological_space) at_within_nhd: assumes "x \ S" "open S" "T \ S - {x} = U \ S - {x}" shows "at x within T = at x within U" unfolding filter_eq_iff eventually_at_filter proof (intro allI eventually_subst) have "eventually (\x. x \ S) (nhds x)" using \x \ S\ \open S\ by (auto simp: eventually_nhds) then show "\\<^sub>F n in nhds x. (n \ x \ n \ T \ P n) = (n \ x \ n \ U \ P n)" for P by eventually_elim (insert \T \ S - {x} = U \ S - {x}\, blast) qed lemma (in topological_space) at_within_empty [simp]: "at a within {} = bot" unfolding at_within_def by simp lemma (in topological_space) at_within_union: "at x within (S \ T) = sup (at x within S) (at x within T)" unfolding filter_eq_iff eventually_sup eventually_at_filter by (auto elim!: eventually_rev_mp) lemma (in topological_space) at_eq_bot_iff: "at a = bot \ open {a}" unfolding trivial_limit_def eventually_at_topological apply safe apply (case_tac "S = {a}") apply simp apply fast apply fast done lemma (in perfect_space) at_neq_bot [simp]: "at a \ bot" by (simp add: at_eq_bot_iff not_open_singleton) lemma (in order_topology) nhds_order: "nhds x = inf (INF a\{x <..}. principal {..< a}) (INF a\{..< x}. principal {a <..})" proof - have 1: "{S \ range lessThan \ range greaterThan. x \ S} = (\a. {..< a}) ` {x <..} \ (\a. {a <..}) ` {..< x}" by auto show ?thesis by (simp only: nhds_generated_topology[OF open_generated_order] INF_union 1 INF_image comp_def) qed lemma (in topological_space) filterlim_at_within_If: assumes "filterlim f G (at x within (A \ {x. P x}))" and "filterlim g G (at x within (A \ {x. \P x}))" shows "filterlim (\x. if P x then f x else g x) G (at x within A)" proof (rule filterlim_If) note assms(1) also have "at x within (A \ {x. P x}) = inf (nhds x) (principal (A \ Collect P - {x}))" by (simp add: at_within_def) also have "A \ Collect P - {x} = (A - {x}) \ Collect P" by blast also have "inf (nhds x) (principal \) = inf (at x within A) (principal (Collect P))" by (simp add: at_within_def inf_assoc) finally show "filterlim f G (inf (at x within A) (principal (Collect P)))" . next note assms(2) also have "at x within (A \ {x. \ P x}) = inf (nhds x) (principal (A \ {x. \ P x} - {x}))" by (simp add: at_within_def) also have "A \ {x. \ P x} - {x} = (A - {x}) \ {x. \ P x}" by blast also have "inf (nhds x) (principal \) = inf (at x within A) (principal {x. \ P x})" by (simp add: at_within_def inf_assoc) finally show "filterlim g G (inf (at x within A) (principal {x. \ P x}))" . qed lemma (in topological_space) filterlim_at_If: assumes "filterlim f G (at x within {x. P x})" and "filterlim g G (at x within {x. \P x})" shows "filterlim (\x. if P x then f x else g x) G (at x)" using assms by (intro filterlim_at_within_If) simp_all lemma (in linorder_topology) at_within_order: assumes "UNIV \ {x}" shows "at x within s = inf (INF a\{x <..}. principal ({..< a} \ s - {x})) (INF a\{..< x}. principal ({a <..} \ s - {x}))" proof (cases "{x <..} = {}" "{..< x} = {}" rule: case_split [case_product case_split]) case True_True have "UNIV = {..< x} \ {x} \ {x <..}" by auto with assms True_True show ?thesis by auto qed (auto simp del: inf_principal simp: at_within_def nhds_order Int_Diff inf_principal[symmetric] INF_inf_const2 inf_sup_aci[where 'a="'a filter"]) lemma (in linorder_topology) at_left_eq: "y < x \ at_left x = (INF a\{..< x}. principal {a <..< x})" by (subst at_within_order) (auto simp: greaterThan_Int_greaterThan greaterThanLessThan_eq[symmetric] min.absorb2 INF_constant intro!: INF_lower2 inf_absorb2) lemma (in linorder_topology) eventually_at_left: "y < x \ eventually P (at_left x) \ (\by>b. y < x \ P y)" unfolding at_left_eq by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def) lemma (in linorder_topology) at_right_eq: "x < y \ at_right x = (INF a\{x <..}. principal {x <..< a})" by (subst at_within_order) (auto simp: lessThan_Int_lessThan greaterThanLessThan_eq[symmetric] max.absorb2 INF_constant Int_commute intro!: INF_lower2 inf_absorb1) lemma (in linorder_topology) eventually_at_right: "x < y \ eventually P (at_right x) \ (\b>x. \y>x. y < b \ P y)" unfolding at_right_eq by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def) lemma eventually_at_right_less: "\\<^sub>F y in at_right (x::'a::{linorder_topology, no_top}). x < y" using gt_ex[of x] eventually_at_right[of x] by auto lemma trivial_limit_at_right_top: "at_right (top::_::{order_top,linorder_topology}) = bot" by (auto simp: filter_eq_iff eventually_at_topological) lemma trivial_limit_at_left_bot: "at_left (bot::_::{order_bot,linorder_topology}) = bot" by (auto simp: filter_eq_iff eventually_at_topological) lemma trivial_limit_at_left_real [simp]: "\ trivial_limit (at_left x)" for x :: "'a::{no_bot,dense_order,linorder_topology}" using lt_ex [of x] by safe (auto simp add: trivial_limit_def eventually_at_left dest: dense) lemma trivial_limit_at_right_real [simp]: "\ trivial_limit (at_right x)" for x :: "'a::{no_top,dense_order,linorder_topology}" using gt_ex[of x] by safe (auto simp add: trivial_limit_def eventually_at_right dest: dense) lemma (in linorder_topology) at_eq_sup_left_right: "at x = sup (at_left x) (at_right x)" by (auto simp: eventually_at_filter filter_eq_iff eventually_sup elim: eventually_elim2 eventually_mono) lemma (in linorder_topology) eventually_at_split: "eventually P (at x) \ eventually P (at_left x) \ eventually P (at_right x)" by (subst at_eq_sup_left_right) (simp add: eventually_sup) lemma (in order_topology) eventually_at_leftI: assumes "\x. x \ {a<.. P x" "a < b" shows "eventually P (at_left b)" using assms unfolding eventually_at_topological by (intro exI[of _ "{a<..}"]) auto lemma (in order_topology) eventually_at_rightI: assumes "\x. x \ {a<.. P x" "a < b" shows "eventually P (at_right a)" using assms unfolding eventually_at_topological by (intro exI[of _ "{.. (\S. open S \ x \ S \ (\x. f x \ S \ P x))" unfolding eventually_filtercomap eventually_nhds by auto lemma eventually_filtercomap_at_topological: "eventually P (filtercomap f (at A within B)) \ (\S. open S \ A \ S \ (\x. f x \ S \ B - {A} \ P x))" (is "?lhs = ?rhs") unfolding at_within_def filtercomap_inf eventually_inf_principal filtercomap_principal eventually_filtercomap_nhds eventually_principal by blast lemma eventually_at_right_field: "eventually P (at_right x) \ (\b>x. \y>x. y < b \ P y)" for x :: "'a::{linordered_field, linorder_topology}" using linordered_field_no_ub[rule_format, of x] by (auto simp: eventually_at_right) lemma eventually_at_left_field: "eventually P (at_left x) \ (\by>b. y < x \ P y)" for x :: "'a::{linordered_field, linorder_topology}" using linordered_field_no_lb[rule_format, of x] by (auto simp: eventually_at_left) subsubsection \Tendsto\ abbreviation (in topological_space) tendsto :: "('b \ 'a) \ 'a \ 'b filter \ bool" (infixr "\" 55) where "(f \ l) F \ filterlim f (nhds l) F" definition (in t2_space) Lim :: "'f filter \ ('f \ 'a) \ 'a" where "Lim A f = (THE l. (f \ l) A)" lemma (in topological_space) tendsto_eq_rhs: "(f \ x) F \ x = y \ (f \ y) F" by simp named_theorems tendsto_intros "introduction rules for tendsto" setup \ Global_Theory.add_thms_dynamic (\<^binding>\tendsto_eq_intros\, fn context => Named_Theorems.get (Context.proof_of context) \<^named_theorems>\tendsto_intros\ |> map_filter (try (fn thm => @{thm tendsto_eq_rhs} OF [thm]))) \ context topological_space begin lemma tendsto_def: "(f \ l) F \ (\S. open S \ l \ S \ eventually (\x. f x \ S) F)" unfolding nhds_def filterlim_INF filterlim_principal by auto lemma tendsto_cong: "(f \ c) F \ (g \ c) F" if "eventually (\x. f x = g x) F" by (rule filterlim_cong [OF refl refl that]) lemma tendsto_mono: "F \ F' \ (f \ l) F' \ (f \ l) F" unfolding tendsto_def le_filter_def by fast lemma tendsto_ident_at [tendsto_intros, simp, intro]: "((\x. x) \ a) (at a within s)" by (auto simp: tendsto_def eventually_at_topological) lemma tendsto_const [tendsto_intros, simp, intro]: "((\x. k) \ k) F" by (simp add: tendsto_def) lemma filterlim_at: "(LIM x F. f x :> at b within s) \ eventually (\x. f x \ s \ f x \ b) F \ (f \ b) F" by (simp add: at_within_def filterlim_inf filterlim_principal conj_commute) lemma (in -) assumes "filterlim f (nhds L) F" shows tendsto_imp_filterlim_at_right: "eventually (\x. f x > L) F \ filterlim f (at_right L) F" and tendsto_imp_filterlim_at_left: "eventually (\x. f x < L) F \ filterlim f (at_left L) F" using assms by (auto simp: filterlim_at elim: eventually_mono) lemma filterlim_at_withinI: assumes "filterlim f (nhds c) F" assumes "eventually (\x. f x \ A - {c}) F" shows "filterlim f (at c within A) F" using assms by (simp add: filterlim_at) lemma filterlim_atI: assumes "filterlim f (nhds c) F" assumes "eventually (\x. f x \ c) F" shows "filterlim f (at c) F" using assms by (intro filterlim_at_withinI) simp_all lemma topological_tendstoI: "(\S. open S \ l \ S \ eventually (\x. f x \ S) F) \ (f \ l) F" by (auto simp: tendsto_def) lemma topological_tendstoD: "(f \ l) F \ open S \ l \ S \ eventually (\x. f x \ S) F" by (auto simp: tendsto_def) lemma tendsto_bot [simp]: "(f \ a) bot" by (simp add: tendsto_def) lemma tendsto_eventually: "eventually (\x. f x = l) net \ ((\x. f x) \ l) net" by (rule topological_tendstoI) (auto elim: eventually_mono) end lemma (in topological_space) filterlim_within_subset: "filterlim f l (at x within S) \ T \ S \ filterlim f l (at x within T)" by (blast intro: filterlim_mono at_le) lemmas tendsto_within_subset = filterlim_within_subset lemma (in order_topology) order_tendsto_iff: "(f \ x) F \ (\lx. l < f x) F) \ (\u>x. eventually (\x. f x < u) F)" by (auto simp: nhds_order filterlim_inf filterlim_INF filterlim_principal) lemma (in order_topology) order_tendstoI: "(\a. a < y \ eventually (\x. a < f x) F) \ (\a. y < a \ eventually (\x. f x < a) F) \ (f \ y) F" by (auto simp: order_tendsto_iff) lemma (in order_topology) order_tendstoD: assumes "(f \ y) F" shows "a < y \ eventually (\x. a < f x) F" and "y < a \ eventually (\x. f x < a) F" using assms by (auto simp: order_tendsto_iff) lemma (in linorder_topology) tendsto_max[tendsto_intros]: assumes X: "(X \ x) net" and Y: "(Y \ y) net" shows "((\x. max (X x) (Y x)) \ max x y) net" proof (rule order_tendstoI) fix a assume "a < max x y" then show "eventually (\x. a < max (X x) (Y x)) net" using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a] by (auto simp: less_max_iff_disj elim: eventually_mono) next fix a assume "max x y < a" then show "eventually (\x. max (X x) (Y x) < a) net" using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a] by (auto simp: eventually_conj_iff) qed lemma (in linorder_topology) tendsto_min[tendsto_intros]: assumes X: "(X \ x) net" and Y: "(Y \ y) net" shows "((\x. min (X x) (Y x)) \ min x y) net" proof (rule order_tendstoI) fix a assume "a < min x y" then show "eventually (\x. a < min (X x) (Y x)) net" using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a] by (auto simp: eventually_conj_iff) next fix a assume "min x y < a" then show "eventually (\x. min (X x) (Y x) < a) net" using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a] by (auto simp: min_less_iff_disj elim: eventually_mono) qed lemma (in order_topology) assumes "a < b" shows at_within_Icc_at_right: "at a within {a..b} = at_right a" and at_within_Icc_at_left: "at b within {a..b} = at_left b" using order_tendstoD(2)[OF tendsto_ident_at assms, of "{a<..}"] using order_tendstoD(1)[OF tendsto_ident_at assms, of "{.. x < b \ at x within {a..b} = at x" by (rule at_within_open_subset[where S="{a<.. bot" and "(f \ a) F" and "(f \ b) F" shows "a = b" proof (rule ccontr) assume "a \ b" obtain U V where "open U" "open V" "a \ U" "b \ V" "U \ V = {}" using hausdorff [OF \a \ b\] by fast have "eventually (\x. f x \ U) F" using \(f \ a) F\ \open U\ \a \ U\ by (rule topological_tendstoD) moreover have "eventually (\x. f x \ V) F" using \(f \ b) F\ \open V\ \b \ V\ by (rule topological_tendstoD) ultimately have "eventually (\x. False) F" proof eventually_elim case (elim x) then have "f x \ U \ V" by simp with \U \ V = {}\ show ?case by simp qed with \\ trivial_limit F\ show "False" by (simp add: trivial_limit_def) qed lemma (in t2_space) tendsto_const_iff: fixes a b :: 'a assumes "\ trivial_limit F" shows "((\x. a) \ b) F \ a = b" by (auto intro!: tendsto_unique [OF assms tendsto_const]) lemma (in t2_space) tendsto_unique': assumes "F \ bot" shows "\\<^sub>\\<^sub>1l. (f \ l) F" using Uniq_def assms local.tendsto_unique by fastforce lemma Lim_in_closed_set: assumes "closed S" "eventually (\x. f(x) \ S) F" "F \ bot" "(f \ l) F" shows "l \ S" proof (rule ccontr) assume "l \ S" with \closed S\ have "open (- S)" "l \ - S" by (simp_all add: open_Compl) with assms(4) have "eventually (\x. f x \ - S) F" by (rule topological_tendstoD) with assms(2) have "eventually (\x. False) F" by (rule eventually_elim2) simp with assms(3) show "False" by (simp add: eventually_False) qed lemma (in t3_space) nhds_closed: assumes "x \ A" and "open A" shows "\A'. x \ A' \ closed A' \ A' \ A \ eventually (\y. y \ A') (nhds x)" proof - from assms have "\U V. open U \ open V \ x \ U \ - A \ V \ U \ V = {}" by (intro t3_space) auto then obtain U V where UV: "open U" "open V" "x \ U" "-A \ V" "U \ V = {}" by auto have "eventually (\y. y \ U) (nhds x)" using \open U\ and \x \ U\ by (intro eventually_nhds_in_open) hence "eventually (\y. y \ -V) (nhds x)" by eventually_elim (use UV in auto) with UV show ?thesis by (intro exI[of _ "-V"]) auto qed lemma (in order_topology) increasing_tendsto: assumes bdd: "eventually (\n. f n \ l) F" and en: "\x. x < l \ eventually (\n. x < f n) F" shows "(f \ l) F" using assms by (intro order_tendstoI) (auto elim!: eventually_mono) lemma (in order_topology) decreasing_tendsto: assumes bdd: "eventually (\n. l \ f n) F" and en: "\x. l < x \ eventually (\n. f n < x) F" shows "(f \ l) F" using assms by (intro order_tendstoI) (auto elim!: eventually_mono) lemma (in order_topology) tendsto_sandwich: assumes ev: "eventually (\n. f n \ g n) net" "eventually (\n. g n \ h n) net" assumes lim: "(f \ c) net" "(h \ c) net" shows "(g \ c) net" proof (rule order_tendstoI) fix a show "a < c \ eventually (\x. a < g x) net" using order_tendstoD[OF lim(1), of a] ev by (auto elim: eventually_elim2) next fix a show "c < a \ eventually (\x. g x < a) net" using order_tendstoD[OF lim(2), of a] ev by (auto elim: eventually_elim2) qed lemma (in t1_space) limit_frequently_eq: assumes "F \ bot" and "frequently (\x. f x = c) F" and "(f \ d) F" shows "d = c" proof (rule ccontr) assume "d \ c" from t1_space[OF this] obtain U where "open U" "d \ U" "c \ U" by blast with assms have "eventually (\x. f x \ U) F" unfolding tendsto_def by blast then have "eventually (\x. f x \ c) F" by eventually_elim (insert \c \ U\, blast) with assms(2) show False unfolding frequently_def by contradiction qed lemma (in t1_space) tendsto_imp_eventually_ne: assumes "(f \ c) F" "c \ c'" shows "eventually (\z. f z \ c') F" proof (cases "F=bot") case True thus ?thesis by auto next case False show ?thesis proof (rule ccontr) assume "\ eventually (\z. f z \ c') F" then have "frequently (\z. f z = c') F" by (simp add: frequently_def) from limit_frequently_eq[OF False this \(f \ c) F\] and \c \ c'\ show False by contradiction qed qed lemma (in linorder_topology) tendsto_le: assumes F: "\ trivial_limit F" and x: "(f \ x) F" and y: "(g \ y) F" and ev: "eventually (\x. g x \ f x) F" shows "y \ x" proof (rule ccontr) assume "\ y \ x" with less_separate[of x y] obtain a b where xy: "x < a" "b < y" "{.. {b<..} = {}" by (auto simp: not_le) then have "eventually (\x. f x < a) F" "eventually (\x. b < g x) F" using x y by (auto intro: order_tendstoD) with ev have "eventually (\x. False) F" by eventually_elim (insert xy, fastforce) with F show False by (simp add: eventually_False) qed lemma (in linorder_topology) tendsto_lowerbound: assumes x: "(f \ x) F" and ev: "eventually (\i. a \ f i) F" and F: "\ trivial_limit F" shows "a \ x" using F x tendsto_const ev by (rule tendsto_le) lemma (in linorder_topology) tendsto_upperbound: assumes x: "(f \ x) F" and ev: "eventually (\i. a \ f i) F" and F: "\ trivial_limit F" shows "a \ x" by (rule tendsto_le [OF F tendsto_const x ev]) lemma filterlim_at_within_not_equal: fixes f::"'a \ 'b::t2_space" assumes "filterlim f (at a within s) F" shows "eventually (\w. f w\s \ f w \b) F" proof (cases "a=b") case True then show ?thesis using assms by (simp add: filterlim_at) next case False from hausdorff[OF this] obtain U V where UV:"open U" "open V" "a \ U" "b \ V" "U \ V = {}" by auto have "(f \ a) F" using assms filterlim_at by auto then have "\\<^sub>F x in F. f x \ U" using UV unfolding tendsto_def by auto moreover have "\\<^sub>F x in F. f x \ s \ f x\a" using assms filterlim_at by auto ultimately show ?thesis apply eventually_elim using UV by auto qed subsubsection \Rules about \<^const>\Lim\\ lemma tendsto_Lim: "\ trivial_limit net \ (f \ l) net \ Lim net f = l" unfolding Lim_def using tendsto_unique [of net f] by auto lemma Lim_ident_at: "\ trivial_limit (at x within s) \ Lim (at x within s) (\x. x) = x" by (rule tendsto_Lim[OF _ tendsto_ident_at]) auto lemma eventually_Lim_ident_at: "(\\<^sub>F y in at x within X. P (Lim (at x within X) (\x. x)) y) \ (\\<^sub>F y in at x within X. P x y)" for x::"'a::t2_space" by (cases "at x within X = bot") (auto simp: Lim_ident_at) lemma filterlim_at_bot_at_right: fixes f :: "'a::linorder_topology \ 'b::linorder" assumes mono: "\x y. Q x \ Q y \ x \ y \ f x \ f y" and bij: "\x. P x \ f (g x) = x" "\x. P x \ Q (g x)" and Q: "eventually Q (at_right a)" and bound: "\b. Q b \ a < b" and P: "eventually P at_bot" shows "filterlim f at_bot (at_right a)" proof - from P obtain x where x: "\y. y \ x \ P y" unfolding eventually_at_bot_linorder by auto show ?thesis proof (intro filterlim_at_bot_le[THEN iffD2] allI impI) fix z assume "z \ x" with x have "P z" by auto have "eventually (\x. x \ g z) (at_right a)" using bound[OF bij(2)[OF \P z\]] unfolding eventually_at_right[OF bound[OF bij(2)[OF \P z\]]] by (auto intro!: exI[of _ "g z"]) with Q show "eventually (\x. f x \ z) (at_right a)" by eventually_elim (metis bij \P z\ mono) qed qed lemma filterlim_at_top_at_left: fixes f :: "'a::linorder_topology \ 'b::linorder" assumes mono: "\x y. Q x \ Q y \ x \ y \ f x \ f y" and bij: "\x. P x \ f (g x) = x" "\x. P x \ Q (g x)" and Q: "eventually Q (at_left a)" and bound: "\b. Q b \ b < a" and P: "eventually P at_top" shows "filterlim f at_top (at_left a)" proof - from P obtain x where x: "\y. x \ y \ P y" unfolding eventually_at_top_linorder by auto show ?thesis proof (intro filterlim_at_top_ge[THEN iffD2] allI impI) fix z assume "x \ z" with x have "P z" by auto have "eventually (\x. g z \ x) (at_left a)" using bound[OF bij(2)[OF \P z\]] unfolding eventually_at_left[OF bound[OF bij(2)[OF \P z\]]] by (auto intro!: exI[of _ "g z"]) with Q show "eventually (\x. z \ f x) (at_left a)" by eventually_elim (metis bij \P z\ mono) qed qed lemma filterlim_split_at: "filterlim f F (at_left x) \ filterlim f F (at_right x) \ filterlim f F (at x)" for x :: "'a::linorder_topology" by (subst at_eq_sup_left_right) (rule filterlim_sup) lemma filterlim_at_split: "filterlim f F (at x) \ filterlim f F (at_left x) \ filterlim f F (at_right x)" for x :: "'a::linorder_topology" by (subst at_eq_sup_left_right) (simp add: filterlim_def filtermap_sup) lemma eventually_nhds_top: fixes P :: "'a :: {order_top,linorder_topology} \ bool" and b :: 'a assumes "b < top" shows "eventually P (nhds top) \ (\bz. b < z \ P z))" unfolding eventually_nhds proof safe fix S :: "'a set" assume "open S" "top \ S" note open_left[OF this \b < top\] moreover assume "\s\S. P s" ultimately show "\bz>b. P z" by (auto simp: subset_eq Ball_def) next fix b assume "b < top" "\z>b. P z" then show "\S. open S \ top \ S \ (\xa\S. P xa)" by (intro exI[of _ "{b <..}"]) auto qed lemma tendsto_at_within_iff_tendsto_nhds: "(g \ g l) (at l within S) \ (g \ g l) (inf (nhds l) (principal S))" unfolding tendsto_def eventually_at_filter eventually_inf_principal by (intro ext all_cong imp_cong) (auto elim!: eventually_mono) subsection \Limits on sequences\ abbreviation (in topological_space) LIMSEQ :: "[nat \ 'a, 'a] \ bool" ("((_)/ \ (_))" [60, 60] 60) where "X \ L \ (X \ L) sequentially" abbreviation (in t2_space) lim :: "(nat \ 'a) \ 'a" where "lim X \ Lim sequentially X" definition (in topological_space) convergent :: "(nat \ 'a) \ bool" where "convergent X = (\L. X \ L)" lemma lim_def: "lim X = (THE L. X \ L)" unfolding Lim_def .. lemma lim_explicit: "f \ f0 \ (\S. open S \ f0 \ S \ (\N. \n\N. f n \ S))" unfolding tendsto_def eventually_sequentially by auto subsection \Monotone sequences and subsequences\ text \ Definition of monotonicity. The use of disjunction here complicates proofs considerably. One alternative is to add a Boolean argument to indicate the direction. Another is to develop the notions of increasing and decreasing first. \ definition monoseq :: "(nat \ 'a::order) \ bool" where "monoseq X \ (\m. \n\m. X m \ X n) \ (\m. \n\m. X n \ X m)" abbreviation incseq :: "(nat \ 'a::order) \ bool" where "incseq X \ mono X" lemma incseq_def: "incseq X \ (\m. \n\m. X n \ X m)" unfolding mono_def .. abbreviation decseq :: "(nat \ 'a::order) \ bool" where "decseq X \ antimono X" lemma decseq_def: "decseq X \ (\m. \n\m. X n \ X m)" unfolding antimono_def .. subsubsection \Definition of subsequence.\ (* For compatibility with the old "subseq" *) lemma strict_mono_leD: "strict_mono r \ m \ n \ r m \ r n" by (erule (1) monoD [OF strict_mono_mono]) lemma strict_mono_id: "strict_mono id" by (simp add: strict_mono_def) lemma incseq_SucI: "(\n. X n \ X (Suc n)) \ incseq X" using lift_Suc_mono_le[of X] by (auto simp: incseq_def) lemma incseqD: "incseq f \ i \ j \ f i \ f j" by (auto simp: incseq_def) lemma incseq_SucD: "incseq A \ A i \ A (Suc i)" using incseqD[of A i "Suc i"] by auto lemma incseq_Suc_iff: "incseq f \ (\n. f n \ f (Suc n))" by (auto intro: incseq_SucI dest: incseq_SucD) lemma incseq_const[simp, intro]: "incseq (\x. k)" unfolding incseq_def by auto lemma decseq_SucI: "(\n. X (Suc n) \ X n) \ decseq X" using order.lift_Suc_mono_le[OF dual_order, of X] by (auto simp: decseq_def) lemma decseqD: "decseq f \ i \ j \ f j \ f i" by (auto simp: decseq_def) lemma decseq_SucD: "decseq A \ A (Suc i) \ A i" using decseqD[of A i "Suc i"] by auto lemma decseq_Suc_iff: "decseq f \ (\n. f (Suc n) \ f n)" by (auto intro: decseq_SucI dest: decseq_SucD) lemma decseq_const[simp, intro]: "decseq (\x. k)" unfolding decseq_def by auto lemma monoseq_iff: "monoseq X \ incseq X \ decseq X" unfolding monoseq_def incseq_def decseq_def .. lemma monoseq_Suc: "monoseq X \ (\n. X n \ X (Suc n)) \ (\n. X (Suc n) \ X n)" unfolding monoseq_iff incseq_Suc_iff decseq_Suc_iff .. lemma monoI1: "\m. \n \ m. X m \ X n \ monoseq X" by (simp add: monoseq_def) lemma monoI2: "\m. \n \ m. X n \ X m \ monoseq X" by (simp add: monoseq_def) lemma mono_SucI1: "\n. X n \ X (Suc n) \ monoseq X" by (simp add: monoseq_Suc) lemma mono_SucI2: "\n. X (Suc n) \ X n \ monoseq X" by (simp add: monoseq_Suc) lemma monoseq_minus: fixes a :: "nat \ 'a::ordered_ab_group_add" assumes "monoseq a" shows "monoseq (\ n. - a n)" proof (cases "\m. \n \ m. a m \ a n") case True then have "\m. \n \ m. - a n \ - a m" by auto then show ?thesis by (rule monoI2) next case False then have "\m. \n \ m. - a m \ - a n" using \monoseq a\[unfolded monoseq_def] by auto then show ?thesis by (rule monoI1) qed subsubsection \Subsequence (alternative definition, (e.g. Hoskins)\ lemma strict_mono_Suc_iff: "strict_mono f \ (\n. f n < f (Suc n))" proof (intro iffI strict_monoI) assume *: "\n. f n < f (Suc n)" fix m n :: nat assume "m < n" thus "f m < f n" by (induction rule: less_Suc_induct) (use * in auto) qed (auto simp: strict_mono_def) lemma strict_mono_add: "strict_mono (\n::'a::linordered_semidom. n + k)" by (auto simp: strict_mono_def) text \For any sequence, there is a monotonic subsequence.\ lemma seq_monosub: fixes s :: "nat \ 'a::linorder" shows "\f. strict_mono f \ monoseq (\n. (s (f n)))" proof (cases "\n. \p>n. \m\p. s m \ s p") case True then have "\f. \n. (\m\f n. s m \ s (f n)) \ f n < f (Suc n)" by (intro dependent_nat_choice) (auto simp: conj_commute) then obtain f :: "nat \ nat" where f: "strict_mono f" and mono: "\n m. f n \ m \ s m \ s (f n)" by (auto simp: strict_mono_Suc_iff) then have "incseq f" unfolding strict_mono_Suc_iff incseq_Suc_iff by (auto intro: less_imp_le) then have "monoseq (\n. s (f n))" by (auto simp add: incseq_def intro!: mono monoI2) with f show ?thesis by auto next case False then obtain N where N: "p > N \ \m>p. s p < s m" for p by (force simp: not_le le_less) have "\f. \n. N < f n \ f n < f (Suc n) \ s (f n) \ s (f (Suc n))" proof (intro dependent_nat_choice) fix x assume "N < x" with N[of x] show "\y>N. x < y \ s x \ s y" by (auto intro: less_trans) qed auto then show ?thesis by (auto simp: monoseq_iff incseq_Suc_iff strict_mono_Suc_iff) qed lemma seq_suble: assumes sf: "strict_mono (f :: nat \ nat)" shows "n \ f n" proof (induct n) case 0 show ?case by simp next case (Suc n) with sf [unfolded strict_mono_Suc_iff, rule_format, of n] have "n < f (Suc n)" by arith then show ?case by arith qed lemma eventually_subseq: "strict_mono r \ eventually P sequentially \ eventually (\n. P (r n)) sequentially" unfolding eventually_sequentially by (metis seq_suble le_trans) lemma not_eventually_sequentiallyD: assumes "\ eventually P sequentially" shows "\r::nat\nat. strict_mono r \ (\n. \ P (r n))" proof - from assms have "\n. \m\n. \ P m" unfolding eventually_sequentially by (simp add: not_less) then obtain r where "\n. r n \ n" "\n. \ P (r n)" by (auto simp: choice_iff) then show ?thesis by (auto intro!: exI[of _ "\n. r (((Suc \ r) ^^ Suc n) 0)"] simp: less_eq_Suc_le strict_mono_Suc_iff) qed lemma sequentially_offset: assumes "eventually (\i. P i) sequentially" shows "eventually (\i. P (i + k)) sequentially" using assms by (rule eventually_sequentially_seg [THEN iffD2]) lemma seq_offset_neg: "(f \ l) sequentially \ ((\i. f(i - k)) \ l) sequentially" apply (erule filterlim_compose) apply (simp add: filterlim_def le_sequentially eventually_filtermap eventually_sequentially, arith) done lemma filterlim_subseq: "strict_mono f \ filterlim f sequentially sequentially" unfolding filterlim_iff by (metis eventually_subseq) lemma strict_mono_o: "strict_mono r \ strict_mono s \ strict_mono (r \ s)" unfolding strict_mono_def by simp lemma strict_mono_compose: "strict_mono r \ strict_mono s \ strict_mono (\x. r (s x))" using strict_mono_o[of r s] by (simp add: o_def) lemma incseq_imp_monoseq: "incseq X \ monoseq X" by (simp add: incseq_def monoseq_def) lemma decseq_imp_monoseq: "decseq X \ monoseq X" by (simp add: decseq_def monoseq_def) lemma decseq_eq_incseq: "decseq X = incseq (\n. - X n)" for X :: "nat \ 'a::ordered_ab_group_add" by (simp add: decseq_def incseq_def) lemma INT_decseq_offset: assumes "decseq F" shows "(\i. F i) = (\i\{n..}. F i)" proof safe fix x i assume x: "x \ (\i\{n..}. F i)" show "x \ F i" proof cases from x have "x \ F n" by auto also assume "i \ n" with \decseq F\ have "F n \ F i" unfolding decseq_def by simp finally show ?thesis . qed (insert x, simp) qed auto lemma LIMSEQ_const_iff: "(\n. k) \ l \ k = l" for k l :: "'a::t2_space" using trivial_limit_sequentially by (rule tendsto_const_iff) lemma LIMSEQ_SUP: "incseq X \ X \ (SUP i. X i :: 'a::{complete_linorder,linorder_topology})" by (intro increasing_tendsto) (auto simp: SUP_upper less_SUP_iff incseq_def eventually_sequentially intro: less_le_trans) lemma LIMSEQ_INF: "decseq X \ X \ (INF i. X i :: 'a::{complete_linorder,linorder_topology})" by (intro decreasing_tendsto) (auto simp: INF_lower INF_less_iff decseq_def eventually_sequentially intro: le_less_trans) lemma LIMSEQ_ignore_initial_segment: "f \ a \ (\n. f (n + k)) \ a" unfolding tendsto_def by (subst eventually_sequentially_seg[where k=k]) lemma LIMSEQ_offset: "(\n. f (n + k)) \ a \ f \ a" unfolding tendsto_def by (subst (asm) eventually_sequentially_seg[where k=k]) lemma LIMSEQ_Suc: "f \ l \ (\n. f (Suc n)) \ l" by (drule LIMSEQ_ignore_initial_segment [where k="Suc 0"]) simp lemma LIMSEQ_imp_Suc: "(\n. f (Suc n)) \ l \ f \ l" by (rule LIMSEQ_offset [where k="Suc 0"]) simp lemma LIMSEQ_lessThan_iff_atMost: shows "(\n. f {.. x \ (\n. f {..n}) \ x" apply (subst filterlim_sequentially_Suc [symmetric]) apply (simp only: lessThan_Suc_atMost) done lemma (in t2_space) LIMSEQ_Uniq: "\\<^sub>\\<^sub>1l. X \ l" by (simp add: tendsto_unique') lemma (in t2_space) LIMSEQ_unique: "X \ a \ X \ b \ a = b" using trivial_limit_sequentially by (rule tendsto_unique) lemma LIMSEQ_le_const: "X \ x \ \N. \n\N. a \ X n \ a \ x" for a x :: "'a::linorder_topology" by (simp add: eventually_at_top_linorder tendsto_lowerbound) lemma LIMSEQ_le: "X \ x \ Y \ y \ \N. \n\N. X n \ Y n \ x \ y" for x y :: "'a::linorder_topology" using tendsto_le[of sequentially Y y X x] by (simp add: eventually_sequentially) lemma LIMSEQ_le_const2: "X \ x \ \N. \n\N. X n \ a \ x \ a" for a x :: "'a::linorder_topology" by (rule LIMSEQ_le[of X x "\n. a"]) auto lemma Lim_bounded: "f \ l \ \n\M. f n \ C \ l \ C" for l :: "'a::linorder_topology" by (intro LIMSEQ_le_const2) auto lemma Lim_bounded2: fixes f :: "nat \ 'a::linorder_topology" assumes lim:"f \ l" and ge: "\n\N. f n \ C" shows "l \ C" using ge by (intro tendsto_le[OF trivial_limit_sequentially lim tendsto_const]) (auto simp: eventually_sequentially) lemma lim_mono: fixes X Y :: "nat \ 'a::linorder_topology" assumes "\n. N \ n \ X n \ Y n" and "X \ x" and "Y \ y" shows "x \ y" using assms(1) by (intro LIMSEQ_le[OF assms(2,3)]) auto lemma Sup_lim: fixes a :: "'a::{complete_linorder,linorder_topology}" assumes "\n. b n \ s" and "b \ a" shows "a \ Sup s" by (metis Lim_bounded assms complete_lattice_class.Sup_upper) lemma Inf_lim: fixes a :: "'a::{complete_linorder,linorder_topology}" assumes "\n. b n \ s" and "b \ a" shows "Inf s \ a" by (metis Lim_bounded2 assms complete_lattice_class.Inf_lower) lemma SUP_Lim: fixes X :: "nat \ 'a::{complete_linorder,linorder_topology}" assumes inc: "incseq X" and l: "X \ l" shows "(SUP n. X n) = l" using LIMSEQ_SUP[OF inc] tendsto_unique[OF trivial_limit_sequentially l] by simp lemma INF_Lim: fixes X :: "nat \ 'a::{complete_linorder,linorder_topology}" assumes dec: "decseq X" and l: "X \ l" shows "(INF n. X n) = l" using LIMSEQ_INF[OF dec] tendsto_unique[OF trivial_limit_sequentially l] by simp lemma convergentD: "convergent X \ \L. X \ L" by (simp add: convergent_def) lemma convergentI: "X \ L \ convergent X" by (auto simp add: convergent_def) lemma convergent_LIMSEQ_iff: "convergent X \ X \ lim X" by (auto intro: theI LIMSEQ_unique simp add: convergent_def lim_def) lemma convergent_const: "convergent (\n. c)" by (rule convergentI) (rule tendsto_const) lemma monoseq_le: "monoseq a \ a \ x \ (\n. a n \ x) \ (\m. \n\m. a m \ a n) \ (\n. x \ a n) \ (\m. \n\m. a n \ a m)" for x :: "'a::linorder_topology" by (metis LIMSEQ_le_const LIMSEQ_le_const2 decseq_def incseq_def monoseq_iff) lemma LIMSEQ_subseq_LIMSEQ: "X \ L \ strict_mono f \ (X \ f) \ L" unfolding comp_def by (rule filterlim_compose [of X, OF _ filterlim_subseq]) lemma convergent_subseq_convergent: "convergent X \ strict_mono f \ convergent (X \ f)" by (auto simp: convergent_def intro: LIMSEQ_subseq_LIMSEQ) lemma limI: "X \ L \ lim X = L" by (rule tendsto_Lim) (rule trivial_limit_sequentially) lemma lim_le: "convergent f \ (\n. f n \ x) \ lim f \ x" for x :: "'a::linorder_topology" using LIMSEQ_le_const2[of f "lim f" x] by (simp add: convergent_LIMSEQ_iff) lemma lim_const [simp]: "lim (\m. a) = a" by (simp add: limI) subsubsection \Increasing and Decreasing Series\ lemma incseq_le: "incseq X \ X \ L \ X n \ L" for L :: "'a::linorder_topology" by (metis incseq_def LIMSEQ_le_const) lemma decseq_ge: "decseq X \ X \ L \ L \ X n" for L :: "'a::linorder_topology" by (metis decseq_def LIMSEQ_le_const2) subsection \First countable topologies\ class first_countable_topology = topological_space + assumes first_countable_basis: "\A::nat \ 'a set. (\i. x \ A i \ open (A i)) \ (\S. open S \ x \ S \ (\i. A i \ S))" lemma (in first_countable_topology) countable_basis_at_decseq: obtains A :: "nat \ 'a set" where "\i. open (A i)" "\i. x \ (A i)" "\S. open S \ x \ S \ eventually (\i. A i \ S) sequentially" proof atomize_elim from first_countable_basis[of x] obtain A :: "nat \ 'a set" where nhds: "\i. open (A i)" "\i. x \ A i" and incl: "\S. open S \ x \ S \ \i. A i \ S" by auto define F where "F n = (\i\n. A i)" for n show "\A. (\i. open (A i)) \ (\i. x \ A i) \ (\S. open S \ x \ S \ eventually (\i. A i \ S) sequentially)" proof (safe intro!: exI[of _ F]) fix i show "open (F i)" using nhds(1) by (auto simp: F_def) show "x \ F i" using nhds(2) by (auto simp: F_def) next fix S assume "open S" "x \ S" from incl[OF this] obtain i where "F i \ S" unfolding F_def by auto moreover have "\j. i \ j \ F j \ F i" by (simp add: Inf_superset_mono F_def image_mono) ultimately show "eventually (\i. F i \ S) sequentially" by (auto simp: eventually_sequentially) qed qed lemma (in first_countable_topology) nhds_countable: obtains X :: "nat \ 'a set" where "decseq X" "\n. open (X n)" "\n. x \ X n" "nhds x = (INF n. principal (X n))" proof - from first_countable_basis obtain A :: "nat \ 'a set" where *: "\n. x \ A n" "\n. open (A n)" "\S. open S \ x \ S \ \i. A i \ S" by metis show thesis proof show "decseq (\n. \i\n. A i)" by (simp add: antimono_iff_le_Suc atMost_Suc) show "x \ (\i\n. A i)" "\n. open (\i\n. A i)" for n using * by auto show "nhds x = (INF n. principal (\i\n. A i))" using * unfolding nhds_def apply - apply (rule INF_eq) apply simp_all apply fastforce apply (intro exI [of _ "\i\n. A i" for n] conjI open_INT) apply auto done qed qed lemma (in first_countable_topology) countable_basis: obtains A :: "nat \ 'a set" where "\i. open (A i)" "\i. x \ A i" "\F. (\n. F n \ A n) \ F \ x" proof atomize_elim obtain A :: "nat \ 'a set" where *: "\i. open (A i)" "\i. x \ A i" "\S. open S \ x \ S \ eventually (\i. A i \ S) sequentially" by (rule countable_basis_at_decseq) blast have "eventually (\n. F n \ S) sequentially" if "\n. F n \ A n" "open S" "x \ S" for F S using *(3)[of S] that by (auto elim: eventually_mono simp: subset_eq) with * show "\A. (\i. open (A i)) \ (\i. x \ A i) \ (\F. (\n. F n \ A n) \ F \ x)" by (intro exI[of _ A]) (auto simp: tendsto_def) qed lemma (in first_countable_topology) sequentially_imp_eventually_nhds_within: assumes "\f. (\n. f n \ s) \ f \ a \ eventually (\n. P (f n)) sequentially" shows "eventually P (inf (nhds a) (principal s))" proof (rule ccontr) obtain A :: "nat \ 'a set" where *: "\i. open (A i)" "\i. a \ A i" "\F. \n. F n \ A n \ F \ a" by (rule countable_basis) blast assume "\ ?thesis" with * have "\F. \n. F n \ s \ F n \ A n \ \ P (F n)" unfolding eventually_inf_principal eventually_nhds by (intro choice) fastforce then obtain F where F: "\n. F n \ s" and "\n. F n \ A n" and F': "\n. \ P (F n)" by blast with * have "F \ a" by auto then have "eventually (\n. P (F n)) sequentially" using assms F by simp then show False by (simp add: F') qed lemma (in first_countable_topology) eventually_nhds_within_iff_sequentially: "eventually P (inf (nhds a) (principal s)) \ (\f. (\n. f n \ s) \ f \ a \ eventually (\n. P (f n)) sequentially)" proof (safe intro!: sequentially_imp_eventually_nhds_within) assume "eventually P (inf (nhds a) (principal s))" then obtain S where "open S" "a \ S" "\x\S. x \ s \ P x" by (auto simp: eventually_inf_principal eventually_nhds) moreover fix f assume "\n. f n \ s" "f \ a" ultimately show "eventually (\n. P (f n)) sequentially" by (auto dest!: topological_tendstoD elim: eventually_mono) qed lemma (in first_countable_topology) eventually_nhds_iff_sequentially: "eventually P (nhds a) \ (\f. f \ a \ eventually (\n. P (f n)) sequentially)" using eventually_nhds_within_iff_sequentially[of P a UNIV] by simp (*Thanks to Sébastien Gouëzel*) lemma Inf_as_limit: fixes A::"'a::{linorder_topology, first_countable_topology, complete_linorder} set" assumes "A \ {}" shows "\u. (\n. u n \ A) \ u \ Inf A" proof (cases "Inf A \ A") case True show ?thesis by (rule exI[of _ "\n. Inf A"], auto simp add: True) next case False obtain y where "y \ A" using assms by auto then have "Inf A < y" using False Inf_lower less_le by auto obtain F :: "nat \ 'a set" where F: "\i. open (F i)" "\i. Inf A \ F i" "\u. (\n. u n \ F n) \ u \ Inf A" by (metis first_countable_topology_class.countable_basis) define u where "u = (\n. SOME z. z \ F n \ z \ A)" have "\z. z \ U \ z \ A" if "Inf A \ U" "open U" for U proof - obtain b where "b > Inf A" "{Inf A .. U" using open_right[OF \open U\ \Inf A \ U\ \Inf A < y\] by auto obtain z where "z < b" "z \ A" using \Inf A < b\ Inf_less_iff by auto then have "z \ {Inf A ..z \ A\ \{Inf A .. U\ by auto qed then have *: "u n \ F n \ u n \ A" for n using \Inf A \ F n\ \open (F n)\ unfolding u_def by (metis (no_types, lifting) someI_ex) then have "u \ Inf A" using F(3) by simp then show ?thesis using * by auto qed lemma tendsto_at_iff_sequentially: "(f \ a) (at x within s) \ (\X. (\i. X i \ s - {x}) \ X \ x \ ((f \ X) \ a))" for f :: "'a::first_countable_topology \ _" unfolding filterlim_def[of _ "nhds a"] le_filter_def eventually_filtermap at_within_def eventually_nhds_within_iff_sequentially comp_def by metis lemma approx_from_above_dense_linorder: fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}" assumes "x < y" shows "\u. (\n. u n > x) \ (u \ x)" proof - obtain A :: "nat \ 'a set" where A: "\i. open (A i)" "\i. x \ A i" "\F. (\n. F n \ A n) \ F \ x" by (metis first_countable_topology_class.countable_basis) define u where "u = (\n. SOME z. z \ A n \ z > x)" have "\z. z \ U \ x < z" if "x \ U" "open U" for U using open_right[OF \open U\ \x \ U\ \x < y\] by (meson atLeastLessThan_iff dense less_imp_le subset_eq) then have *: "u n \ A n \ x < u n" for n using \x \ A n\ \open (A n)\ unfolding u_def by (metis (no_types, lifting) someI_ex) then have "u \ x" using A(3) by simp then show ?thesis using * by auto qed lemma approx_from_below_dense_linorder: fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}" assumes "x > y" shows "\u. (\n. u n < x) \ (u \ x)" proof - obtain A :: "nat \ 'a set" where A: "\i. open (A i)" "\i. x \ A i" "\F. (\n. F n \ A n) \ F \ x" by (metis first_countable_topology_class.countable_basis) define u where "u = (\n. SOME z. z \ A n \ z < x)" have "\z. z \ U \ z < x" if "x \ U" "open U" for U using open_left[OF \open U\ \x \ U\ \x > y\] by (meson dense greaterThanAtMost_iff less_imp_le subset_eq) then have *: "u n \ A n \ u n < x" for n using \x \ A n\ \open (A n)\ unfolding u_def by (metis (no_types, lifting) someI_ex) then have "u \ x" using A(3) by simp then show ?thesis using * by auto qed subsection \Function limit at a point\ abbreviation LIM :: "('a::topological_space \ 'b::topological_space) \ 'a \ 'b \ bool" ("((_)/ \(_)/\ (_))" [60, 0, 60] 60) where "f \a\ L \ (f \ L) (at a)" lemma tendsto_within_open: "a \ S \ open S \ (f \ l) (at a within S) \ (f \a\ l)" by (simp add: tendsto_def at_within_open[where S = S]) lemma tendsto_within_open_NO_MATCH: "a \ S \ NO_MATCH UNIV S \ open S \ (f \ l)(at a within S) \ (f \ l)(at a)" for f :: "'a::topological_space \ 'b::topological_space" using tendsto_within_open by blast lemma LIM_const_not_eq[tendsto_intros]: "k \ L \ \ (\x. k) \a\ L" for a :: "'a::perfect_space" and k L :: "'b::t2_space" by (simp add: tendsto_const_iff) lemmas LIM_not_zero = LIM_const_not_eq [where L = 0] lemma LIM_const_eq: "(\x. k) \a\ L \ k = L" for a :: "'a::perfect_space" and k L :: "'b::t2_space" by (simp add: tendsto_const_iff) lemma LIM_unique: "f \a\ L \ f \a\ M \ L = M" for a :: "'a::perfect_space" and L M :: "'b::t2_space" using at_neq_bot by (rule tendsto_unique) lemma LIM_Uniq: "\\<^sub>\\<^sub>1L::'b::t2_space. f \a\ L" for a :: "'a::perfect_space" by (auto simp add: Uniq_def LIM_unique) text \Limits are equal for functions equal except at limit point.\ lemma LIM_equal: "\x. x \ a \ f x = g x \ (f \a\ l) \ (g \a\ l)" by (simp add: tendsto_def eventually_at_topological) lemma LIM_cong: "a = b \ (\x. x \ b \ f x = g x) \ l = m \ (f \a\ l) \ (g \b\ m)" by (simp add: LIM_equal) lemma tendsto_cong_limit: "(f \ l) F \ k = l \ (f \ k) F" by simp lemma tendsto_at_iff_tendsto_nhds: "g \l\ g l \ (g \ g l) (nhds l)" unfolding tendsto_def eventually_at_filter by (intro ext all_cong imp_cong) (auto elim!: eventually_mono) lemma tendsto_compose: "g \l\ g l \ (f \ l) F \ ((\x. g (f x)) \ g l) F" unfolding tendsto_at_iff_tendsto_nhds by (rule filterlim_compose[of g]) lemma tendsto_compose_eventually: "g \l\ m \ (f \ l) F \ eventually (\x. f x \ l) F \ ((\x. g (f x)) \ m) F" by (rule filterlim_compose[of g _ "at l"]) (auto simp add: filterlim_at) lemma LIM_compose_eventually: assumes "f \a\ b" and "g \b\ c" and "eventually (\x. f x \ b) (at a)" shows "(\x. g (f x)) \a\ c" using assms(2,1,3) by (rule tendsto_compose_eventually) lemma tendsto_compose_filtermap: "((g \ f) \ T) F \ (g \ T) (filtermap f F)" by (simp add: filterlim_def filtermap_filtermap comp_def) lemma tendsto_compose_at: assumes f: "(f \ y) F" and g: "(g \ z) (at y)" and fg: "eventually (\w. f w = y \ g y = z) F" shows "((g \ f) \ z) F" proof - have "(\\<^sub>F a in F. f a \ y) \ g y = z" using fg by force moreover have "(g \ z) (filtermap f F) \ \ (\\<^sub>F a in F. f a \ y)" by (metis (no_types) filterlim_atI filterlim_def tendsto_mono f g) ultimately show ?thesis by (metis (no_types) f filterlim_compose filterlim_filtermap g tendsto_at_iff_tendsto_nhds tendsto_compose_filtermap) qed subsubsection \Relation of \LIM\ and \LIMSEQ\\ lemma (in first_countable_topology) sequentially_imp_eventually_within: "(\f. (\n. f n \ s \ f n \ a) \ f \ a \ eventually (\n. P (f n)) sequentially) \ eventually P (at a within s)" unfolding at_within_def by (intro sequentially_imp_eventually_nhds_within) auto lemma (in first_countable_topology) sequentially_imp_eventually_at: "(\f. (\n. f n \ a) \ f \ a \ eventually (\n. P (f n)) sequentially) \ eventually P (at a)" using sequentially_imp_eventually_within [where s=UNIV] by simp lemma LIMSEQ_SEQ_conv1: fixes f :: "'a::topological_space \ 'b::topological_space" assumes f: "f \a\ l" shows "\S. (\n. S n \ a) \ S \ a \ (\n. f (S n)) \ l" using tendsto_compose_eventually [OF f, where F=sequentially] by simp lemma LIMSEQ_SEQ_conv2: fixes f :: "'a::first_countable_topology \ 'b::topological_space" assumes "\S. (\n. S n \ a) \ S \ a \ (\n. f (S n)) \ l" shows "f \a\ l" using assms unfolding tendsto_def [where l=l] by (simp add: sequentially_imp_eventually_at) lemma LIMSEQ_SEQ_conv: "(\S. (\n. S n \ a) \ S \ a \ (\n. X (S n)) \ L) \ X \a\ L" for a :: "'a::first_countable_topology" and L :: "'b::topological_space" using LIMSEQ_SEQ_conv2 LIMSEQ_SEQ_conv1 .. lemma sequentially_imp_eventually_at_left: fixes a :: "'a::{linorder_topology,first_countable_topology}" assumes b[simp]: "b < a" and *: "\f. (\n. b < f n) \ (\n. f n < a) \ incseq f \ f \ a \ eventually (\n. P (f n)) sequentially" shows "eventually P (at_left a)" proof (safe intro!: sequentially_imp_eventually_within) fix X assume X: "\n. X n \ {..< a} \ X n \ a" "X \ a" show "eventually (\n. P (X n)) sequentially" proof (rule ccontr) assume neg: "\ ?thesis" have "\s. \n. (\ P (X (s n)) \ b < X (s n)) \ (X (s n) \ X (s (Suc n)) \ Suc (s n) \ s (Suc n))" (is "\s. ?P s") proof (rule dependent_nat_choice) have "\ eventually (\n. b < X n \ P (X n)) sequentially" by (intro not_eventually_impI neg order_tendstoD(1) [OF X(2) b]) then show "\x. \ P (X x) \ b < X x" by (auto dest!: not_eventuallyD) next fix x n have "\ eventually (\n. Suc x \ n \ b < X n \ X x < X n \ P (X n)) sequentially" using X by (intro not_eventually_impI order_tendstoD(1)[OF X(2)] eventually_ge_at_top neg) auto then show "\n. (\ P (X n) \ b < X n) \ (X x \ X n \ Suc x \ n)" by (auto dest!: not_eventuallyD) qed then obtain s where "?P s" .. with X have "b < X (s n)" and "X (s n) < a" and "incseq (\n. X (s n))" and "(\n. X (s n)) \ a" and "\ P (X (s n))" for n by (auto simp: strict_mono_Suc_iff Suc_le_eq incseq_Suc_iff intro!: LIMSEQ_subseq_LIMSEQ[OF \X \ a\, unfolded comp_def]) from *[OF this(1,2,3,4)] this(5) show False by auto qed qed lemma tendsto_at_left_sequentially: fixes a b :: "'b::{linorder_topology,first_countable_topology}" assumes "b < a" assumes *: "\S. (\n. S n < a) \ (\n. b < S n) \ incseq S \ S \ a \ (\n. X (S n)) \ L" shows "(X \ L) (at_left a)" using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_left) lemma sequentially_imp_eventually_at_right: fixes a b :: "'a::{linorder_topology,first_countable_topology}" assumes b[simp]: "a < b" assumes *: "\f. (\n. a < f n) \ (\n. f n < b) \ decseq f \ f \ a \ eventually (\n. P (f n)) sequentially" shows "eventually P (at_right a)" proof (safe intro!: sequentially_imp_eventually_within) fix X assume X: "\n. X n \ {a <..} \ X n \ a" "X \ a" show "eventually (\n. P (X n)) sequentially" proof (rule ccontr) assume neg: "\ ?thesis" have "\s. \n. (\ P (X (s n)) \ X (s n) < b) \ (X (s (Suc n)) \ X (s n) \ Suc (s n) \ s (Suc n))" (is "\s. ?P s") proof (rule dependent_nat_choice) have "\ eventually (\n. X n < b \ P (X n)) sequentially" by (intro not_eventually_impI neg order_tendstoD(2) [OF X(2) b]) then show "\x. \ P (X x) \ X x < b" by (auto dest!: not_eventuallyD) next fix x n have "\ eventually (\n. Suc x \ n \ X n < b \ X n < X x \ P (X n)) sequentially" using X by (intro not_eventually_impI order_tendstoD(2)[OF X(2)] eventually_ge_at_top neg) auto then show "\n. (\ P (X n) \ X n < b) \ (X n \ X x \ Suc x \ n)" by (auto dest!: not_eventuallyD) qed then obtain s where "?P s" .. with X have "a < X (s n)" and "X (s n) < b" and "decseq (\n. X (s n))" and "(\n. X (s n)) \ a" and "\ P (X (s n))" for n by (auto simp: strict_mono_Suc_iff Suc_le_eq decseq_Suc_iff intro!: LIMSEQ_subseq_LIMSEQ[OF \X \ a\, unfolded comp_def]) from *[OF this(1,2,3,4)] this(5) show False by auto qed qed lemma tendsto_at_right_sequentially: fixes a :: "_ :: {linorder_topology, first_countable_topology}" assumes "a < b" and *: "\S. (\n. a < S n) \ (\n. S n < b) \ decseq S \ S \ a \ (\n. X (S n)) \ L" shows "(X \ L) (at_right a)" using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_right) subsection \Continuity\ subsubsection \Continuity on a set\ definition continuous_on :: "'a set \ ('a::topological_space \ 'b::topological_space) \ bool" where "continuous_on s f \ (\x\s. (f \ f x) (at x within s))" lemma continuous_on_cong [cong]: "s = t \ (\x. x \ t \ f x = g x) \ continuous_on s f \ continuous_on t g" unfolding continuous_on_def by (intro ball_cong filterlim_cong) (auto simp: eventually_at_filter) lemma continuous_on_cong_simp: "s = t \ (\x. x \ t =simp=> f x = g x) \ continuous_on s f \ continuous_on t g" unfolding simp_implies_def by (rule continuous_on_cong) lemma continuous_on_topological: "continuous_on s f \ (\x\s. \B. open B \ f x \ B \ (\A. open A \ x \ A \ (\y\s. y \ A \ f y \ B)))" unfolding continuous_on_def tendsto_def eventually_at_topological by metis lemma continuous_on_open_invariant: "continuous_on s f \ (\B. open B \ (\A. open A \ A \ s = f -` B \ s))" proof safe fix B :: "'b set" assume "continuous_on s f" "open B" then have "\x\f -` B \ s. (\A. open A \ x \ A \ s \ A \ f -` B)" by (auto simp: continuous_on_topological subset_eq Ball_def imp_conjL) then obtain A where "\x\f -` B \ s. open (A x) \ x \ A x \ s \ A x \ f -` B" unfolding bchoice_iff .. then show "\A. open A \ A \ s = f -` B \ s" by (intro exI[of _ "\x\f -` B \ s. A x"]) auto next assume B: "\B. open B \ (\A. open A \ A \ s = f -` B \ s)" show "continuous_on s f" unfolding continuous_on_topological proof safe fix x B assume "x \ s" "open B" "f x \ B" with B obtain A where A: "open A" "A \ s = f -` B \ s" by auto with \x \ s\ \f x \ B\ show "\A. open A \ x \ A \ (\y\s. y \ A \ f y \ B)" by (intro exI[of _ A]) auto qed qed lemma continuous_on_open_vimage: "open s \ continuous_on s f \ (\B. open B \ open (f -` B \ s))" unfolding continuous_on_open_invariant by (metis open_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s]) corollary continuous_imp_open_vimage: assumes "continuous_on s f" "open s" "open B" "f -` B \ s" shows "open (f -` B)" by (metis assms continuous_on_open_vimage le_iff_inf) corollary open_vimage[continuous_intros]: assumes "open s" and "continuous_on UNIV f" shows "open (f -` s)" using assms by (simp add: continuous_on_open_vimage [OF open_UNIV]) lemma continuous_on_closed_invariant: "continuous_on s f \ (\B. closed B \ (\A. closed A \ A \ s = f -` B \ s))" proof - have *: "(\A. P A \ Q (- A)) \ (\A. P A) \ (\A. Q A)" for P Q :: "'b set \ bool" by (metis double_compl) show ?thesis unfolding continuous_on_open_invariant by (intro *) (auto simp: open_closed[symmetric]) qed lemma continuous_on_closed_vimage: "closed s \ continuous_on s f \ (\B. closed B \ closed (f -` B \ s))" unfolding continuous_on_closed_invariant by (metis closed_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s]) corollary closed_vimage_Int[continuous_intros]: assumes "closed s" and "continuous_on t f" and t: "closed t" shows "closed (f -` s \ t)" using assms by (simp add: continuous_on_closed_vimage [OF t]) corollary closed_vimage[continuous_intros]: assumes "closed s" and "continuous_on UNIV f" shows "closed (f -` s)" using closed_vimage_Int [OF assms] by simp lemma continuous_on_empty [simp]: "continuous_on {} f" by (simp add: continuous_on_def) lemma continuous_on_sing [simp]: "continuous_on {x} f" by (simp add: continuous_on_def at_within_def) lemma continuous_on_open_Union: "(\s. s \ S \ open s) \ (\s. s \ S \ continuous_on s f) \ continuous_on (\S) f" unfolding continuous_on_def by safe (metis open_Union at_within_open UnionI) lemma continuous_on_open_UN: "(\s. s \ S \ open (A s)) \ (\s. s \ S \ continuous_on (A s) f) \ continuous_on (\s\S. A s) f" by (rule continuous_on_open_Union) auto lemma continuous_on_open_Un: "open s \ open t \ continuous_on s f \ continuous_on t f \ continuous_on (s \ t) f" using continuous_on_open_Union [of "{s,t}"] by auto lemma continuous_on_closed_Un: "closed s \ closed t \ continuous_on s f \ continuous_on t f \ continuous_on (s \ t) f" by (auto simp add: continuous_on_closed_vimage closed_Un Int_Un_distrib) lemma continuous_on_closed_Union: assumes "finite I" "\i. i \ I \ closed (U i)" "\i. i \ I \ continuous_on (U i) f" shows "continuous_on (\ i \ I. U i) f" using assms by (induction I) (auto intro!: continuous_on_closed_Un) lemma continuous_on_If: assumes closed: "closed s" "closed t" and cont: "continuous_on s f" "continuous_on t g" and P: "\x. x \ s \ \ P x \ f x = g x" "\x. x \ t \ P x \ f x = g x" shows "continuous_on (s \ t) (\x. if P x then f x else g x)" (is "continuous_on _ ?h") proof- from P have "\x\s. f x = ?h x" "\x\t. g x = ?h x" by auto with cont have "continuous_on s ?h" "continuous_on t ?h" by simp_all with closed show ?thesis by (rule continuous_on_closed_Un) qed lemma continuous_on_cases: "closed s \ closed t \ continuous_on s f \ continuous_on t g \ \x. (x\s \ \ P x) \ (x \ t \ P x) \ f x = g x \ continuous_on (s \ t) (\x. if P x then f x else g x)" by (rule continuous_on_If) auto lemma continuous_on_id[continuous_intros,simp]: "continuous_on s (\x. x)" unfolding continuous_on_def by fast lemma continuous_on_id'[continuous_intros,simp]: "continuous_on s id" unfolding continuous_on_def id_def by fast lemma continuous_on_const[continuous_intros,simp]: "continuous_on s (\x. c)" unfolding continuous_on_def by auto lemma continuous_on_subset: "continuous_on s f \ t \ s \ continuous_on t f" unfolding continuous_on_def by (metis subset_eq tendsto_within_subset) lemma continuous_on_compose[continuous_intros]: "continuous_on s f \ continuous_on (f ` s) g \ continuous_on s (g \ f)" unfolding continuous_on_topological by simp metis lemma continuous_on_compose2: "continuous_on t g \ continuous_on s f \ f ` s \ t \ continuous_on s (\x. g (f x))" using continuous_on_compose[of s f g] continuous_on_subset by (force simp add: comp_def) lemma continuous_on_generate_topology: assumes *: "open = generate_topology X" and **: "\B. B \ X \ \C. open C \ C \ A = f -` B \ A" shows "continuous_on A f" unfolding continuous_on_open_invariant proof safe fix B :: "'a set" assume "open B" then show "\C. open C \ C \ A = f -` B \ A" unfolding * proof induct case (UN K) then obtain C where "\k. k \ K \ open (C k)" "\k. k \ K \ C k \ A = f -` k \ A" by metis then show ?case by (intro exI[of _ "\k\K. C k"]) blast qed (auto intro: **) qed lemma continuous_onI_mono: fixes f :: "'a::linorder_topology \ 'b::{dense_order,linorder_topology}" assumes "open (f`A)" and mono: "\x y. x \ A \ y \ A \ x \ y \ f x \ f y" shows "continuous_on A f" proof (rule continuous_on_generate_topology[OF open_generated_order], safe) have monoD: "\x y. x \ A \ y \ A \ f x < f y \ x < y" by (auto simp: not_le[symmetric] mono) have "\x. x \ A \ f x < b \ a < x" if a: "a \ A" and fa: "f a < b" for a b proof - obtain y where "f a < y" "{f a ..< y} \ f`A" using open_right[OF \open (f`A)\, of "f a" b] a fa by auto obtain z where z: "f a < z" "z < min b y" using dense[of "f a" "min b y"] \f a < y\ \f a < b\ by auto then obtain c where "z = f c" "c \ A" using \{f a ..< y} \ f`A\[THEN subsetD, of z] by (auto simp: less_imp_le) with a z show ?thesis by (auto intro!: exI[of _ c] simp: monoD) qed then show "\C. open C \ C \ A = f -` {.. A" for b by (intro exI[of _ "(\x\{x\A. f x < b}. {..< x})"]) (auto intro: le_less_trans[OF mono] less_imp_le) have "\x. x \ A \ b < f x \ x < a" if a: "a \ A" and fa: "b < f a" for a b proof - note a fa moreover obtain y where "y < f a" "{y <.. f a} \ f`A" using open_left[OF \open (f`A)\, of "f a" b] a fa by auto then obtain z where z: "max b y < z" "z < f a" using dense[of "max b y" "f a"] \y < f a\ \b < f a\ by auto then obtain c where "z = f c" "c \ A" using \{y <.. f a} \ f`A\[THEN subsetD, of z] by (auto simp: less_imp_le) with a z show ?thesis by (auto intro!: exI[of _ c] simp: monoD) qed then show "\C. open C \ C \ A = f -` {b <..} \ A" for b by (intro exI[of _ "(\x\{x\A. b < f x}. {x <..})"]) (auto intro: less_le_trans[OF _ mono] less_imp_le) qed lemma continuous_on_IccI: "\(f \ f a) (at_right a); (f \ f b) (at_left b); (\x. a < x \ x < b \ f \x\ f x); a < b\ \ continuous_on {a .. b} f" for a::"'a::linorder_topology" using at_within_open[of _ "{a<.. f a) (at_right a)" and continuous_on_Icc_at_leftD: "(f \ f b) (at_left b)" using assms by (auto simp: at_within_Icc_at_right at_within_Icc_at_left continuous_on_def dest: bspec[where x=a] bspec[where x=b]) lemma continuous_on_discrete [simp]: "continuous_on A (f :: 'a :: discrete_topology \ _)" by (auto simp: continuous_on_def at_discrete) subsubsection \Continuity at a point\ definition continuous :: "'a::t2_space filter \ ('a \ 'b::topological_space) \ bool" where "continuous F f \ (f \ f (Lim F (\x. x))) F" lemma continuous_bot[continuous_intros, simp]: "continuous bot f" unfolding continuous_def by auto lemma continuous_trivial_limit: "trivial_limit net \ continuous net f" by simp lemma continuous_within: "continuous (at x within s) f \ (f \ f x) (at x within s)" by (cases "trivial_limit (at x within s)") (auto simp add: Lim_ident_at continuous_def) lemma continuous_within_topological: "continuous (at x within s) f \ (\B. open B \ f x \ B \ (\A. open A \ x \ A \ (\y\s. y \ A \ f y \ B)))" unfolding continuous_within tendsto_def eventually_at_topological by metis lemma continuous_within_compose[continuous_intros]: "continuous (at x within s) f \ continuous (at (f x) within f ` s) g \ continuous (at x within s) (g \ f)" by (simp add: continuous_within_topological) metis lemma continuous_within_compose2: "continuous (at x within s) f \ continuous (at (f x) within f ` s) g \ continuous (at x within s) (\x. g (f x))" using continuous_within_compose[of x s f g] by (simp add: comp_def) lemma continuous_at: "continuous (at x) f \ f \x\ f x" using continuous_within[of x UNIV f] by simp lemma continuous_ident[continuous_intros, simp]: "continuous (at x within S) (\x. x)" unfolding continuous_within by (rule tendsto_ident_at) lemma continuous_id[continuous_intros, simp]: "continuous (at x within S) id" by (simp add: id_def) lemma continuous_const[continuous_intros, simp]: "continuous F (\x. c)" unfolding continuous_def by (rule tendsto_const) lemma continuous_on_eq_continuous_within: "continuous_on s f \ (\x\s. continuous (at x within s) f)" unfolding continuous_on_def continuous_within .. lemma continuous_discrete [simp]: "continuous (at x within A) (f :: 'a :: discrete_topology \ _)" by (auto simp: continuous_def at_discrete) abbreviation isCont :: "('a::t2_space \ 'b::topological_space) \ 'a \ bool" where "isCont f a \ continuous (at a) f" lemma isCont_def: "isCont f a \ f \a\ f a" by (rule continuous_at) lemma isContD: "isCont f x \ f \x\ f x" by (simp add: isCont_def) lemma isCont_cong: assumes "eventually (\x. f x = g x) (nhds x)" shows "isCont f x \ isCont g x" proof - from assms have [simp]: "f x = g x" by (rule eventually_nhds_x_imp_x) from assms have "eventually (\x. f x = g x) (at x)" by (auto simp: eventually_at_filter elim!: eventually_mono) with assms have "isCont f x \ isCont g x" unfolding isCont_def by (intro filterlim_cong) (auto elim!: eventually_mono) with assms show ?thesis by simp qed lemma continuous_at_imp_continuous_at_within: "isCont f x \ continuous (at x within s) f" by (auto intro: tendsto_mono at_le simp: continuous_at continuous_within) lemma continuous_on_eq_continuous_at: "open s \ continuous_on s f \ (\x\s. isCont f x)" by (simp add: continuous_on_def continuous_at at_within_open[of _ s]) lemma continuous_within_open: "a \ A \ open A \ continuous (at a within A) f \ isCont f a" by (simp add: at_within_open_NO_MATCH) lemma continuous_at_imp_continuous_on: "\x\s. isCont f x \ continuous_on s f" by (auto intro: continuous_at_imp_continuous_at_within simp: continuous_on_eq_continuous_within) lemma isCont_o2: "isCont f a \ isCont g (f a) \ isCont (\x. g (f x)) a" unfolding isCont_def by (rule tendsto_compose) lemma continuous_at_compose[continuous_intros]: "isCont f a \ isCont g (f a) \ isCont (g \ f) a" unfolding o_def by (rule isCont_o2) lemma isCont_tendsto_compose: "isCont g l \ (f \ l) F \ ((\x. g (f x)) \ g l) F" unfolding isCont_def by (rule tendsto_compose) lemma continuous_on_tendsto_compose: assumes f_cont: "continuous_on s f" and g: "(g \ l) F" and l: "l \ s" and ev: "\\<^sub>Fx in F. g x \ s" shows "((\x. f (g x)) \ f l) F" proof - from f_cont l have f: "(f \ f l) (at l within s)" by (simp add: continuous_on_def) have i: "((\x. if g x = l then f l else f (g x)) \ f l) F" by (rule filterlim_If) (auto intro!: filterlim_compose[OF f] eventually_conj tendsto_mono[OF _ g] simp: filterlim_at eventually_inf_principal eventually_mono[OF ev]) show ?thesis by (rule filterlim_cong[THEN iffD1[OF _ i]]) auto qed lemma continuous_within_compose3: "isCont g (f x) \ continuous (at x within s) f \ continuous (at x within s) (\x. g (f x))" using continuous_at_imp_continuous_at_within continuous_within_compose2 by blast lemma filtermap_nhds_open_map: assumes cont: "isCont f a" and open_map: "\S. open S \ open (f`S)" shows "filtermap f (nhds a) = nhds (f a)" unfolding filter_eq_iff proof safe fix P assume "eventually P (filtermap f (nhds a))" then obtain S where "open S" "a \ S" "\x\S. P (f x)" by (auto simp: eventually_filtermap eventually_nhds) then show "eventually P (nhds (f a))" unfolding eventually_nhds by (intro exI[of _ "f`S"]) (auto intro!: open_map) qed (metis filterlim_iff tendsto_at_iff_tendsto_nhds isCont_def eventually_filtermap cont) lemma continuous_at_split: "continuous (at x) f \ continuous (at_left x) f \ continuous (at_right x) f" for x :: "'a::linorder_topology" by (simp add: continuous_within filterlim_at_split) lemma continuous_on_max [continuous_intros]: fixes f g :: "'a::topological_space \ 'b::linorder_topology" shows "continuous_on A f \ continuous_on A g \ continuous_on A (\x. max (f x) (g x))" by (auto simp: continuous_on_def intro!: tendsto_max) lemma continuous_on_min [continuous_intros]: fixes f g :: "'a::topological_space \ 'b::linorder_topology" shows "continuous_on A f \ continuous_on A g \ continuous_on A (\x. min (f x) (g x))" by (auto simp: continuous_on_def intro!: tendsto_min) lemma continuous_max [continuous_intros]: fixes f :: "'a::t2_space \ 'b::linorder_topology" shows "\continuous F f; continuous F g\ \ continuous F (\x. (max (f x) (g x)))" by (simp add: tendsto_max continuous_def) lemma continuous_min [continuous_intros]: fixes f :: "'a::t2_space \ 'b::linorder_topology" shows "\continuous F f; continuous F g\ \ continuous F (\x. (min (f x) (g x)))" by (simp add: tendsto_min continuous_def) text \ The following open/closed Collect lemmas are ported from Sébastien Gouëzel's \Ergodic_Theory\. \ lemma open_Collect_neq: fixes f g :: "'a::topological_space \ 'b::t2_space" assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g" shows "open {x. f x \ g x}" proof (rule openI) fix t assume "t \ {x. f x \ g x}" then obtain U V where *: "open U" "open V" "f t \ U" "g t \ V" "U \ V = {}" by (auto simp add: separation_t2) with open_vimage[OF \open U\ f] open_vimage[OF \open V\ g] show "\T. open T \ t \ T \ T \ {x. f x \ g x}" by (intro exI[of _ "f -` U \ g -` V"]) auto qed lemma closed_Collect_eq: fixes f g :: "'a::topological_space \ 'b::t2_space" assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g" shows "closed {x. f x = g x}" using open_Collect_neq[OF f g] by (simp add: closed_def Collect_neg_eq) lemma open_Collect_less: fixes f g :: "'a::topological_space \ 'b::linorder_topology" assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g" shows "open {x. f x < g x}" proof (rule openI) fix t assume t: "t \ {x. f x < g x}" show "\T. open T \ t \ T \ T \ {x. f x < g x}" proof (cases "\z. f t < z \ z < g t") case True then obtain z where "f t < z \ z < g t" by blast then show ?thesis using open_vimage[OF _ f, of "{..< z}"] open_vimage[OF _ g, of "{z <..}"] by (intro exI[of _ "f -` {.. g -` {z<..}"]) auto next case False then have *: "{g t ..} = {f t <..}" "{..< g t} = {.. f t}" using t by (auto intro: leI) show ?thesis using open_vimage[OF _ f, of "{..< g t}"] open_vimage[OF _ g, of "{f t <..}"] t apply (intro exI[of _ "f -` {..< g t} \ g -` {f t<..}"]) apply (simp add: open_Int) apply (auto simp add: *) done qed qed lemma closed_Collect_le: fixes f g :: "'a :: topological_space \ 'b::linorder_topology" assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g" shows "closed {x. f x \ g x}" using open_Collect_less [OF g f] by (simp add: closed_def Collect_neg_eq[symmetric] not_le) subsubsection \Open-cover compactness\ context topological_space begin definition compact :: "'a set \ bool" where compact_eq_Heine_Borel: (* This name is used for backwards compatibility *) "compact S \ (\C. (\c\C. open c) \ S \ \C \ (\D\C. finite D \ S \ \D))" lemma compactI: assumes "\C. \t\C. open t \ s \ \C \ \C'. C' \ C \ finite C' \ s \ \C'" shows "compact s" unfolding compact_eq_Heine_Borel using assms by metis lemma compact_empty[simp]: "compact {}" by (auto intro!: compactI) lemma compactE: (*related to COMPACT_IMP_HEINE_BOREL in HOL Light*) assumes "compact S" "S \ \\" "\B. B \ \ \ open B" obtains \' where "\' \ \" "finite \'" "S \ \\'" by (meson assms compact_eq_Heine_Borel) lemma compactE_image: assumes "compact S" and opn: "\T. T \ C \ open (f T)" and S: "S \ (\c\C. f c)" obtains C' where "C' \ C" and "finite C'" and "S \ (\c\C'. f c)" apply (rule compactE[OF \compact S\ S]) using opn apply force by (metis finite_subset_image) lemma compact_Int_closed [intro]: assumes "compact S" and "closed T" shows "compact (S \ T)" proof (rule compactI) fix C assume C: "\c\C. open c" assume cover: "S \ T \ \C" from C \closed T\ have "\c\C \ {- T}. open c" by auto moreover from cover have "S \ \(C \ {- T})" by auto ultimately have "\D\C \ {- T}. finite D \ S \ \D" using \compact S\ unfolding compact_eq_Heine_Borel by auto then obtain D where "D \ C \ {- T} \ finite D \ S \ \D" .. then show "\D\C. finite D \ S \ T \ \D" by (intro exI[of _ "D - {-T}"]) auto qed lemma compact_diff: "\compact S; open T\ \ compact(S - T)" by (simp add: Diff_eq compact_Int_closed open_closed) lemma inj_setminus: "inj_on uminus (A::'a set set)" by (auto simp: inj_on_def) subsection \Finite intersection property\ lemma compact_fip: "compact U \ (\A. (\a\A. closed a) \ (\B \ A. finite B \ U \ \B \ {}) \ U \ \A \ {})" (is "_ \ ?R") proof (safe intro!: compact_eq_Heine_Borel[THEN iffD2]) fix A assume "compact U" assume A: "\a\A. closed a" "U \ \A = {}" assume fin: "\B \ A. finite B \ U \ \B \ {}" from A have "(\a\uminus`A. open a) \ U \ \(uminus`A)" by auto with \compact U\ obtain B where "B \ A" "finite (uminus`B)" "U \ \(uminus`B)" unfolding compact_eq_Heine_Borel by (metis subset_image_iff) with fin[THEN spec, of B] show False by (auto dest: finite_imageD intro: inj_setminus) next fix A assume ?R assume "\a\A. open a" "U \ \A" then have "U \ \(uminus`A) = {}" "\a\uminus`A. closed a" by auto with \?R\ obtain B where "B \ A" "finite (uminus`B)" "U \ \(uminus`B) = {}" by (metis subset_image_iff) then show "\T\A. finite T \ U \ \T" by (auto intro!: exI[of _ B] inj_setminus dest: finite_imageD) qed lemma compact_imp_fip: assumes "compact S" and "\T. T \ F \ closed T" and "\F'. finite F' \ F' \ F \ S \ (\F') \ {}" shows "S \ (\F) \ {}" using assms unfolding compact_fip by auto lemma compact_imp_fip_image: assumes "compact s" and P: "\i. i \ I \ closed (f i)" and Q: "\I'. finite I' \ I' \ I \ (s \ (\i\I'. f i) \ {})" shows "s \ (\i\I. f i) \ {}" proof - note \compact s\ moreover from P have "\i \ f ` I. closed i" by blast moreover have "\A. finite A \ A \ f ` I \ (s \ (\A) \ {})" apply rule apply rule apply (erule conjE) proof - fix A :: "'a set set" assume "finite A" and "A \ f ` I" then obtain B where "B \ I" and "finite B" and "A = f ` B" using finite_subset_image [of A f I] by blast with Q [of B] show "s \ \A \ {}" by simp qed ultimately have "s \ (\(f ` I)) \ {}" by (metis compact_imp_fip) then show ?thesis by simp qed end lemma (in t2_space) compact_imp_closed: assumes "compact s" shows "closed s" unfolding closed_def proof (rule openI) fix y assume "y \ - s" let ?C = "\x\s. {u. open u \ x \ u \ eventually (\y. y \ u) (nhds y)}" have "s \ \?C" proof fix x assume "x \ s" with \y \ - s\ have "x \ y" by clarsimp then have "\u v. open u \ open v \ x \ u \ y \ v \ u \ v = {}" by (rule hausdorff) with \x \ s\ show "x \ \?C" unfolding eventually_nhds by auto qed then obtain D where "D \ ?C" and "finite D" and "s \ \D" by (rule compactE [OF \compact s\]) auto from \D \ ?C\ have "\x\D. eventually (\y. y \ x) (nhds y)" by auto with \finite D\ have "eventually (\y. y \ \D) (nhds y)" by (simp add: eventually_ball_finite) with \s \ \D\ have "eventually (\y. y \ s) (nhds y)" by (auto elim!: eventually_mono) then show "\t. open t \ y \ t \ t \ - s" by (simp add: eventually_nhds subset_eq) qed lemma compact_continuous_image: assumes f: "continuous_on s f" and s: "compact s" shows "compact (f ` s)" proof (rule compactI) fix C assume "\c\C. open c" and cover: "f`s \ \C" with f have "\c\C. \A. open A \ A \ s = f -` c \ s" unfolding continuous_on_open_invariant by blast then obtain A where A: "\c\C. open (A c) \ A c \ s = f -` c \ s" unfolding bchoice_iff .. with cover have "\c. c \ C \ open (A c)" "s \ (\c\C. A c)" by (fastforce simp add: subset_eq set_eq_iff)+ from compactE_image[OF s this] obtain D where "D \ C" "finite D" "s \ (\c\D. A c)" . with A show "\D \ C. finite D \ f`s \ \D" by (intro exI[of _ D]) (fastforce simp add: subset_eq set_eq_iff)+ qed lemma continuous_on_inv: fixes f :: "'a::topological_space \ 'b::t2_space" assumes "continuous_on s f" and "compact s" and "\x\s. g (f x) = x" shows "continuous_on (f ` s) g" unfolding continuous_on_topological proof (clarsimp simp add: assms(3)) fix x :: 'a and B :: "'a set" assume "x \ s" and "open B" and "x \ B" have 1: "\x\s. f x \ f ` (s - B) \ x \ s - B" using assms(3) by (auto, metis) have "continuous_on (s - B) f" using \continuous_on s f\ Diff_subset by (rule continuous_on_subset) moreover have "compact (s - B)" using \open B\ and \compact s\ unfolding Diff_eq by (intro compact_Int_closed closed_Compl) ultimately have "compact (f ` (s - B))" by (rule compact_continuous_image) then have "closed (f ` (s - B))" by (rule compact_imp_closed) then have "open (- f ` (s - B))" by (rule open_Compl) moreover have "f x \ - f ` (s - B)" using \x \ s\ and \x \ B\ by (simp add: 1) moreover have "\y\s. f y \ - f ` (s - B) \ y \ B" by (simp add: 1) ultimately show "\A. open A \ f x \ A \ (\y\s. f y \ A \ y \ B)" by fast qed lemma continuous_on_inv_into: fixes f :: "'a::topological_space \ 'b::t2_space" assumes s: "continuous_on s f" "compact s" and f: "inj_on f s" shows "continuous_on (f ` s) (the_inv_into s f)" by (rule continuous_on_inv[OF s]) (auto simp: the_inv_into_f_f[OF f]) lemma (in linorder_topology) compact_attains_sup: assumes "compact S" "S \ {}" shows "\s\S. \t\S. t \ s" proof (rule classical) assume "\ (\s\S. \t\S. t \ s)" then obtain t where t: "\s\S. t s \ S" and "\s\S. s < t s" by (metis not_le) then have "\s. s\S \ open {..< t s}" "S \ (\s\S. {..< t s})" by auto with \compact S\ obtain C where "C \ S" "finite C" and C: "S \ (\s\C. {..< t s})" by (metis compactE_image) with \S \ {}\ have Max: "Max (t`C) \ t`C" and "\s\t`C. s \ Max (t`C)" by (auto intro!: Max_in) with C have "S \ {..< Max (t`C)}" by (auto intro: less_le_trans simp: subset_eq) with t Max \C \ S\ show ?thesis by fastforce qed lemma (in linorder_topology) compact_attains_inf: assumes "compact S" "S \ {}" shows "\s\S. \t\S. s \ t" proof (rule classical) assume "\ (\s\S. \t\S. s \ t)" then obtain t where t: "\s\S. t s \ S" and "\s\S. t s < s" by (metis not_le) then have "\s. s\S \ open {t s <..}" "S \ (\s\S. {t s <..})" by auto with \compact S\ obtain C where "C \ S" "finite C" and C: "S \ (\s\C. {t s <..})" by (metis compactE_image) with \S \ {}\ have Min: "Min (t`C) \ t`C" and "\s\t`C. Min (t`C) \ s" by (auto intro!: Min_in) with C have "S \ {Min (t`C) <..}" by (auto intro: le_less_trans simp: subset_eq) with t Min \C \ S\ show ?thesis by fastforce qed lemma continuous_attains_sup: fixes f :: "'a::topological_space \ 'b::linorder_topology" shows "compact s \ s \ {} \ continuous_on s f \ (\x\s. \y\s. f y \ f x)" using compact_attains_sup[of "f ` s"] compact_continuous_image[of s f] by auto lemma continuous_attains_inf: fixes f :: "'a::topological_space \ 'b::linorder_topology" shows "compact s \ s \ {} \ continuous_on s f \ (\x\s. \y\s. f x \ f y)" using compact_attains_inf[of "f ` s"] compact_continuous_image[of s f] by auto subsection \Connectedness\ context topological_space begin definition "connected S \ \ (\A B. open A \ open B \ S \ A \ B \ A \ B \ S = {} \ A \ S \ {} \ B \ S \ {})" lemma connectedI: "(\A B. open A \ open B \ A \ U \ {} \ B \ U \ {} \ A \ B \ U = {} \ U \ A \ B \ False) \ connected U" by (auto simp: connected_def) lemma connected_empty [simp]: "connected {}" by (auto intro!: connectedI) lemma connected_sing [simp]: "connected {x}" by (auto intro!: connectedI) lemma connectedD: "connected A \ open U \ open V \ U \ V \ A = {} \ A \ U \ V \ U \ A = {} \ V \ A = {}" by (auto simp: connected_def) end lemma connected_closed: "connected s \ \ (\A B. closed A \ closed B \ s \ A \ B \ A \ B \ s = {} \ A \ s \ {} \ B \ s \ {})" apply (simp add: connected_def del: ex_simps, safe) apply (drule_tac x="-A" in spec) apply (drule_tac x="-B" in spec) apply (fastforce simp add: closed_def [symmetric]) apply (drule_tac x="-A" in spec) apply (drule_tac x="-B" in spec) apply (fastforce simp add: open_closed [symmetric]) done lemma connected_closedD: "\connected s; A \ B \ s = {}; s \ A \ B; closed A; closed B\ \ A \ s = {} \ B \ s = {}" by (simp add: connected_closed) lemma connected_Union: assumes cs: "\s. s \ S \ connected s" and ne: "\S \ {}" shows "connected(\S)" proof (rule connectedI) fix A B assume A: "open A" and B: "open B" and Alap: "A \ \S \ {}" and Blap: "B \ \S \ {}" and disj: "A \ B \ \S = {}" and cover: "\S \ A \ B" have disjs:"\s. s \ S \ A \ B \ s = {}" using disj by auto obtain sa where sa: "sa \ S" "A \ sa \ {}" using Alap by auto obtain sb where sb: "sb \ S" "B \ sb \ {}" using Blap by auto obtain x where x: "\s. s \ S \ x \ s" using ne by auto then have "x \ \S" using \sa \ S\ by blast then have "x \ A \ x \ B" using cover by auto then show False using cs [unfolded connected_def] by (metis A B IntI Sup_upper sa sb disjs x cover empty_iff subset_trans) qed lemma connected_Un: "connected s \ connected t \ s \ t \ {} \ connected (s \ t)" using connected_Union [of "{s,t}"] by auto lemma connected_diff_open_from_closed: assumes st: "s \ t" and tu: "t \ u" and s: "open s" and t: "closed t" and u: "connected u" and ts: "connected (t - s)" shows "connected(u - s)" proof (rule connectedI) fix A B assume AB: "open A" "open B" "A \ (u - s) \ {}" "B \ (u - s) \ {}" and disj: "A \ B \ (u - s) = {}" and cover: "u - s \ A \ B" then consider "A \ (t - s) = {}" | "B \ (t - s) = {}" using st ts tu connectedD [of "t-s" "A" "B"] by auto then show False proof cases case 1 then have "(A - t) \ (B \ s) \ u = {}" using disj st by auto moreover have "u \ (A - t) \ (B \ s)" using 1 cover by auto ultimately show False using connectedD [of u "A - t" "B \ s"] AB s t 1 u by auto next case 2 then have "(A \ s) \ (B - t) \ u = {}" using disj st by auto moreover have "u \ (A \ s) \ (B - t)" using 2 cover by auto ultimately show False using connectedD [of u "A \ s" "B - t"] AB s t 2 u by auto qed qed lemma connected_iff_const: fixes S :: "'a::topological_space set" shows "connected S \ (\P::'a \ bool. continuous_on S P \ (\c. \s\S. P s = c))" proof safe fix P :: "'a \ bool" assume "connected S" "continuous_on S P" then have "\b. \A. open A \ A \ S = P -` {b} \ S" unfolding continuous_on_open_invariant by (simp add: open_discrete) from this[of True] this[of False] obtain t f where "open t" "open f" and *: "f \ S = P -` {False} \ S" "t \ S = P -` {True} \ S" by meson then have "t \ S = {} \ f \ S = {}" by (intro connectedD[OF \connected S\]) auto then show "\c. \s\S. P s = c" proof (rule disjE) assume "t \ S = {}" then show ?thesis unfolding * by (intro exI[of _ False]) auto next assume "f \ S = {}" then show ?thesis unfolding * by (intro exI[of _ True]) auto qed next assume P: "\P::'a \ bool. continuous_on S P \ (\c. \s\S. P s = c)" show "connected S" proof (rule connectedI) fix A B assume *: "open A" "open B" "A \ S \ {}" "B \ S \ {}" "A \ B \ S = {}" "S \ A \ B" have "continuous_on S (\x. x \ A)" unfolding continuous_on_open_invariant proof safe fix C :: "bool set" have "C = UNIV \ C = {True} \ C = {False} \ C = {}" using subset_UNIV[of C] unfolding UNIV_bool by auto with * show "\T. open T \ T \ S = (\x. x \ A) -` C \ S" by (intro exI[of _ "(if True \ C then A else {}) \ (if False \ C then B else {})"]) auto qed from P[rule_format, OF this] obtain c where "\s. s \ S \ (s \ A) = c" by blast with * show False by (cases c) auto qed qed lemma connectedD_const: "connected S \ continuous_on S P \ \c. \s\S. P s = c" for P :: "'a::topological_space \ bool" by (auto simp: connected_iff_const) lemma connectedI_const: "(\P::'a::topological_space \ bool. continuous_on S P \ \c. \s\S. P s = c) \ connected S" by (auto simp: connected_iff_const) lemma connected_local_const: assumes "connected A" "a \ A" "b \ A" and *: "\a\A. eventually (\b. f a = f b) (at a within A)" shows "f a = f b" proof - obtain S where S: "\a. a \ A \ a \ S a" "\a. a \ A \ open (S a)" "\a x. a \ A \ x \ S a \ x \ A \ f a = f x" using * unfolding eventually_at_topological by metis let ?P = "\b\{b\A. f a = f b}. S b" and ?N = "\b\{b\A. f a \ f b}. S b" have "?P \ A = {} \ ?N \ A = {}" using \connected A\ S \a\A\ by (intro connectedD) (auto, metis) then show "f a = f b" proof assume "?N \ A = {}" then have "\x\A. f a = f x" using S(1) by auto with \b\A\ show ?thesis by auto next assume "?P \ A = {}" then show ?thesis using \a \ A\ S(1)[of a] by auto qed qed lemma (in linorder_topology) connectedD_interval: assumes "connected U" and xy: "x \ U" "y \ U" and "x \ z" "z \ y" shows "z \ U" proof - have eq: "{.. {z<..} = - {z}" by auto have "\ connected U" if "z \ U" "x < z" "z < y" using xy that apply (simp only: connected_def simp_thms) apply (rule_tac exI[of _ "{..< z}"]) apply (rule_tac exI[of _ "{z <..}"]) apply (auto simp add: eq) done with assms show "z \ U" by (metis less_le) qed lemma (in linorder_topology) not_in_connected_cases: assumes conn: "connected S" assumes nbdd: "x \ S" assumes ne: "S \ {}" obtains "bdd_above S" "\y. y \ S \ x \ y" | "bdd_below S" "\y. y \ S \ x \ y" proof - obtain s where "s \ S" using ne by blast { assume "s \ x" have "False" if "x \ y" "y \ S" for y using connectedD_interval[OF conn \s \ S\ \y \ S\ \s \ x\ \x \ y\] \x \ S\ by simp then have wit: "y \ S \ x \ y" for y using le_cases by blast then have "bdd_above S" by (rule local.bdd_aboveI) note this wit } moreover { assume "x \ s" have "False" if "x \ y" "y \ S" for y using connectedD_interval[OF conn \y \ S\ \s \ S\ \x \ y\ \s \ x\ ] \x \ S\ by simp then have wit: "y \ S \ x \ y" for y using le_cases by blast then have "bdd_below S" by (rule bdd_belowI) note this wit } ultimately show ?thesis by (meson le_cases that) qed lemma connected_continuous_image: assumes *: "continuous_on s f" and "connected s" shows "connected (f ` s)" proof (rule connectedI_const) fix P :: "'b \ bool" assume "continuous_on (f ` s) P" then have "continuous_on s (P \ f)" by (rule continuous_on_compose[OF *]) from connectedD_const[OF \connected s\ this] show "\c. \s\f ` s. P s = c" by auto qed section \Linear Continuum Topologies\ class linear_continuum_topology = linorder_topology + linear_continuum begin lemma Inf_notin_open: assumes A: "open A" and bnd: "\a\A. x < a" shows "Inf A \ A" proof assume "Inf A \ A" then obtain b where "b < Inf A" "{b <.. Inf A} \ A" using open_left[of A "Inf A" x] assms by auto with dense[of b "Inf A"] obtain c where "c < Inf A" "c \ A" by (auto simp: subset_eq) then show False using cInf_lower[OF \c \ A\] bnd by (metis not_le less_imp_le bdd_belowI) qed lemma Sup_notin_open: assumes A: "open A" and bnd: "\a\A. a < x" shows "Sup A \ A" proof assume "Sup A \ A" with assms obtain b where "Sup A < b" "{Sup A ..< b} \ A" using open_right[of A "Sup A" x] by auto with dense[of "Sup A" b] obtain c where "Sup A < c" "c \ A" by (auto simp: subset_eq) then show False using cSup_upper[OF \c \ A\] bnd by (metis less_imp_le not_le bdd_aboveI) qed end instance linear_continuum_topology \ perfect_space proof fix x :: 'a obtain y where "x < y \ y < x" using ex_gt_or_lt [of x] .. with Inf_notin_open[of "{x}" y] Sup_notin_open[of "{x}" y] show "\ open {x}" by auto qed lemma connectedI_interval: fixes U :: "'a :: linear_continuum_topology set" assumes *: "\x y z. x \ U \ y \ U \ x \ z \ z \ y \ z \ U" shows "connected U" proof (rule connectedI) { fix A B assume "open A" "open B" "A \ B \ U = {}" "U \ A \ B" fix x y assume "x < y" "x \ A" "y \ B" "x \ U" "y \ U" let ?z = "Inf (B \ {x <..})" have "x \ ?z" "?z \ y" using \y \ B\ \x < y\ by (auto intro: cInf_lower cInf_greatest) with \x \ U\ \y \ U\ have "?z \ U" by (rule *) moreover have "?z \ B \ {x <..}" using \open B\ by (intro Inf_notin_open) auto ultimately have "?z \ A" using \x \ ?z\ \A \ B \ U = {}\ \x \ A\ \U \ A \ B\ by auto have "\b\B. b \ A \ b \ U" if "?z < y" proof - obtain a where "?z < a" "{?z ..< a} \ A" using open_right[OF \open A\ \?z \ A\ \?z < y\] by auto moreover obtain b where "b \ B" "x < b" "b < min a y" using cInf_less_iff[of "B \ {x <..}" "min a y"] \?z < a\ \?z < y\ \x < y\ \y \ B\ by auto moreover have "?z \ b" using \b \ B\ \x < b\ by (intro cInf_lower) auto moreover have "b \ U" using \x \ ?z\ \?z \ b\ \b < min a y\ by (intro *[OF \x \ U\ \y \ U\]) (auto simp: less_imp_le) ultimately show ?thesis by (intro bexI[of _ b]) auto qed then have False using \?z \ y\ \?z \ A\ \y \ B\ \y \ U\ \A \ B \ U = {}\ unfolding le_less by blast } note not_disjoint = this fix A B assume AB: "open A" "open B" "U \ A \ B" "A \ B \ U = {}" moreover assume "A \ U \ {}" then obtain x where x: "x \ U" "x \ A" by auto moreover assume "B \ U \ {}" then obtain y where y: "y \ U" "y \ B" by auto moreover note not_disjoint[of B A y x] not_disjoint[of A B x y] ultimately show False by (cases x y rule: linorder_cases) auto qed lemma connected_iff_interval: "connected U \ (\x\U. \y\U. \z. x \ z \ z \ y \ z \ U)" for U :: "'a::linear_continuum_topology set" by (auto intro: connectedI_interval dest: connectedD_interval) lemma connected_UNIV[simp]: "connected (UNIV::'a::linear_continuum_topology set)" by (simp add: connected_iff_interval) lemma connected_Ioi[simp]: "connected {a<..}" for a :: "'a::linear_continuum_topology" by (auto simp: connected_iff_interval) lemma connected_Ici[simp]: "connected {a..}" for a :: "'a::linear_continuum_topology" by (auto simp: connected_iff_interval) lemma connected_Iio[simp]: "connected {.. A" "b \ A" shows "{a <..< b} \ A" using connectedD_interval[OF assms] by (simp add: subset_eq Ball_def less_imp_le) lemma connected_contains_Icc: fixes A :: "'a::linorder_topology set" assumes "connected A" "a \ A" "b \ A" shows "{a..b} \ A" proof fix x assume "x \ {a..b}" then have "x = a \ x = b \ x \ {a<.. A" using assms connected_contains_Ioo[of A a b] by auto qed subsection \Intermediate Value Theorem\ lemma IVT': fixes f :: "'a::linear_continuum_topology \ 'b::linorder_topology" assumes y: "f a \ y" "y \ f b" "a \ b" and *: "continuous_on {a .. b} f" shows "\x. a \ x \ x \ b \ f x = y" proof - have "connected {a..b}" unfolding connected_iff_interval by auto from connected_continuous_image[OF * this, THEN connectedD_interval, of "f a" "f b" y] y show ?thesis by (auto simp add: atLeastAtMost_def atLeast_def atMost_def) qed lemma IVT2': fixes f :: "'a :: linear_continuum_topology \ 'b :: linorder_topology" assumes y: "f b \ y" "y \ f a" "a \ b" and *: "continuous_on {a .. b} f" shows "\x. a \ x \ x \ b \ f x = y" proof - have "connected {a..b}" unfolding connected_iff_interval by auto from connected_continuous_image[OF * this, THEN connectedD_interval, of "f b" "f a" y] y show ?thesis by (auto simp add: atLeastAtMost_def atLeast_def atMost_def) qed lemma IVT: fixes f :: "'a::linear_continuum_topology \ 'b::linorder_topology" shows "f a \ y \ y \ f b \ a \ b \ (\x. a \ x \ x \ b \ isCont f x) \ \x. a \ x \ x \ b \ f x = y" by (rule IVT') (auto intro: continuous_at_imp_continuous_on) lemma IVT2: fixes f :: "'a::linear_continuum_topology \ 'b::linorder_topology" shows "f b \ y \ y \ f a \ a \ b \ (\x. a \ x \ x \ b \ isCont f x) \ \x. a \ x \ x \ b \ f x = y" by (rule IVT2') (auto intro: continuous_at_imp_continuous_on) lemma continuous_inj_imp_mono: fixes f :: "'a::linear_continuum_topology \ 'b::linorder_topology" assumes x: "a < x" "x < b" and cont: "continuous_on {a..b} f" and inj: "inj_on f {a..b}" shows "(f a < f x \ f x < f b) \ (f b < f x \ f x < f a)" proof - note I = inj_on_eq_iff[OF inj] { assume "f x < f a" "f x < f b" then obtain s t where "x \ s" "s \ b" "a \ t" "t \ x" "f s = f t" "f x < f s" using IVT'[of f x "min (f a) (f b)" b] IVT2'[of f x "min (f a) (f b)" a] x by (auto simp: continuous_on_subset[OF cont] less_imp_le) with x I have False by auto } moreover { assume "f a < f x" "f b < f x" then obtain s t where "x \ s" "s \ b" "a \ t" "t \ x" "f s = f t" "f s < f x" using IVT'[of f a "max (f a) (f b)" x] IVT2'[of f b "max (f a) (f b)" x] x by (auto simp: continuous_on_subset[OF cont] less_imp_le) with x I have False by auto } ultimately show ?thesis using I[of a x] I[of x b] x less_trans[OF x] by (auto simp add: le_less less_imp_neq neq_iff) qed lemma continuous_at_Sup_mono: fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \ 'b::{linorder_topology,conditionally_complete_linorder}" assumes "mono f" and cont: "continuous (at_left (Sup S)) f" and S: "S \ {}" "bdd_above S" shows "f (Sup S) = (SUP s\S. f s)" proof (rule antisym) have f: "(f \ f (Sup S)) (at_left (Sup S))" using cont unfolding continuous_within . show "f (Sup S) \ (SUP s\S. f s)" proof cases assume "Sup S \ S" then show ?thesis by (rule cSUP_upper) (auto intro: bdd_above_image_mono S \mono f\) next assume "Sup S \ S" from \S \ {}\ obtain s where "s \ S" by auto with \Sup S \ S\ S have "s < Sup S" unfolding less_le by (blast intro: cSup_upper) show ?thesis proof (rule ccontr) assume "\ ?thesis" with order_tendstoD(1)[OF f, of "SUP s\S. f s"] obtain b where "b < Sup S" and *: "\y. b < y \ y < Sup S \ (SUP s\S. f s) < f y" by (auto simp: not_le eventually_at_left[OF \s < Sup S\]) with \S \ {}\ obtain c where "c \ S" "b < c" using less_cSupD[of S b] by auto with \Sup S \ S\ S have "c < Sup S" unfolding less_le by (blast intro: cSup_upper) from *[OF \b < c\ \c < Sup S\] cSUP_upper[OF \c \ S\ bdd_above_image_mono[of f]] show False by (auto simp: assms) qed qed qed (intro cSUP_least \mono f\[THEN monoD] cSup_upper S) lemma continuous_at_Sup_antimono: fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \ 'b::{linorder_topology,conditionally_complete_linorder}" assumes "antimono f" and cont: "continuous (at_left (Sup S)) f" and S: "S \ {}" "bdd_above S" shows "f (Sup S) = (INF s\S. f s)" proof (rule antisym) have f: "(f \ f (Sup S)) (at_left (Sup S))" using cont unfolding continuous_within . show "(INF s\S. f s) \ f (Sup S)" proof cases assume "Sup S \ S" then show ?thesis by (intro cINF_lower) (auto intro: bdd_below_image_antimono S \antimono f\) next assume "Sup S \ S" from \S \ {}\ obtain s where "s \ S" by auto with \Sup S \ S\ S have "s < Sup S" unfolding less_le by (blast intro: cSup_upper) show ?thesis proof (rule ccontr) assume "\ ?thesis" with order_tendstoD(2)[OF f, of "INF s\S. f s"] obtain b where "b < Sup S" and *: "\y. b < y \ y < Sup S \ f y < (INF s\S. f s)" by (auto simp: not_le eventually_at_left[OF \s < Sup S\]) with \S \ {}\ obtain c where "c \ S" "b < c" using less_cSupD[of S b] by auto with \Sup S \ S\ S have "c < Sup S" unfolding less_le by (blast intro: cSup_upper) from *[OF \b < c\ \c < Sup S\] cINF_lower[OF bdd_below_image_antimono, of f S c] \c \ S\ show False by (auto simp: assms) qed qed qed (intro cINF_greatest \antimono f\[THEN antimonoD] cSup_upper S) lemma continuous_at_Inf_mono: fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \ 'b::{linorder_topology,conditionally_complete_linorder}" assumes "mono f" and cont: "continuous (at_right (Inf S)) f" and S: "S \ {}" "bdd_below S" shows "f (Inf S) = (INF s\S. f s)" proof (rule antisym) have f: "(f \ f (Inf S)) (at_right (Inf S))" using cont unfolding continuous_within . show "(INF s\S. f s) \ f (Inf S)" proof cases assume "Inf S \ S" then show ?thesis by (rule cINF_lower[rotated]) (auto intro: bdd_below_image_mono S \mono f\) next assume "Inf S \ S" from \S \ {}\ obtain s where "s \ S" by auto with \Inf S \ S\ S have "Inf S < s" unfolding less_le by (blast intro: cInf_lower) show ?thesis proof (rule ccontr) assume "\ ?thesis" with order_tendstoD(2)[OF f, of "INF s\S. f s"] obtain b where "Inf S < b" and *: "\y. Inf S < y \ y < b \ f y < (INF s\S. f s)" by (auto simp: not_le eventually_at_right[OF \Inf S < s\]) with \S \ {}\ obtain c where "c \ S" "c < b" using cInf_lessD[of S b] by auto with \Inf S \ S\ S have "Inf S < c" unfolding less_le by (blast intro: cInf_lower) from *[OF \Inf S < c\ \c < b\] cINF_lower[OF bdd_below_image_mono[of f] \c \ S\] show False by (auto simp: assms) qed qed qed (intro cINF_greatest \mono f\[THEN monoD] cInf_lower \bdd_below S\ \S \ {}\) lemma continuous_at_Inf_antimono: fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \ 'b::{linorder_topology,conditionally_complete_linorder}" assumes "antimono f" and cont: "continuous (at_right (Inf S)) f" and S: "S \ {}" "bdd_below S" shows "f (Inf S) = (SUP s\S. f s)" proof (rule antisym) have f: "(f \ f (Inf S)) (at_right (Inf S))" using cont unfolding continuous_within . show "f (Inf S) \ (SUP s\S. f s)" proof cases assume "Inf S \ S" then show ?thesis by (rule cSUP_upper) (auto intro: bdd_above_image_antimono S \antimono f\) next assume "Inf S \ S" from \S \ {}\ obtain s where "s \ S" by auto with \Inf S \ S\ S have "Inf S < s" unfolding less_le by (blast intro: cInf_lower) show ?thesis proof (rule ccontr) assume "\ ?thesis" with order_tendstoD(1)[OF f, of "SUP s\S. f s"] obtain b where "Inf S < b" and *: "\y. Inf S < y \ y < b \ (SUP s\S. f s) < f y" by (auto simp: not_le eventually_at_right[OF \Inf S < s\]) with \S \ {}\ obtain c where "c \ S" "c < b" using cInf_lessD[of S b] by auto with \Inf S \ S\ S have "Inf S < c" unfolding less_le by (blast intro: cInf_lower) from *[OF \Inf S < c\ \c < b\] cSUP_upper[OF \c \ S\ bdd_above_image_antimono[of f]] show False by (auto simp: assms) qed qed qed (intro cSUP_least \antimono f\[THEN antimonoD] cInf_lower S) subsection \Uniform spaces\ class uniformity = fixes uniformity :: "('a \ 'a) filter" begin abbreviation uniformity_on :: "'a set \ ('a \ 'a) filter" where "uniformity_on s \ inf uniformity (principal (s\s))" end lemma uniformity_Abort: "uniformity = Filter.abstract_filter (\u. Code.abort (STR ''uniformity is not executable'') (\u. uniformity))" by simp class open_uniformity = "open" + uniformity + assumes open_uniformity: "\U. open U \ (\x\U. eventually (\(x', y). x' = x \ y \ U) uniformity)" begin subclass topological_space by standard (force elim: eventually_mono eventually_elim2 simp: split_beta' open_uniformity)+ end class uniform_space = open_uniformity + assumes uniformity_refl: "eventually E uniformity \ E (x, x)" and uniformity_sym: "eventually E uniformity \ eventually (\(x, y). E (y, x)) uniformity" and uniformity_trans: "eventually E uniformity \ \D. eventually D uniformity \ (\x y z. D (x, y) \ D (y, z) \ E (x, z))" begin lemma uniformity_bot: "uniformity \ bot" using uniformity_refl by auto lemma uniformity_trans': "eventually E uniformity \ eventually (\((x, y), (y', z)). y = y' \ E (x, z)) (uniformity \\<^sub>F uniformity)" by (drule uniformity_trans) (auto simp add: eventually_prod_same) lemma uniformity_transE: assumes "eventually E uniformity" obtains D where "eventually D uniformity" "\x y z. D (x, y) \ D (y, z) \ E (x, z)" using uniformity_trans [OF assms] by auto lemma eventually_nhds_uniformity: "eventually P (nhds x) \ eventually (\(x', y). x' = x \ P y) uniformity" (is "_ \ ?N P x") unfolding eventually_nhds proof safe assume *: "?N P x" have "?N (?N P) x" if "?N P x" for x proof - from that obtain D where ev: "eventually D uniformity" and D: "D (a, b) \ D (b, c) \ case (a, c) of (x', y) \ x' = x \ P y" for a b c by (rule uniformity_transE) simp from ev show ?thesis by eventually_elim (insert ev D, force elim: eventually_mono split: prod.split) qed then have "open {x. ?N P x}" by (simp add: open_uniformity) then show "\S. open S \ x \ S \ (\x\S. P x)" by (intro exI[of _ "{x. ?N P x}"]) (auto dest: uniformity_refl simp: *) qed (force simp add: open_uniformity elim: eventually_mono) subsubsection \Totally bounded sets\ definition totally_bounded :: "'a set \ bool" where "totally_bounded S \ (\E. eventually E uniformity \ (\X. finite X \ (\s\S. \x\X. E (x, s))))" lemma totally_bounded_empty[iff]: "totally_bounded {}" by (auto simp add: totally_bounded_def) lemma totally_bounded_subset: "totally_bounded S \ T \ S \ totally_bounded T" by (fastforce simp add: totally_bounded_def) lemma totally_bounded_Union[intro]: assumes M: "finite M" "\S. S \ M \ totally_bounded S" shows "totally_bounded (\M)" unfolding totally_bounded_def proof safe fix E assume "eventually E uniformity" with M obtain X where "\S\M. finite (X S) \ (\s\S. \x\X S. E (x, s))" by (metis totally_bounded_def) with \finite M\ show "\X. finite X \ (\s\\M. \x\X. E (x, s))" by (intro exI[of _ "\S\M. X S"]) force qed subsubsection \Cauchy filter\ definition cauchy_filter :: "'a filter \ bool" where "cauchy_filter F \ F \\<^sub>F F \ uniformity" definition Cauchy :: "(nat \ 'a) \ bool" where Cauchy_uniform: "Cauchy X = cauchy_filter (filtermap X sequentially)" lemma Cauchy_uniform_iff: "Cauchy X \ (\P. eventually P uniformity \ (\N. \n\N. \m\N. P (X n, X m)))" unfolding Cauchy_uniform cauchy_filter_def le_filter_def eventually_prod_same eventually_filtermap eventually_sequentially proof safe let ?U = "\P. eventually P uniformity" { fix P assume "?U P" "\P. ?U P \ (\Q. (\N. \n\N. Q (X n)) \ (\x y. Q x \ Q y \ P (x, y)))" then obtain Q N where "\n. n \ N \ Q (X n)" "\x y. Q x \ Q y \ P (x, y)" by metis then show "\N. \n\N. \m\N. P (X n, X m)" by blast next fix P assume "?U P" and P: "\P. ?U P \ (\N. \n\N. \m\N. P (X n, X m))" then obtain Q where "?U Q" and Q: "\x y z. Q (x, y) \ Q (y, z) \ P (x, z)" by (auto elim: uniformity_transE) then have "?U (\x. Q x \ (\(x, y). Q (y, x)) x)" unfolding eventually_conj_iff by (simp add: uniformity_sym) from P[rule_format, OF this] obtain N where N: "\n m. n \ N \ m \ N \ Q (X n, X m) \ Q (X m, X n)" by auto show "\Q. (\N. \n\N. Q (X n)) \ (\x y. Q x \ Q y \ P (x, y))" proof (safe intro!: exI[of _ "\x. \n\N. Q (x, X n) \ Q (X n, x)"] exI[of _ N] N) fix x y assume "\n\N. Q (x, X n) \ Q (X n, x)" "\n\N. Q (y, X n) \ Q (X n, y)" then have "Q (x, X N)" "Q (X N, y)" by auto then show "P (x, y)" by (rule Q) qed } qed lemma nhds_imp_cauchy_filter: assumes *: "F \ nhds x" shows "cauchy_filter F" proof - have "F \\<^sub>F F \ nhds x \\<^sub>F nhds x" by (intro prod_filter_mono *) also have "\ \ uniformity" unfolding le_filter_def eventually_nhds_uniformity eventually_prod_same proof safe fix P assume "eventually P uniformity" then obtain Ql where ev: "eventually Ql uniformity" and "Ql (x, y) \ Ql (y, z) \ P (x, z)" for x y z by (rule uniformity_transE) simp with ev[THEN uniformity_sym] show "\Q. eventually (\(x', y). x' = x \ Q y) uniformity \ (\x y. Q x \ Q y \ P (x, y))" by (rule_tac exI[of _ "\y. Ql (y, x) \ Ql (x, y)"]) (fastforce elim: eventually_elim2) qed finally show ?thesis by (simp add: cauchy_filter_def) qed lemma LIMSEQ_imp_Cauchy: "X \ x \ Cauchy X" unfolding Cauchy_uniform filterlim_def by (intro nhds_imp_cauchy_filter) lemma Cauchy_subseq_Cauchy: assumes "Cauchy X" "strict_mono f" shows "Cauchy (X \ f)" unfolding Cauchy_uniform comp_def filtermap_filtermap[symmetric] cauchy_filter_def by (rule order_trans[OF _ \Cauchy X\[unfolded Cauchy_uniform cauchy_filter_def]]) (intro prod_filter_mono filtermap_mono filterlim_subseq[OF \strict_mono f\, unfolded filterlim_def]) lemma convergent_Cauchy: "convergent X \ Cauchy X" unfolding convergent_def by (erule exE, erule LIMSEQ_imp_Cauchy) definition complete :: "'a set \ bool" where complete_uniform: "complete S \ (\F \ principal S. F \ bot \ cauchy_filter F \ (\x\S. F \ nhds x))" end subsubsection \Uniformly continuous functions\ definition uniformly_continuous_on :: "'a set \ ('a::uniform_space \ 'b::uniform_space) \ bool" where uniformly_continuous_on_uniformity: "uniformly_continuous_on s f \ (LIM (x, y) (uniformity_on s). (f x, f y) :> uniformity)" lemma uniformly_continuous_onD: "uniformly_continuous_on s f \ eventually E uniformity \ eventually (\(x, y). x \ s \ y \ s \ E (f x, f y)) uniformity" by (simp add: uniformly_continuous_on_uniformity filterlim_iff eventually_inf_principal split_beta' mem_Times_iff imp_conjL) lemma uniformly_continuous_on_const[continuous_intros]: "uniformly_continuous_on s (\x. c)" by (auto simp: uniformly_continuous_on_uniformity filterlim_iff uniformity_refl) lemma uniformly_continuous_on_id[continuous_intros]: "uniformly_continuous_on s (\x. x)" by (auto simp: uniformly_continuous_on_uniformity filterlim_def) lemma uniformly_continuous_on_compose[continuous_intros]: "uniformly_continuous_on s g \ uniformly_continuous_on (g`s) f \ uniformly_continuous_on s (\x. f (g x))" using filterlim_compose[of "\(x, y). (f x, f y)" uniformity "uniformity_on (g`s)" "\(x, y). (g x, g y)" "uniformity_on s"] by (simp add: split_beta' uniformly_continuous_on_uniformity filterlim_inf filterlim_principal eventually_inf_principal mem_Times_iff) lemma uniformly_continuous_imp_continuous: assumes f: "uniformly_continuous_on s f" shows "continuous_on s f" by (auto simp: filterlim_iff eventually_at_filter eventually_nhds_uniformity continuous_on_def elim: eventually_mono dest!: uniformly_continuous_onD[OF f]) section \Product Topology\ subsection \Product is a topological space\ instantiation prod :: (topological_space, topological_space) topological_space begin definition open_prod_def[code del]: "open (S :: ('a \ 'b) set) \ (\x\S. \A B. open A \ open B \ x \ A \ B \ A \ B \ S)" lemma open_prod_elim: assumes "open S" and "x \ S" obtains A B where "open A" and "open B" and "x \ A \ B" and "A \ B \ S" using assms unfolding open_prod_def by fast lemma open_prod_intro: assumes "\x. x \ S \ \A B. open A \ open B \ x \ A \ B \ A \ B \ S" shows "open S" using assms unfolding open_prod_def by fast instance proof show "open (UNIV :: ('a \ 'b) set)" unfolding open_prod_def by auto next fix S T :: "('a \ 'b) set" assume "open S" "open T" show "open (S \ T)" proof (rule open_prod_intro) fix x assume x: "x \ S \ T" from x have "x \ S" by simp obtain Sa Sb where A: "open Sa" "open Sb" "x \ Sa \ Sb" "Sa \ Sb \ S" using \open S\ and \x \ S\ by (rule open_prod_elim) from x have "x \ T" by simp obtain Ta Tb where B: "open Ta" "open Tb" "x \ Ta \ Tb" "Ta \ Tb \ T" using \open T\ and \x \ T\ by (rule open_prod_elim) let ?A = "Sa \ Ta" and ?B = "Sb \ Tb" have "open ?A \ open ?B \ x \ ?A \ ?B \ ?A \ ?B \ S \ T" using A B by (auto simp add: open_Int) then show "\A B. open A \ open B \ x \ A \ B \ A \ B \ S \ T" by fast qed next fix K :: "('a \ 'b) set set" assume "\S\K. open S" then show "open (\K)" unfolding open_prod_def by fast qed end declare [[code abort: "open :: ('a::topological_space \ 'b::topological_space) set \ bool"]] lemma open_Times: "open S \ open T \ open (S \ T)" unfolding open_prod_def by auto lemma fst_vimage_eq_Times: "fst -` S = S \ UNIV" by auto lemma snd_vimage_eq_Times: "snd -` S = UNIV \ S" by auto lemma open_vimage_fst: "open S \ open (fst -` S)" by (simp add: fst_vimage_eq_Times open_Times) lemma open_vimage_snd: "open S \ open (snd -` S)" by (simp add: snd_vimage_eq_Times open_Times) lemma closed_vimage_fst: "closed S \ closed (fst -` S)" unfolding closed_open vimage_Compl [symmetric] by (rule open_vimage_fst) lemma closed_vimage_snd: "closed S \ closed (snd -` S)" unfolding closed_open vimage_Compl [symmetric] by (rule open_vimage_snd) lemma closed_Times: "closed S \ closed T \ closed (S \ T)" proof - have "S \ T = (fst -` S) \ (snd -` T)" by auto then show "closed S \ closed T \ closed (S \ T)" by (simp add: closed_vimage_fst closed_vimage_snd closed_Int) qed lemma subset_fst_imageI: "A \ B \ S \ y \ B \ A \ fst ` S" unfolding image_def subset_eq by force lemma subset_snd_imageI: "A \ B \ S \ x \ A \ B \ snd ` S" unfolding image_def subset_eq by force lemma open_image_fst: assumes "open S" shows "open (fst ` S)" proof (rule openI) fix x assume "x \ fst ` S" then obtain y where "(x, y) \ S" by auto then obtain A B where "open A" "open B" "x \ A" "y \ B" "A \ B \ S" using \open S\ unfolding open_prod_def by auto from \A \ B \ S\ \y \ B\ have "A \ fst ` S" by (rule subset_fst_imageI) with \open A\ \x \ A\ have "open A \ x \ A \ A \ fst ` S" by simp then show "\T. open T \ x \ T \ T \ fst ` S" .. qed lemma open_image_snd: assumes "open S" shows "open (snd ` S)" proof (rule openI) fix y assume "y \ snd ` S" then obtain x where "(x, y) \ S" by auto then obtain A B where "open A" "open B" "x \ A" "y \ B" "A \ B \ S" using \open S\ unfolding open_prod_def by auto from \A \ B \ S\ \x \ A\ have "B \ snd ` S" by (rule subset_snd_imageI) with \open B\ \y \ B\ have "open B \ y \ B \ B \ snd ` S" by simp then show "\T. open T \ y \ T \ T \ snd ` S" .. qed lemma nhds_prod: "nhds (a, b) = nhds a \\<^sub>F nhds b" unfolding nhds_def proof (subst prod_filter_INF, auto intro!: antisym INF_greatest simp: principal_prod_principal) fix S T assume "open S" "a \ S" "open T" "b \ T" then show "(INF x \ {S. open S \ (a, b) \ S}. principal x) \ principal (S \ T)" by (intro INF_lower) (auto intro!: open_Times) next fix S' assume "open S'" "(a, b) \ S'" then obtain S T where "open S" "a \ S" "open T" "b \ T" "S \ T \ S'" by (auto elim: open_prod_elim) then show "(INF x \ {S. open S \ a \ S}. INF y \ {S. open S \ b \ S}. principal (x \ y)) \ principal S'" by (auto intro!: INF_lower2) qed subsubsection \Continuity of operations\ lemma tendsto_fst [tendsto_intros]: assumes "(f \ a) F" shows "((\x. fst (f x)) \ fst a) F" proof (rule topological_tendstoI) fix S assume "open S" and "fst a \ S" then have "open (fst -` S)" and "a \ fst -` S" by (simp_all add: open_vimage_fst) with assms have "eventually (\x. f x \ fst -` S) F" by (rule topological_tendstoD) then show "eventually (\x. fst (f x) \ S) F" by simp qed lemma tendsto_snd [tendsto_intros]: assumes "(f \ a) F" shows "((\x. snd (f x)) \ snd a) F" proof (rule topological_tendstoI) fix S assume "open S" and "snd a \ S" then have "open (snd -` S)" and "a \ snd -` S" by (simp_all add: open_vimage_snd) with assms have "eventually (\x. f x \ snd -` S) F" by (rule topological_tendstoD) then show "eventually (\x. snd (f x) \ S) F" by simp qed lemma tendsto_Pair [tendsto_intros]: assumes "(f \ a) F" and "(g \ b) F" shows "((\x. (f x, g x)) \ (a, b)) F" unfolding nhds_prod using assms by (rule filterlim_Pair) lemma continuous_fst[continuous_intros]: "continuous F f \ continuous F (\x. fst (f x))" unfolding continuous_def by (rule tendsto_fst) lemma continuous_snd[continuous_intros]: "continuous F f \ continuous F (\x. snd (f x))" unfolding continuous_def by (rule tendsto_snd) lemma continuous_Pair[continuous_intros]: "continuous F f \ continuous F g \ continuous F (\x. (f x, g x))" unfolding continuous_def by (rule tendsto_Pair) lemma continuous_on_fst[continuous_intros]: "continuous_on s f \ continuous_on s (\x. fst (f x))" unfolding continuous_on_def by (auto intro: tendsto_fst) lemma continuous_on_snd[continuous_intros]: "continuous_on s f \ continuous_on s (\x. snd (f x))" unfolding continuous_on_def by (auto intro: tendsto_snd) lemma continuous_on_Pair[continuous_intros]: "continuous_on s f \ continuous_on s g \ continuous_on s (\x. (f x, g x))" unfolding continuous_on_def by (auto intro: tendsto_Pair) lemma continuous_on_swap[continuous_intros]: "continuous_on A prod.swap" by (simp add: prod.swap_def continuous_on_fst continuous_on_snd continuous_on_Pair continuous_on_id) lemma continuous_on_swap_args: assumes "continuous_on (A\B) (\(x,y). d x y)" shows "continuous_on (B\A) (\(x,y). d y x)" proof - have "(\(x,y). d y x) = (\(x,y). d x y) \ prod.swap" by force then show ?thesis by (metis assms continuous_on_compose continuous_on_swap product_swap) qed lemma isCont_fst [simp]: "isCont f a \ isCont (\x. fst (f x)) a" by (fact continuous_fst) lemma isCont_snd [simp]: "isCont f a \ isCont (\x. snd (f x)) a" by (fact continuous_snd) lemma isCont_Pair [simp]: "\isCont f a; isCont g a\ \ isCont (\x. (f x, g x)) a" by (fact continuous_Pair) lemma continuous_on_compose_Pair: assumes f: "continuous_on (Sigma A B) (\(a, b). f a b)" assumes g: "continuous_on C g" assumes h: "continuous_on C h" assumes subset: "\c. c \ C \ g c \ A" "\c. c \ C \ h c \ B (g c)" shows "continuous_on C (\c. f (g c) (h c))" using continuous_on_compose2[OF f continuous_on_Pair[OF g h]] subset by auto subsubsection \Connectedness of products\ proposition connected_Times: assumes S: "connected S" and T: "connected T" shows "connected (S \ T)" proof (rule connectedI_const) fix P::"'a \ 'b \ bool" assume P[THEN continuous_on_compose2, continuous_intros]: "continuous_on (S \ T) P" have "continuous_on S (\s. P (s, t))" if "t \ T" for t by (auto intro!: continuous_intros that) from connectedD_const[OF S this] obtain c1 where c1: "\s t. t \ T \ s \ S \ P (s, t) = c1 t" by metis moreover have "continuous_on T (\t. P (s, t))" if "s \ S" for s by (auto intro!: continuous_intros that) from connectedD_const[OF T this] obtain c2 where "\s t. t \ T \ s \ S \ P (s, t) = c2 s" by metis ultimately show "\c. \s\S \ T. P s = c" by auto qed corollary connected_Times_eq [simp]: "connected (S \ T) \ S = {} \ T = {} \ connected S \ connected T" (is "?lhs = ?rhs") proof assume L: ?lhs show ?rhs proof cases assume "S \ {} \ T \ {}" moreover have "connected (fst ` (S \ T))" "connected (snd ` (S \ T))" using continuous_on_fst continuous_on_snd continuous_on_id by (blast intro: connected_continuous_image [OF _ L])+ ultimately show ?thesis by auto qed auto qed (auto simp: connected_Times) subsubsection \Separation axioms\ instance prod :: (t0_space, t0_space) t0_space proof fix x y :: "'a \ 'b" assume "x \ y" then have "fst x \ fst y \ snd x \ snd y" by (simp add: prod_eq_iff) then show "\U. open U \ (x \ U) \ (y \ U)" by (fast dest: t0_space elim: open_vimage_fst open_vimage_snd) qed instance prod :: (t1_space, t1_space) t1_space proof fix x y :: "'a \ 'b" assume "x \ y" then have "fst x \ fst y \ snd x \ snd y" by (simp add: prod_eq_iff) then show "\U. open U \ x \ U \ y \ U" by (fast dest: t1_space elim: open_vimage_fst open_vimage_snd) qed instance prod :: (t2_space, t2_space) t2_space proof fix x y :: "'a \ 'b" assume "x \ y" then have "fst x \ fst y \ snd x \ snd y" by (simp add: prod_eq_iff) then show "\U V. open U \ open V \ x \ U \ y \ V \ U \ V = {}" by (fast dest: hausdorff elim: open_vimage_fst open_vimage_snd) qed lemma isCont_swap[continuous_intros]: "isCont prod.swap a" using continuous_on_eq_continuous_within continuous_on_swap by blast lemma open_diagonal_complement: "open {(x,y) |x y. x \ (y::('a::t2_space))}" proof - have "open {(x, y). x \ (y::'a)}" unfolding split_def by (intro open_Collect_neq continuous_intros) also have "{(x, y). x \ (y::'a)} = {(x, y) |x y. x \ (y::'a)}" by auto finally show ?thesis . qed lemma closed_diagonal: "closed {y. \ x::('a::t2_space). y = (x,x)}" proof - have "{y. \ x::'a. y = (x,x)} = UNIV - {(x,y) | x y. x \ y}" by auto then show ?thesis using open_diagonal_complement closed_Diff by auto qed lemma open_superdiagonal: "open {(x,y) | x y. x > (y::'a::{linorder_topology})}" proof - have "open {(x, y). x > (y::'a)}" unfolding split_def by (intro open_Collect_less continuous_intros) also have "{(x, y). x > (y::'a)} = {(x, y) |x y. x > (y::'a)}" by auto finally show ?thesis . qed lemma closed_subdiagonal: "closed {(x,y) | x y. x \ (y::'a::{linorder_topology})}" proof - have "{(x,y) | x y. x \ (y::'a)} = UNIV - {(x,y) | x y. x > (y::'a)}" by auto then show ?thesis using open_superdiagonal closed_Diff by auto qed lemma open_subdiagonal: "open {(x,y) | x y. x < (y::'a::{linorder_topology})}" proof - have "open {(x, y). x < (y::'a)}" unfolding split_def by (intro open_Collect_less continuous_intros) also have "{(x, y). x < (y::'a)} = {(x, y) |x y. x < (y::'a)}" by auto finally show ?thesis . qed lemma closed_superdiagonal: "closed {(x,y) | x y. x \ (y::('a::{linorder_topology}))}" proof - have "{(x,y) | x y. x \ (y::'a)} = UNIV - {(x,y) | x y. x < y}" by auto then show ?thesis using open_subdiagonal closed_Diff by auto qed end diff --git a/src/HOL/ex/Radix_Sort.thy b/src/HOL/ex/Radix_Sort.thy --- a/src/HOL/ex/Radix_Sort.thy +++ b/src/HOL/ex/Radix_Sort.thy @@ -1,110 +1,110 @@ (* Author: Tobias Nipkow *) theory Radix_Sort imports "HOL-Library.List_Lexorder" "HOL-Library.Sublist" "HOL-Library.Multiset" begin text \The \Radix_Sort\ locale provides a sorting function \radix_sort\ that sorts lists of lists. It is parameterized by a sorting function \sort1 f\ that also sorts lists of lists, but only w.r.t. the column selected by \f\. Working with lists, \f\ is instantiated with \<^term>\\xs. xs ! n\ to select the \n\-th element. A more efficient implementation would sort lists of arrays because arrays support constant time access to every element.\ locale Radix_Sort = fixes sort1 :: "('a list \ 'a::linorder) \ 'a list list \ 'a list list" assumes sorted: "sorted (map f (sort1 f xss))" assumes mset: "mset (sort1 f xss) = mset xss" assumes stable: "stable_sort_key sort1" begin lemma set_sort1[simp]: "set(sort1 f xss) = set xss" by (metis mset set_mset_mset) abbreviation "sort_col i xss \ sort1 (\xs. xs ! i) xss" abbreviation "sorted_col i xss \ sorted (map (\xs. xs ! i) xss)" fun radix_sort :: "nat \ 'a list list \ 'a list list" where "radix_sort 0 xss = xss" | "radix_sort (Suc i) xss = radix_sort i (sort_col i xss)" lemma mset_radix_sort: "mset (radix_sort i xss) = mset xss" by(induction i arbitrary: xss) (auto simp: mset) abbreviation "sorted_from i xss \ sorted (map (drop i) xss)" definition "cols xss n = (\xs \ set xss. length xs = n)" lemma cols_sort1: "cols xss n \ cols (sort1 f xss) n" by(simp add: cols_def) lemma sorted_from_Suc2: "\ cols xss n; i < n; sorted_col i xss; \x. sorted_from (i+1) [ys \ xss. ys!i = x] \ \ sorted_from i xss" proof(induction xss rule: induct_list012) case 1 show ?case by simp next case 2 show ?case by simp next case (3 xs1 xs2 xss) have lxs1: "length xs1 = n" and lxs2: "length xs2 = n" using "3.prems"(1) by(auto simp: cols_def) have *: "drop i xs1 \ drop i xs2" proof - have "drop i xs1 = xs1!i # drop (i+1) xs1" using \i < n\ by (simp add: Cons_nth_drop_Suc lxs1) also have "\ \ xs2!i # drop (i+1) xs2" using "3.prems"(3) "3.prems"(4)[of "xs2!i"] by(auto) also have "\ = drop i xs2" using \i < n\ by (simp add: Cons_nth_drop_Suc lxs2) finally show ?thesis . qed have "sorted_from i (xs2 # xss)" proof(rule "3.IH"[OF _ "3.prems"(2)]) show "cols (xs2 # xss) n" using "3.prems"(1) by(simp add: cols_def) show "sorted_col i (xs2 # xss)" using "3.prems"(3) by simp show "\x. sorted_from (i+1) [ys\xs2 # xss . ys ! i = x]" using "3.prems"(4) - sorted_antimono_suffix[OF map_mono_suffix[OF filter_mono_suffix[OF suffix_ConsI[OF suffix_order.order.refl]]]] + sorted_antimono_suffix[OF map_mono_suffix[OF filter_mono_suffix[OF suffix_ConsI[OF suffix_order.refl]]]] by fastforce qed with * show ?case by (auto) qed lemma sorted_from_radix_sort_step: assumes "cols xss n" and "i < n" and "sorted_from (i+1) xss" shows "sorted_from i (sort_col i xss)" proof (rule sorted_from_Suc2[OF cols_sort1[OF assms(1)] assms(2)]) show "sorted_col i (sort_col i xss)" by(simp add: sorted) fix x show "sorted_from (i+1) [ys \ sort_col i xss . ys ! i = x]" proof - from assms(3) have "sorted_from (i+1) (filter (\ys. ys!i = x) xss)" by(rule sorted_filter) thus "sorted (map (drop (i+1)) (filter (\ys. ys!i = x) (sort_col i xss)))" by (metis stable stable_sort_key_def) qed qed lemma sorted_from_radix_sort: "\ cols xss n; i \ n; sorted_from i xss \ \ sorted_from 0 (radix_sort i xss)" proof(induction i arbitrary: xss) case 0 thus ?case by simp next case (Suc i) thus ?case by(simp add: sorted_from_radix_sort_step cols_sort1) qed corollary sorted_radix_sort: "cols xss n \ sorted (radix_sort n xss)" apply(frule sorted_from_radix_sort[OF _ le_refl]) apply(auto simp add: cols_def sorted_iff_nth_mono) done end end