diff --git a/metadata/README b/metadata/README --- a/metadata/README +++ b/metadata/README @@ -1,122 +1,122 @@ Metadata format --------------- We're using a simple INI-like format for configuration files. - File `metadata` Master storage for entry metadata. Format: [] title = author = <author1> [<<url1>>], <author2> ... date = <YYYY>-<MM>-<HH> topic = <topic>/<subtopic>/..., <topic2>/... abstract = <text> notify = <email1>, <email2>, ... Optional: contributors = <contributor1> [<<url1>>], <contributor2> ... license = LGPL Example: [Presburger-Automata] title = Formalizing the Logic-Automaton Connection author = Stefan Berghofer <http://www.in.tum.de/~berghofe>, Markus Reiter date = 2009-12-03 - topic = Computer Science/Automata, Logic + topic = Computer science/Automata, Logic abstract = This abstract has multiple lines ... notify = stefan.berghofer@example.org The section name (`<short-name>` in this terminology) must correspond to the folder name in `thys` directory. This short name is used as entry identifier during the whole process. Currently, only three levels of topics and subtopics are allowed, but you may specify as many topics as you wish. If multiple topics are specified, the entry will appear under each of them. Note that the short name must be the same as their name in the `thys` folder. The topic must also appear in the `topics` file (see below). For each author, you may provide an URI (either a web page or a mail address, the latter prepended with `mailto:`) in standard `<protocol:uri>` notation. The section header and the keys must not contain leading whitespaces. When continuing a value on a second line, this and the following lines must be preceded by a whitespace. The date is the submission date of the entry. If you've chosen multiple topics, you can separate them with commas. If you want to have some additional text fields like 'Note' or 'Change history' below the 'Abstract' column, you can use the `extra` facility: extra-<key> = <heading>: <text> where `<key>` denotes an identifier (most cases 0, 1, ...) unique for each entry. The particular `<key>` has no impact on output and is solely used for disambiguating multiple extra fields. Example: extra-0 = Warning: Untested... extra-1 = History: [2010-01-01] new year For entries with a license other than BSD, you can add a line license = LGPL Allowed values are BSD and LGPL. Finally, sometimes existing entries get significant contributions from other authors. These authors can be listed on a 'contributors' line. A separate change-history entry should indicated what these people have contributed contributors = Peter Lammich <http://cs.uni-muenster.de/sev/staff/lammich/> extra-history = ... - File `release-dates` To list the older releases, a mapping between date and Isabelle version is necessary. Format: <isabelle-version> = <release-date> Example: 2003 = 2003-05-13 2004 = 2004-04-19 So, all tarballs between 2003-05-13 (inclusive) and 2004-04-19 (exclusive) will be treated as older release for 'Isabelle 2003'. - File `releases` Contains a list of all released tarballs. The youngest release is always ignored, so don't forget to add new releases when a new Isabelle version has been added to the `release-dates` file. Example: afp-AVL-Trees-2009-04-29.tar.gz afp-Abstract-Hoare-Logics-2007-11-27.tar.gz afp-Abstract-Hoare-Logics-2008-06-10.tar.gz - File `topics` Each topic and its subtopics must go into there. The format looks like that (where `_` denotes exactly one space character): first_level_topic __second_level_topic ____third_level_topic __another_second_level_topic Only three levels of indentation are supported currently. \ No newline at end of file diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,11514 +1,11664 @@ [Arith_Prog_Rel_Primes] title = Arithmetic progressions and relative primes author = José Manuel Rodríguez Caballero <https://josephcmac.github.io/> topic = Mathematics/Number theory date = 2020-02-01 notify = jose.manuel.rodriguez.caballero@ut.ee abstract = This article provides a formalization of the solution obtained by the author of the Problem “ARITHMETIC PROGRESSIONS” from the <a href="https://www.ocf.berkeley.edu/~wwu/riddles/putnam.shtml"> Putnam exam problems of 2002</a>. The statement of the problem is as follows: For which integers n > 1 does the set of positive integers less than and relatively prime to n constitute an arithmetic progression? [Banach_Steinhaus] title = Banach-Steinhaus Theorem author = Dominique Unruh <http://kodu.ut.ee/~unruh/> <mailto:unruh@ut.ee>, Jose Manuel Rodriguez Caballero <https://josephcmac.github.io/> <mailto:jose.manuel.rodriguez.caballero@ut.ee> topic = Mathematics/Analysis date = 2020-05-02 notify = jose.manuel.rodriguez.caballero@ut.ee, unruh@ut.ee abstract = We formalize in Isabelle/HOL a result due to S. Banach and H. Steinhaus known as the Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal. [Complex_Geometry] title = Complex Geometry author = Filip Marić <http://www.matf.bg.ac.rs/~filip>, Danijela Simić <http://poincare.matf.bg.ac.rs/~danijela> topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = A formalization of geometry of complex numbers is presented. Fundamental objects that are investigated are the complex plane extended by a single infinite point, its objects (points, lines and circles), and groups of transformations that act on them (e.g., inversions and Möbius transformations). Most objects are defined algebraically, but correspondence with classical geometric definitions is shown. [Poincare_Disc] title = Poincaré Disc Model author = Danijela Simić <http://poincare.matf.bg.ac.rs/~danijela>, Filip Marić <http://www.matf.bg.ac.rs/~filip>, Pierre Boutry <mailto:boutry@unistra.fr> topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = We describe formalization of the Poincaré disc model of hyperbolic geometry within the Isabelle/HOL proof assistant. The model is defined within the extended complex plane (one dimensional complex projectives space ℂP1), formalized in the AFP entry “Complex Geometry”. Points, lines, congruence of pairs of points, betweenness of triples of points, circles, and isometries are defined within the model. It is shown that the model satisfies all Tarski's axioms except the Euclid's axiom. It is shown that it satisfies its negation and the limiting parallels axiom (which proves it to be a model of hyperbolic geometry). [Fourier] title = Fourier Series author = Lawrence C Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Analysis date = 2019-09-06 notify = lp15@cam.ac.uk abstract = This development formalises the square integrable functions over the reals and the basics of Fourier series. It culminates with a proof that every well-behaved periodic function can be approximated by a Fourier series. The material is ported from HOL Light: https://github.com/jrh13/hol-light/blob/master/100/fourier.ml [Generic_Deriving] title = Deriving generic class instances for datatypes author = Jonas Rädle <mailto:jonas.raedle@gmail.com>, Lars Hupel <https://www21.in.tum.de/~hupel/> topic = Computer science/Data structures date = 2018-11-06 notify = jonas.raedle@gmail.com abstract = We provide a framework for automatically deriving instances for generic type classes. Our approach is inspired by Haskell's generic-deriving package and Scala's shapeless library. In addition to generating the code for type class functions, we also attempt to automatically prove type class laws for these instances. As of now, however, some manual proofs are still required for recursive datatypes. Note: There are already articles in the AFP that provide automatic instantiation for a number of classes. Concretely, <a href="https://www.isa-afp.org/entries/Deriving.html">Deriving</a> allows the automatic instantiation of comparators, linear orders, equality, and hashing. <a href="https://www.isa-afp.org/entries/Show.html">Show</a> instantiates a Haskell-style show class.Our approach works for arbitrary classes (with some Isabelle/HOL overhead for each class), but a smaller set of datatypes. [Partial_Order_Reduction] title = Partial Order Reduction author = Julian Brunner <http://www21.in.tum.de/~brunnerj/> topic = Computer science/Automata and formal languages date = 2018-06-05 notify = brunnerj@in.tum.de abstract = This entry provides a formalization of the abstract theory of ample set partial order reduction. The formalization includes transition systems with actions, trace theory, as well as basics on finite, infinite, and lazy sequences. We also provide a basic framework for static analysis on concurrent systems with respect to the ample set condition. [CakeML] title = CakeML author = Lars Hupel <https://www21.in.tum.de/~hupel/>, Yu Zhang <> contributors = Johannes Åman Pohjola <> topic = Computer science/Programming languages/Language definitions date = 2018-03-12 notify = hupel@in.tum.de abstract = CakeML is a functional programming language with a proven-correct compiler and runtime system. This entry contains an unofficial version of the CakeML semantics that has been exported from the Lem specifications to Isabelle. Additionally, there are some hand-written theory files that adapt the exported code to Isabelle and port proofs from the HOL4 formalization, e.g. termination and equivalence proofs. [CakeML_Codegen] title = A Verified Code Generator from Isabelle/HOL to CakeML author = Lars Hupel <https://lars.hupel.info/> topic = Computer science/Programming languages/Compiling, Logic/Rewriting date = 2019-07-08 notify = lars@hupel.info abstract = This entry contains the formalization that accompanies my PhD thesis (see https://lars.hupel.info/research/codegen/). I develop a verified compilation toolchain from executable specifications in Isabelle/HOL to CakeML abstract syntax trees. This improves over the state-of-the-art in Isabelle by providing a trustworthy procedure for code generation. [DiscretePricing] title = Pricing in discrete financial models author = Mnacho Echenim <http://lig-membres.imag.fr/mechenim/> topic = Mathematics/Probability theory, Mathematics/Games and economics date = 2018-07-16 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = We have formalized the computation of fair prices for derivative products in discrete financial models. As an application, we derive a way to compute fair prices of derivative products in the Cox-Ross-Rubinstein model of a financial market, thus completing the work that was presented in this <a href="https://hal.archives-ouvertes.fr/hal-01562944">paper</a>. extra-history = Change history: [2019-05-12]: Renamed discr_mkt predicate to stk_strict_subs and got rid of predicate A for a more natural definition of the type discrete_market; renamed basic quantity processes for coherent notation; renamed value_process into val_process and closing_value_process to cls_val_process; relaxed hypothesis of lemma CRR_market_fair_price. Added functions to price some basic options. (revision 0b813a1a833f) [Pell] title = Pell's Equation author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2018-06-23 notify = manuel@pruvisto.org abstract = This article gives the basic theory of Pell's equation x2 = 1 + D y2, where D ∈ ℕ is a parameter and x, y are integer variables. The main result that is proven is the following: If D is not a perfect square, then there exists a fundamental solution (x0, y0) that is not the trivial solution (1, 0) and which generates all other solutions (x, y) in the sense that there exists some n ∈ ℕ such that |x| + |y| √D = (x0 + y0 √D)n. This also implies that the set of solutions is infinite, and it gives us an explicit and executable characterisation of all the solutions. Based on this, simple executable algorithms for computing the fundamental solution and the infinite sequence of all non-negative solutions are also provided. [WebAssembly] title = WebAssembly author = Conrad Watt <http://www.cl.cam.ac.uk/~caw77/> topic = Computer science/Programming languages/Language definitions date = 2018-04-29 notify = caw77@cam.ac.uk abstract = This is a mechanised specification of the WebAssembly language, drawn mainly from the previously published paper formalisation of Haas et al. Also included is a full proof of soundness of the type system, together with a verified type checker and interpreter. We include only a partial procedure for the extraction of the type checker and interpreter here. For more details, please see our paper in CPP 2018. [Knuth_Morris_Pratt] title = The string search algorithm by Knuth, Morris and Pratt author = Fabian Hellauer <mailto:hellauer@in.tum.de>, Peter Lammich <http://www21.in.tum.de/~lammich> topic = Computer science/Algorithms date = 2017-12-18 notify = hellauer@in.tum.de, lammich@in.tum.de abstract = The Knuth-Morris-Pratt algorithm is often used to show that the problem of finding a string s in a text t can be solved deterministically in O(|s| + |t|) time. We use the Isabelle Refinement Framework to formulate and verify the algorithm. Via refinement, we apply some optimisations and finally use the Sepref tool to obtain executable code in Imperative/HOL. [Minkowskis_Theorem] title = Minkowski's Theorem author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Geometry, Mathematics/Number theory date = 2017-07-13 notify = manuel@pruvisto.org abstract = Minkowski's theorem relates a subset of ℝn, the Lebesgue measure, and the integer lattice ℤn: It states that any convex subset of ℝn with volume greater than 2n contains at least one lattice point from ℤn\{0}, i. e. a non-zero point with integer coefficients. A related theorem which directly implies this is Blichfeldt's theorem, which states that any subset of ℝn with a volume greater than 1 contains two different points whose difference vector has integer components. The entry contains a proof of both theorems. [Name_Carrying_Type_Inference] title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus author = Michael Rawson <mailto:michaelrawson76@gmail.com> topic = Computer science/Programming languages/Type systems date = 2017-07-09 notify = mr644@cam.ac.uk, michaelrawson76@gmail.com abstract = I formalise a Church-style simply-typed $\lambda$-calculus, extended with pairs, a unit value, and projection functions, and show some metatheory of the calculus, such as the subject reduction property. Particular attention is paid to the treatment of names in the calculus. A nominal style of binding is used, but I use a manual approach over Nominal Isabelle in order to extract an executable type inference algorithm. More information can be found in my <a href="http://www.openthesis.org/documents/Verified-Metatheory-Type-Inference-Simply-603182.html">undergraduate dissertation</a>. [Propositional_Proof_Systems] title = Propositional Proof Systems author = Julius Michaelis <http://liftm.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> topic = Logic/Proof theory date = 2017-06-21 notify = maintainafpppt@liftm.de abstract = We formalize a range of proof systems for classical propositional logic (sequent calculus, natural deduction, Hilbert systems, resolution) and prove the most important meta-theoretic results about semantics and proofs: compactness, soundness, completeness, translations between proof systems, cut-elimination, interpolation and model existence. [Optics] title = Optics author = Simon Foster <mailto:simon.foster@york.ac.uk>, Frank Zeyda <mailto:frank.zeyda@york.ac.uk> topic = Computer science/Functional programming, Mathematics/Algebra date = 2017-05-25 notify = simon.foster@york.ac.uk abstract = Lenses provide an abstract interface for manipulating data types through spatially-separated views. They are defined abstractly in terms of two functions, get, the return a value from the source type, and put that updates the value. We mechanise the underlying theory of lenses, in terms of an algebraic hierarchy of lenses, including well-behaved and very well-behaved lenses, each lens class being characterised by a set of lens laws. We also mechanise a lens algebra in Isabelle that enables their composition and comparison, so as to allow construction of complex lenses. This is accompanied by a large library of algebraic laws. Moreover we also show how the lens classes can be applied by instantiating them with a number of Isabelle data types. extra-history = Change history: [2020-03-02]: Added partial bijective and symmetric lenses. Improved alphabet command generating additional lenses and results. Several additional lens relations, including observational equivalence. Additional theorems throughout. Adaptations for Isabelle 2020. (revision 44e2e5c) [2021-01-27] Addition of new theorems throughout, particularly for prisms. New "chantype" command allows the definition of an algebraic datatype with generated prisms. New "dataspace" command allows the definition of a local-based state space, including lenses and prisms. Addition of various examples for the above. (revision 89cf045a) [2021-11-15] Improvement of alphabet and chantype commands to support code generation. Addition of a tactic "rename_alpha_vars" that removes the subscript vs in proof goals. Bug fixes and improvements to alphabet command ML implementation. Additional laws for scenes. (revisions 9f8bcd71c121 and c061bf9f46f3) [Game_Based_Crypto] title = Game-based cryptography in HOL author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <>, Bhargav Bhatt <mailto:bhargav.bhatt@inf.ethz.ch> topic = Computer science/Security/Cryptography date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = In this AFP entry, we show how to specify game-based cryptographic security notions and formally prove secure several cryptographic constructions from the literature using the CryptHOL framework. Among others, we formalise the notions of a random oracle, a pseudo-random function, an unpredictable function, and of encryption schemes that are indistinguishable under chosen plaintext and/or ciphertext attacks. We prove the random-permutation/random-function switching lemma, security of the Elgamal and hashed Elgamal public-key encryption scheme and correctness and security of several constructions with pseudo-random functions. Our proofs follow the game-hopping style advocated by Shoup and Bellare and Rogaway, from which most of the examples have been taken. We generalise some of their results such that they can be reused in other proofs. Thanks to CryptHOL's integration with Isabelle's parametricity infrastructure, many simple hops are easily justified using the theory of representation independence. extra-history = Change history: [2018-09-28]: added the CryptHOL tutorial for game-based cryptography (revision 489a395764ae) [Multi_Party_Computation] title = Multi-Party Computation author = David Aspinall <http://homepages.inf.ed.ac.uk/da/>, David Butler <mailto:dbutler@turing.ac.uk> topic = Computer science/Security date = 2019-05-09 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to consider Multi-Party Computation (MPC) protocols. MPC was first considered by Yao in 1983 and recent advances in efficiency and an increased demand mean it is now deployed in the real world. Security is considered using the real/ideal world paradigm. We first define security in the semi-honest security setting where parties are assumed not to deviate from the protocol transcript. In this setting we prove multiple Oblivious Transfer (OT) protocols secure and then show security for the gates of the GMW protocol. We then define malicious security, this is a stronger notion of security where parties are assumed to be fully corrupted by an adversary. In this setting we again consider OT, as it is a fundamental building block of almost all MPC protocols. [Sigma_Commit_Crypto] title = Sigma Protocols and Commitment Schemes author = David Butler <https://www.turing.ac.uk/people/doctoral-students/david-butler>, Andreas Lochbihler <http://www.andreas-lochbihler.de> topic = Computer science/Security/Cryptography date = 2019-10-07 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to formalise commitment schemes and Sigma-protocols. Both are widely used fundamental two party cryptographic primitives. Security for commitment schemes is considered using game-based definitions whereas the security of Sigma-protocols is considered using both the game-based and simulation-based security paradigms. In this work, we first define security for both primitives and then prove secure multiple case studies: the Schnorr, Chaum-Pedersen and Okamoto Sigma-protocols as well as a construction that allows for compound (AND and OR statements) Sigma-protocols and the Pedersen and Rivest commitment schemes. We also prove that commitment schemes can be constructed from Sigma-protocols. We formalise this proof at an abstract level, only assuming the existence of a Sigma-protocol; consequently, the instantiations of this result for the concrete Sigma-protocols we consider come for free. [CryptHOL] title = CryptHOL author = Andreas Lochbihler <http://www.andreas-lochbihler.de> topic = Computer science/Security/Cryptography, Computer science/Functional programming, Mathematics/Probability theory date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = CryptHOL provides a framework for formalising cryptographic arguments in Isabelle/HOL. It shallowly embeds a probabilistic functional programming language in higher order logic. The language features monadic sequencing, recursion, random sampling, failures and failure handling, and black-box access to oracles. Oracles are probabilistic functions which maintain hidden state between different invocations. All operators are defined in the new semantic domain of generative probabilistic values, a codatatype. We derive proof rules for the operators and establish a connection with the theory of relational parametricity. Thus, the resuting proofs are trustworthy and comprehensible, and the framework is extensible and widely applicable. The framework is used in the accompanying AFP entry "Game-based Cryptography in HOL". There, we show-case our framework by formalizing different game-based proofs from the literature. This formalisation continues the work described in the author's ESOP 2016 paper. [Constructive_Cryptography] title = Constructive Cryptography in HOL author = Andreas Lochbihler <http://www.andreas-lochbihler.de/>, S. Reza Sefidgar<> topic = Computer science/Security/Cryptography, Mathematics/Probability theory date = 2018-12-17 notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch abstract = Inspired by Abstract Cryptography, we extend CryptHOL, a framework for formalizing game-based proofs, with an abstract model of Random Systems and provide proof rules about their composition and equality. This foundation facilitates the formalization of Constructive Cryptography proofs, where the security of a cryptographic scheme is realized as a special form of construction in which a complex random system is built from simpler ones. This is a first step towards a fully-featured compositional framework, similar to Universal Composability framework, that supports formalization of simulation-based proofs. [Probabilistic_While] title = Probabilistic while loop author = Andreas Lochbihler <http://www.andreas-lochbihler.de> topic = Computer science/Functional programming, Mathematics/Probability theory, Computer science/Algorithms date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = This AFP entry defines a probabilistic while operator based on sub-probability mass functions and formalises zero-one laws and variant rules for probabilistic loop termination. As applications, we implement probabilistic algorithms for the Bernoulli, geometric and arbitrary uniform distributions that only use fair coin flips, and prove them correct and terminating with probability 1. extra-history = Change history: [2018-02-02]: Added a proof that probabilistic conditioning can be implemented by repeated sampling. (revision 305867c4e911) [Monad_Normalisation] title = Monad normalisation author = Joshua Schneider <>, Manuel Eberl <https://pruvisto.org>, Andreas Lochbihler <http://www.andreas-lochbihler.de> topic = Tools, Computer science/Functional programming, Logic/Rewriting date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The usual monad laws can directly be used as rewrite rules for Isabelle’s simplifier to normalise monadic HOL terms and decide equivalences. In a commutative monad, however, the commutativity law is a higher-order permutative rewrite rule that makes the simplifier loop. This AFP entry implements a simproc that normalises monadic expressions in commutative monads using ordered rewriting. The simproc can also permute computations across control operators like if and case. [Monomorphic_Monad] title = Effect polymorphism in higher-order logic author = Andreas Lochbihler <http://www.andreas-lochbihler.de> topic = Computer science/Functional programming date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The notion of a monad cannot be expressed within higher-order logic (HOL) due to type system restrictions. We show that if a monad is used with values of only one type, this notion can be formalised in HOL. Based on this idea, we develop a library of effect specifications and implementations of monads and monad transformers. Hence, we can abstract over the concrete monad in HOL definitions and thus use the same definition for different (combinations of) effects. We illustrate the usefulness of effect polymorphism with a monadic interpreter for a simple language. extra-history = Change history: [2018-02-15]: added further specifications and implementations of non-determinism; more examples (revision bc5399eea78e) [Constructor_Funs] title = Constructor Functions author = Lars Hupel <https://www21.in.tum.de/~hupel/> topic = Tools date = 2017-04-19 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, constructor applications have to be fully saturated. That means that for constructor calls occuring as arguments to higher-order functions, synthetic lambdas have to be inserted. This entry provides tooling to avoid this construction altogether by introducing constructor functions. [Lazy_Case] title = Lazifying case constants author = Lars Hupel <https://www21.in.tum.de/~hupel/> topic = Tools date = 2017-04-18 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, case statements are printed as match expressions. Internally, this is a sophisticated procedure, because in HOL, case statements are represented as nested calls to the case combinators as generated by the datatype package. Furthermore, the procedure relies on laziness of match expressions in the target language, i.e., that branches guarded by patterns that fail to match are not evaluated. Similarly, <tt>if-then-else</tt> is printed to the corresponding construct in the target language. This entry provides tooling to replace these special cases in the code generator by ignoring these target language features, instead printing case expressions and <tt>if-then-else</tt> as functions. [Dict_Construction] title = Dictionary Construction author = Lars Hupel <https://www21.in.tum.de/~hupel/> topic = Tools date = 2017-05-24 notify = hupel@in.tum.de abstract = Isabelle's code generator natively supports type classes. For targets that do not have language support for classes and instances, it performs the well-known dictionary translation, as described by Haftmann and Nipkow. This translation happens outside the logic, i.e., there is no guarantee that it is correct, besides the pen-and-paper proof. This work implements a certified dictionary translation that produces new class-free constants and derives equality theorems. [Higher_Order_Terms] title = An Algebra for Higher-Order Terms author = Lars Hupel <https://lars.hupel.info/> contributors = Yu Zhang <> topic = Computer science/Programming languages/Lambda calculi date = 2019-01-15 notify = lars@hupel.info abstract = In this formalization, I introduce a higher-order term algebra, generalizing the notions of free variables, matching, and substitution. The need arose from the work on a <a href="http://dx.doi.org/10.1007/978-3-319-89884-1_35">verified compiler from Isabelle to CakeML</a>. Terms can be thought of as consisting of a generic (free variables, constants, application) and a specific part. As example applications, this entry provides instantiations for de-Bruijn terms, terms with named variables, and <a href="https://www.isa-afp.org/entries/Lambda_Free_RPOs.html">Blanchette’s λ-free higher-order terms</a>. Furthermore, I implement translation functions between de-Bruijn terms and named terms and prove their correctness. [Subresultants] title = Subresultants author = Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> topic = Mathematics/Algebra date = 2017-04-06 notify = rene.thiemann@uibk.ac.at abstract = We formalize the theory of subresultants and the subresultant polynomial remainder sequence as described by Brown and Traub. As a result, we obtain efficient certified algorithms for computing the resultant and the greatest common divisor of polynomials. [Comparison_Sort_Lower_Bound] title = Lower bound on comparison-based sorting algorithms author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Algorithms date = 2017-03-15 notify = manuel@pruvisto.org abstract = This article contains a formal proof of the well-known fact that number of comparisons that a comparison-based sorting algorithm needs to perform to sort a list of length n is at least log2 (n!) in the worst case, i. e. Ω(n log n). For this purpose, a shallow embedding for comparison-based sorting algorithms is defined: a sorting algorithm is a recursive datatype containing either a HOL function or a query of a comparison oracle with a continuation containing the remaining computation. This makes it possible to force the algorithm to use only comparisons and to track the number of comparisons made. [Quick_Sort_Cost] title = The number of comparisons in QuickSort author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Algorithms date = 2017-03-15 notify = manuel@pruvisto.org abstract = We give a formal proof of the well-known results about the number of comparisons performed by two variants of QuickSort: first, the expected number of comparisons of randomised QuickSort (i. e. QuickSort with random pivot choice) is 2 (n+1) Hn - 4 n, which is asymptotically equivalent to 2 n ln n; second, the number of comparisons performed by the classic non-randomised QuickSort has the same distribution in the average case as the randomised one. [Random_BSTs] title = Expected Shape of Random Binary Search Trees author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Data structures date = 2017-04-04 notify = manuel@pruvisto.org abstract = This entry contains proofs for the textbook results about the distributions of the height and internal path length of random binary search trees (BSTs), i. e. BSTs that are formed by taking an empty BST and inserting elements from a fixed set in random order. In particular, we prove a logarithmic upper bound on the expected height and the Θ(n log n) closed-form solution for the expected internal path length in terms of the harmonic numbers. We also show how the internal path length relates to the average-case cost of a lookup in a BST. [Randomised_BSTs] title = Randomised Binary Search Trees author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Data structures date = 2018-10-19 notify = manuel@pruvisto.org abstract = This work is a formalisation of the Randomised Binary Search Trees introduced by Martínez and Roura, including definitions and correctness proofs. Like randomised treaps, they are a probabilistic data structure that behaves exactly as if elements were inserted into a non-balancing BST in random order. However, unlike treaps, they only use discrete probability distributions, but their use of randomness is more complicated. [E_Transcendental] title = The Transcendence of e author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-12 notify = manuel@pruvisto.org abstract = This work contains a proof that Euler's number e is transcendental. The proof follows the standard approach of assuming that e is algebraic and then using a specific integer polynomial to derive two inconsistent bounds, leading to a contradiction. This kind of approach can be found in many different sources; this formalisation mostly follows a <a href="http://planetmath.org/proofoflindemannweierstrasstheoremandthateandpiaretranscendental">PlanetMath article</a> by Roger Lipsett. [Pi_Transcendental] title = The Transcendence of π author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2018-09-28 notify = manuel@pruvisto.org abstract = This entry shows the transcendence of π based on the classic proof using the fundamental theorem of symmetric polynomials first given by von Lindemann in 1882, but the formalisation mostly follows the version by Niven. The proof reuses much of the machinery developed in the AFP entry on the transcendence of e. [Hermite_Lindemann] title = The Hermite–Lindemann–Weierstraß Transcendence Theorem author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2021-03-03 notify = manuel@pruvisto.org abstract = This article provides a formalisation of the Hermite-Lindemann-Weierstraß Theorem (also known as simply Hermite-Lindemann or Lindemann-Weierstraß). This theorem is one of the crowning achievements of 19th century number theory. The theorem states that if $\alpha_1, \ldots, \alpha_n\in\mathbb{C}$ are algebraic numbers that are linearly independent over $\mathbb{Z}$, then $e^{\alpha_1},\ldots,e^{\alpha_n}$ are algebraically independent over $\mathbb{Q}$. Like the <a href="https://doi.org/10.1007/978-3-319-66107-0_5">previous formalisation in Coq by Bernard</a>, I proceeded by formalising <a href="https://doi.org/10.1017/CBO9780511565977">Baker's version of the theorem and proof</a> and then deriving the original one from that. Baker's version states that for any algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have $\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only if all the $\beta_i$ are zero. This has a number of direct corollaries, e.g.: <ul> <li>$e$ and $\pi$ are transcendental</li> <li>$e^z$, $\sin z$, $\tan z$, etc. are transcendental for algebraic $z\in\mathbb{C}\setminus\{0\}$</li> <li>$\ln z$ is transcendental for algebraic $z\in\mathbb{C}\setminus\{0, 1\}$</li> </ul> [DFS_Framework] title = A Framework for Verifying Depth-First Search Algorithms author = Peter Lammich <http://www21.in.tum.de/~lammich>, René Neumann <mailto:neumannr@in.tum.de> notify = lammich@in.tum.de date = 2016-07-05 topic = Computer science/Algorithms/Graph abstract = This entry presents a framework for the modular verification of DFS-based algorithms, which is described in our [CPP-2015] paper. It provides a generic DFS algorithm framework, that can be parameterized with user-defined actions on certain events (e.g. discovery of new node). It comes with an extensible library of invariants, which can be used to derive invariants of a specific parameterization. Using refinement techniques, efficient implementations of the algorithms can easily be derived. Here, the framework comes with templates for a recursive and a tail-recursive implementation, and also with several templates for implementing the data structures required by the DFS algorithm. Finally, this entry contains a set of re-usable DFS-based algorithms, which illustrate the application of the framework. [CPP-2015] Peter Lammich, René Neumann: A Framework for Verifying Depth-First Search Algorithms. CPP 2015: 137-146 [Flow_Networks] title = Flow Networks and the Min-Cut-Max-Flow Theorem author = Peter Lammich <http://www21.in.tum.de/~lammich>, S. Reza Sefidgar <> topic = Mathematics/Graph theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of flow networks and the Min-Cut-Max-Flow theorem. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Prpu_Maxflow] title = Formalizing Push-Relabel Algorithms author = Peter Lammich <http://www21.in.tum.de/~lammich>, S. Reza Sefidgar <> topic = Computer science/Algorithms/Graph, Mathematics/Graph theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of push-relabel algorithms for computing the maximum flow in a network. We start with Goldberg's et al.~generic push-relabel algorithm, for which we show correctness and the time complexity bound of O(V^2E). We then derive the relabel-to-front and FIFO implementation. Using stepwise refinement techniques, we derive an efficient verified implementation. Our formal proof of the abstract algorithms closely follows a standard textbook proof. It is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Buildings] title = Chamber Complexes, Coxeter Systems, and Buildings author = Jeremy Sylvestre <http://ualberta.ca/~jsylvest/> notify = jeremy.sylvestre@ualberta.ca date = 2016-07-01 topic = Mathematics/Algebra, Mathematics/Geometry abstract = We provide a basic formal framework for the theory of chamber complexes and Coxeter systems, and for buildings as thick chamber complexes endowed with a system of apartments. Along the way, we develop some of the general theory of abstract simplicial complexes and of groups (relying on the group_add class for the basics), including free groups and group presentations, and their universal properties. The main results verified are that the deletion condition is both necessary and sufficient for a group with a set of generators of order two to be a Coxeter system, and that the apartments in a (thick) building are all uniformly Coxeter. [Algebraic_VCs] title = Program Construction and Verification Components Based on Kleene Algebra author = Victor B. F. Gomes <mailto:victor.gomes@cl.cam.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk> notify = victor.gomes@cl.cam.ac.uk, g.struth@sheffield.ac.uk date = 2016-06-18 topic = Mathematics/Algebra abstract = Variants of Kleene algebra support program construction and verification by algebraic reasoning. This entry provides a verification component for Hoare logic based on Kleene algebra with tests, verification components for weakest preconditions and strongest postconditions based on Kleene algebra with domain and a component for step-wise refinement based on refinement Kleene algebra with tests. In addition to these components for the partial correctness of while programs, a verification component for total correctness based on divergence Kleene algebras and one for (partial correctness) of recursive programs based on domain quantales are provided. Finally we have integrated memory models for programs with pointers and a program trace semantics into the weakest precondition component. [C2KA_DistributedSystems] title = Communicating Concurrent Kleene Algebra for Distributed Systems Specification author = Maxime Buyse <mailto:maxime.buyse@polytechnique.edu>, Jason Jaskolka <https://carleton.ca/jaskolka/> topic = Computer science/Automata and formal languages, Mathematics/Algebra date = 2019-08-06 notify = maxime.buyse@polytechnique.edu, jason.jaskolka@carleton.ca abstract = Communicating Concurrent Kleene Algebra (C²KA) is a mathematical framework for capturing the communicating and concurrent behaviour of agents in distributed systems. It extends Hoare et al.'s Concurrent Kleene Algebra (CKA) with communication actions through the notions of stimuli and shared environments. C²KA has applications in studying system-level properties of distributed systems such as safety, security, and reliability. In this work, we formalize results about C²KA and its application for distributed systems specification. We first formalize the stimulus structure and behaviour structure (CKA). Next, we combine them to formalize C²KA and its properties. Then, we formalize notions and properties related to the topology of distributed systems and the potential for communication via stimuli and via shared environments of agents, all within the algebraic setting of C²KA. [Card_Equiv_Relations] title = Cardinality of Equivalence Relations author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> notify = lukas.bulwahn@gmail.com date = 2016-05-24 topic = Mathematics/Combinatorics abstract = This entry provides formulae for counting the number of equivalence relations and partial equivalence relations over a finite carrier set with given cardinality. To count the number of equivalence relations, we provide bijections between equivalence relations and set partitions, and then transfer the main results of the two AFP entries, Cardinality of Set Partitions and Spivey's Generalized Recurrence for Bell Numbers, to theorems on equivalence relations. To count the number of partial equivalence relations, we observe that counting partial equivalence relations over a set A is equivalent to counting all equivalence relations over all subsets of the set A. From this observation and the results on equivalence relations, we show that the cardinality of partial equivalence relations over a finite set of cardinality n is equal to the n+1-th Bell number. [Twelvefold_Way] title = The Twelvefold Way author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> topic = Mathematics/Combinatorics date = 2016-12-29 notify = lukas.bulwahn@gmail.com abstract = This entry provides all cardinality theorems of the Twelvefold Way. The Twelvefold Way systematically classifies twelve related combinatorial problems concerning two finite sets, which include counting permutations, combinations, multisets, set partitions and number partitions. This development builds upon the existing formal developments with cardinality theorems for those structures. It provides twelve bijections from the various structures to different equivalence classes on finite functions, and hence, proves cardinality formulae for these equivalence classes on finite functions. [Chord_Segments] title = Intersecting Chords Theorem author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> notify = lukas.bulwahn@gmail.com date = 2016-10-11 topic = Mathematics/Geometry abstract = This entry provides a geometric proof of the intersecting chords theorem. The theorem states that when two chords intersect each other inside a circle, the products of their segments are equal. After a short review of existing proofs in the literature, I decided to use a proof approach that employs reasoning about lengths of line segments, the orthogonality of two lines and the Pythagoras Law. Hence, one can understand the formalized proof easily with the knowledge of a few general geometric facts that are commonly taught in high-school. This theorem is the 55th theorem of the Top 100 Theorems list. [Category3] title = Category Theory with Adjunctions and Limits author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu> notify = stark@cs.stonybrook.edu date = 2016-06-26 topic = Mathematics/Category theory abstract = This article attempts to develop a usable framework for doing category theory in Isabelle/HOL. Our point of view, which to some extent differs from that of the previous AFP articles on the subject, is to try to explore how category theory can be done efficaciously within HOL, rather than trying to match exactly the way things are done using a traditional approach. To this end, we define the notion of category in an "object-free" style, in which a category is represented by a single partial composition operation on arrows. This way of defining categories provides some advantages in the context of HOL, including the ability to avoid the use of records and the possibility of defining functors and natural transformations simply as certain functions on arrows, rather than as composite objects. We define various constructions associated with the basic notions, including: dual category, product category, functor category, discrete category, free category, functor composition, and horizontal and vertical composite of natural transformations. A "set category" locale is defined that axiomatizes the notion "category of all sets at a type and all functions between them," and a fairly extensive set of properties of set categories is derived from the locale assumptions. The notion of a set category is used to prove the Yoneda Lemma in a general setting of a category equipped with a "hom embedding," which maps arrows of the category to the "universe" of the set category. We also give a treatment of adjunctions, defining adjunctions via left and right adjoint functors, natural bijections between hom-sets, and unit and counit natural transformations, and showing the equivalence of these definitions. We also develop the theory of limits, including representations of functors, diagrams and cones, and diagonal functors. We show that right adjoint functors preserve limits, and that limits can be constructed via products and equalizers. We characterize the conditions under which limits exist in a set category. We also examine the case of limits in a functor category, ultimately culminating in a proof that the Yoneda embedding preserves limits. Revisions made subsequent to the first version of this article added material on equivalence of categories, cartesian categories, categories with pullbacks, categories with finite limits, and cartesian closed categories. A construction was given of the category of hereditarily finite sets and functions between them, and it was shown that this category is cartesian closed. extra-history = Change history: [2018-05-29]: Revised axioms for the category locale. Introduced notation for composition and "in hom". (revision 8318366d4575) [2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867) [2020-07-10]: Added new material, mostly centered around cartesian categories. (revision 06640f317a79) [2020-11-04]: Minor modifications and extensions made in conjunction with the addition of new material to Bicategory. (revision 472cb2268826) [2021-07-22]: Minor changes to sublocale declarations related to functor/natural transformation to avoid issues with global interpretations reported 2/2/2021 by Filip Smola. (revision 49d3aa43c180) [MonoidalCategory] title = Monoidal Categories author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu> topic = Mathematics/Category theory date = 2017-05-04 notify = stark@cs.stonybrook.edu abstract = Building on the formalization of basic category theory set out in the author's previous AFP article, the present article formalizes some basic aspects of the theory of monoidal categories. Among the notions defined here are monoidal category, monoidal functor, and equivalence of monoidal categories. The main theorems formalized are MacLane's coherence theorem and the constructions of the free monoidal category and free strict monoidal category generated by a given category. The coherence theorem is proved syntactically, using a structurally recursive approach to reduction of terms that might have some novel aspects. We also give proofs of some results given by Etingof et al, which may prove useful in a formal setting. In particular, we show that the left and right unitors need not be taken as given data in the definition of monoidal category, nor does the definition of monoidal functor need to take as given a specific isomorphism expressing the preservation of the unit object. Our definitions of monoidal category and monoidal functor are stated so as to take advantage of the economy afforded by these facts. Revisions made subsequent to the first version of this article added material on cartesian monoidal categories; showing that the underlying category of a cartesian monoidal category is a cartesian category, and that every cartesian category extends to a cartesian monoidal category. extra-history = Change history: [2017-05-18]: Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter. (revision 015543cdd069) [2018-05-29]: Modifications required due to 'Category3' changes. Introduced notation for "in hom". (revision 8318366d4575) [2020-02-15]: Cosmetic improvements. (revision a51840d36867) [2020-07-10]: Added new material on cartesian monoidal categories. (revision 06640f317a79) [Card_Multisets] title = Cardinality of Multisets author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> notify = lukas.bulwahn@gmail.com date = 2016-06-26 topic = Mathematics/Combinatorics abstract = This entry provides three lemmas to count the number of multisets of a given size and finite carrier set. The first lemma provides a cardinality formula assuming that the multiset's elements are chosen from the given carrier set. The latter two lemmas provide formulas assuming that the multiset's elements also cover the given carrier set, i.e., each element of the carrier set occurs in the multiset at least once. The proof of the first lemma uses the argument of the recurrence relation for counting multisets. The proof of the second lemma is straightforward, and the proof of the third lemma is easily obtained using the first cardinality lemma. A challenge for the formalization is the derivation of the required induction rule, which is a special combination of the induction rules for finite sets and natural numbers. The induction rule is derived by defining a suitable inductive predicate and transforming the predicate's induction rule. [Posix-Lexing] title = POSIX Lexing with Derivatives of Regular Expressions author = Fahad Ausaf <http://kcl.academia.edu/FahadAusaf>, Roy Dyckhoff <https://rd.host.cs.st-andrews.ac.uk>, Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/> notify = christian.urban@kcl.ac.uk date = 2016-05-24 topic = Computer science/Automata and formal languages abstract = Brzozowski introduced the notion of derivatives for regular expressions. They can be used for a very simple regular expression matching algorithm. Sulzmann and Lu cleverly extended this algorithm in order to deal with POSIX matching, which is the underlying disambiguation strategy for regular expressions needed in lexers. In this entry we give our inductive definition of what a POSIX value is and show (i) that such a value is unique (for given regular expression and string being matched) and (ii) that Sulzmann and Lu's algorithm always generates such a value (provided that the regular expression matches the string). We also prove the correctness of an optimised version of the POSIX matching algorithm. [LocalLexing] title = Local Lexing author = Steven Obua <mailto:steven@recursivemind.com> topic = Computer science/Automata and formal languages date = 2017-04-28 notify = steven@recursivemind.com abstract = This formalisation accompanies the paper <a href="https://arxiv.org/abs/1702.03277">Local Lexing</a> which introduces a novel parsing concept of the same name. The paper also gives a high-level algorithm for local lexing as an extension of Earley's algorithm. This formalisation proves the algorithm to be correct with respect to its local lexing semantics. As a special case, this formalisation thus also contains a proof of the correctness of Earley's algorithm. The paper contains a short outline of how this formalisation is organised. [MFMC_Countable] title = A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks author = Andreas Lochbihler <http://www.andreas-lochbihler.de> date = 2016-05-09 topic = Mathematics/Graph theory abstract = This article formalises a proof of the maximum-flow minimal-cut theorem for networks with countably many edges. A network is a directed graph with non-negative real-valued edge labels and two dedicated vertices, the source and the sink. A flow in a network assigns non-negative real numbers to the edges such that for all vertices except for the source and the sink, the sum of values on incoming edges equals the sum of values on outgoing edges. A cut is a subset of the vertices which contains the source, but not the sink. Our theorem states that in every network, there is a flow and a cut such that the flow saturates all the edges going out of the cut and is zero on all the incoming edges. The proof is based on the paper <emph>The Max-Flow Min-Cut theorem for countable networks</emph> by Aharoni et al. Additionally, we prove a characterisation of the lifting operation for relations on discrete probability distributions, which leads to a concise proof of its distributivity over relation composition. notify = mail@andreas-lochbihler.de extra-history = Change history: [2017-09-06]: derive characterisation for the lifting operation on discrete distributions from finite version of the max-flow min-cut theorem (revision a7a198f5bab0) [2020-12-19]: simpler proof of linkability for bounded unhindered bipartite webs, leading to a simpler proof for networks with bounded out-capacities (revision 93ca33f4d915) [2021-08-13]: generalize the derivation of the characterisation for the relator of discrete probability distributions to work for the bounded and unbounded MFMC theorem (revision 3c85bb52bbe6) [Liouville_Numbers] title = Liouville numbers author = Manuel Eberl <https://pruvisto.org> date = 2015-12-28 topic = Mathematics/Analysis, Mathematics/Number theory abstract = Liouville numbers are a class of transcendental numbers that can be approximated particularly well with rational numbers. Historically, they were the first numbers whose transcendence was proven. In this entry, we define the concept of Liouville numbers as well as the standard construction to obtain Liouville numbers (including Liouville's constant) and we prove their most important properties: irrationality and transcendence. The proof is very elementary and requires only standard arithmetic, the Mean Value Theorem for polynomials, and the boundedness of polynomials on compact intervals. notify = manuel@pruvisto.org [Triangle] title = Basic Geometric Properties of Triangles author = Manuel Eberl <https://pruvisto.org> date = 2015-12-28 topic = Mathematics/Geometry abstract = This entry contains a definition of angles between vectors and between three points. Building on this, we prove basic geometric properties of triangles, such as the Isosceles Triangle Theorem, the Law of Sines and the Law of Cosines, that the sum of the angles of a triangle is π, and the congruence theorems for triangles. The definitions and proofs were developed following those by John Harrison in HOL Light. However, due to Isabelle's type class system, all definitions and theorems in the Isabelle formalisation hold for all real inner product spaces. notify = manuel@pruvisto.org [Prime_Harmonic_Series] title = The Divergence of the Prime Harmonic Series author = Manuel Eberl <https://pruvisto.org> date = 2015-12-28 topic = Mathematics/Number theory abstract = In this work, we prove the lower bound ln(H_n) - ln(5/3) for the partial sum of the Prime Harmonic series and, based on this, the divergence of the Prime Harmonic Series ∑[p prime] · 1/p. The proof relies on the unique squarefree decomposition of natural numbers. This is similar to Euler's original proof (which was highly informal and morally questionable). Its advantage over proofs by contradiction, like the famous one by Paul Erdős, is that it provides a relatively good lower bound for the partial sums. notify = manuel@pruvisto.org [Descartes_Sign_Rule] title = Descartes' Rule of Signs author = Manuel Eberl <https://pruvisto.org> date = 2015-12-28 topic = Mathematics/Analysis abstract = Descartes' Rule of Signs relates the number of positive real roots of a polynomial with the number of sign changes in its coefficient sequence. Our proof follows the simple inductive proof given by Rob Arthan, which was also used by John Harrison in his HOL Light formalisation. We proved most of the lemmas for arbitrary linearly-ordered integrity domains (e.g. integers, rationals, reals); the main result, however, requires the intermediate value theorem and was therefore only proven for real polynomials. notify = manuel@pruvisto.org [Euler_MacLaurin] title = The Euler–MacLaurin Formula author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis date = 2017-03-10 notify = manuel@pruvisto.org abstract = The Euler-MacLaurin formula relates the value of a discrete sum to that of the corresponding integral in terms of the derivatives at the borders of the summation and a remainder term. Since the remainder term is often very small as the summation bounds grow, this can be used to compute asymptotic expansions for sums. This entry contains a proof of this formula for functions from the reals to an arbitrary Banach space. Two variants of the formula are given: the standard textbook version and a variant outlined in Concrete Mathematics that is more useful for deriving asymptotic estimates. As example applications, we use that formula to derive the full asymptotic expansion of the harmonic numbers and the sum of inverse squares. [Card_Partitions] title = Cardinality of Set Partitions author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> date = 2015-12-12 topic = Mathematics/Combinatorics abstract = The theory's main theorem states that the cardinality of set partitions of size k on a carrier set of size n is expressed by Stirling numbers of the second kind. In Isabelle, Stirling numbers of the second kind are defined in the AFP entry `Discrete Summation` through their well-known recurrence relation. The main theorem relates them to the alternative definition as cardinality of set partitions. The proof follows the simple and short explanation in Richard P. Stanley's `Enumerative Combinatorics: Volume 1` and Wikipedia, and unravels the full details and implicit reasoning steps of these explanations. notify = lukas.bulwahn@gmail.com [Card_Number_Partitions] title = Cardinality of Number Partitions author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> date = 2016-01-14 topic = Mathematics/Combinatorics abstract = This entry provides a basic library for number partitions, defines the two-argument partition function through its recurrence relation and relates this partition function to the cardinality of number partitions. The main proof shows that the recursively-defined partition function with arguments n and k equals the cardinality of number partitions of n with exactly k parts. The combinatorial proof follows the proof sketch of Theorem 2.4.1 in Mazur's textbook `Combinatorics: A Guided Tour`. This entry can serve as starting point for various more intrinsic properties about number partitions, the partition function and related recurrence relations. notify = lukas.bulwahn@gmail.com [Multirelations] title = Binary Multirelations author = Hitoshi Furusawa <http://www.sci.kagoshima-u.ac.jp/~furusawa/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg> date = 2015-06-11 topic = Mathematics/Algebra abstract = Binary multirelations associate elements of a set with its subsets; hence they are binary relations from a set to its power set. Applications include alternating automata, models and logics for games, program semantics with dual demonic and angelic nondeterministic choices and concurrent dynamic logics. This proof document supports an arXiv article that formalises the basic algebra of multirelations and proposes axiom systems for them, ranging from weak bi-monoids to weak bi-quantales. notify = [Noninterference_Generic_Unwinding] title = The Generic Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2015-06-11 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract = The classical definition of noninterference security for a deterministic state machine with outputs requires to consider the outputs produced by machine actions after any trace, i.e. any indefinitely long sequence of actions, of the machine. In order to render the verification of the security of such a machine more straightforward, there is a need of some sufficient condition for security such that just individual actions, rather than unbounded sequences of actions, have to be considered. By extending previous results applying to transitive noninterference policies, Rushby has proven an unwinding theorem that provides a sufficient condition of this kind in the general case of a possibly intransitive policy. This condition has to be satisfied by a generic function mapping security domains into equivalence relations over machine states. An analogous problem arises for CSP noninterference security, whose definition requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace. This paper provides a sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's one for classical noninterference security, and has to be satisfied by a generic function mapping security domains into equivalence relations over process traces; hence its name, Generic Unwinding Theorem. Variants of this theorem applying to deterministic processes and trace set processes are also proven. Finally, the sufficient condition for security expressed by the theorem is shown not to be a necessary condition as well, viz. there exists a secure process such that no domain-relation map satisfying the condition exists. notify = [Noninterference_Ipurge_Unwinding] title = The Ipurge Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2015-06-11 topic = Computer science/Security abstract = The definition of noninterference security for Communicating Sequential Processes requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace. In order to render the verification of the security of a process more straightforward, there is a need of some sufficient condition for security such that just individual accepted and refused events, rather than unbounded sequences and sets of events, have to be considered. Of course, if such a sufficient condition were necessary as well, it would be even more valuable, since it would permit to prove not only that a process is secure by verifying that the condition holds, but also that a process is not secure by verifying that the condition fails to hold. This paper provides a necessary and sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's output consistency for deterministic state machines with outputs, and has to be satisfied by a specific function mapping security domains into equivalence relations over process traces. The definition of this function makes use of an intransitive purge function following Rushby's one; hence the name given to the condition, Ipurge Unwinding Theorem. Furthermore, in accordance with Hoare's formal definition of deterministic processes, it is shown that a process is deterministic just in case it is a trace set process, i.e. it may be identified by means of a trace set alone, matching the set of its traces, in place of a failures-divergences pair. Then, variants of the Ipurge Unwinding Theorem are proven for deterministic processes and trace set processes. notify = [Relational_Method] title = The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> topic = Computer science/Security date = 2020-12-05 notify = pasquale.noce.lavoro@gmail.com abstract = This paper introduces a new method for the formal verification of cryptographic protocols, the relational method, derived from Paulson's inductive method by means of some enhancements aimed at streamlining formal definitions and proofs, specially for protocols using public key cryptography. Moreover, this paper proposes a method to formalize a further security property, message anonymity, in addition to message confidentiality and authenticity. The relational method, including message anonymity, is then applied to the verification of a sample authentication protocol, comprising Password Authenticated Connection Establishment (PACE) with Chip Authentication Mapping followed by the explicit verification of an additional password over the PACE secure channel. [List_Interleaving] title = Reasoning about Lists via List Interleaving author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2015-06-11 topic = Computer science/Data structures abstract = Among the various mathematical tools introduced in his outstanding work on Communicating Sequential Processes, Hoare has defined "interleaves" as the predicate satisfied by any three lists such that the first list may be split into sublists alternately extracted from the other two ones, whatever is the criterion for extracting an item from either one list or the other in each step. This paper enriches Hoare's definition by identifying such criterion with the truth value of a predicate taking as inputs the head and the tail of the first list. This enhanced "interleaves" predicate turns out to permit the proof of equalities between lists without the need of an induction. Some rules that allow to infer "interleaves" statements without induction, particularly applying to the addition or removal of a prefix to the input lists, are also proven. Finally, a stronger version of the predicate, named "Interleaves", is shown to fulfil further rules applying to the addition or removal of a suffix to the input lists. notify = [Residuated_Lattices] title = Residuated Lattices author = Victor B. F. Gomes <mailto:vborgesferreiragomes1@sheffield.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk> date = 2015-04-15 topic = Mathematics/Algebra abstract = The theory of residuated lattices, first proposed by Ward and Dilworth, is formalised in Isabelle/HOL. This includes concepts of residuated functions; their adjoints and conjugates. It also contains necessary and sufficient conditions for the existence of these operations in an arbitrary lattice. The mathematical components for residuated lattices are linked to the AFP entry for relation algebra. In particular, we prove Jonsson and Tsinakis conditions for a residuated boolean algebra to form a relation algebra. notify = g.struth@sheffield.ac.uk [ConcurrentGC] title = Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO author = Peter Gammie <http://peteg.org>, Tony Hosking <https://www.cs.purdue.edu/homes/hosking/>, Kai Engelhardt <> date = 2015-04-13 topic = Computer science/Algorithms/Concurrent abstract = We use ConcurrentIMP to model Schism, a state-of-the-art real-time garbage collection scheme for weak memory, and show that it is safe on x86-TSO. This development accompanies the PLDI 2015 paper of the same name. notify = peteg42@gmail.com [List_Update] title = Analysis of List Update Algorithms author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2016-02-17 topic = Computer science/Algorithms/Online abstract = These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front, the lower bound of 2 for the competitiveness of deterministic list update algorithms and 1.6-competitiveness of the randomized COMB algorithm, the best randomized list update algorithm known to date. The material is based on the first two chapters of Online Computation and Competitive Analysis by Borodin and El-Yaniv. For an informal description see the FSTTCS 2016 publication <a href="http://www21.in.tum.de/~nipkow/pubs/fsttcs16.html">Verified Analysis of List Update Algorithms</a> by Haslbeck and Nipkow. notify = nipkow@in.tum.de [ConcurrentIMP] title = Concurrent IMP author = Peter Gammie <http://peteg.org> date = 2015-04-13 topic = Computer science/Programming languages/Logics abstract = ConcurrentIMP extends the small imperative language IMP with control non-determinism and constructs for synchronous message passing. notify = peteg42@gmail.com [TortoiseHare] title = The Tortoise and Hare Algorithm author = Peter Gammie <http://peteg.org> date = 2015-11-18 topic = Computer science/Algorithms abstract = We formalize the Tortoise and Hare cycle-finding algorithm ascribed to Floyd by Knuth, and an improved version due to Brent. notify = peteg42@gmail.com [UPF] title = The Unified Policy Framework (UPF) author = Achim D. Brucker <mailto:adbrucker@0x5f.org>, Lukas Brügger <mailto:lukas.a.bruegger@gmail.com>, Burkhart Wolff <mailto:wolff@lri.fr> date = 2014-11-28 topic = Computer science/Security abstract = We present the Unified Policy Framework (UPF), a generic framework for modelling security (access-control) policies. UPF emphasizes the view that a policy is a policy decision function that grants or denies access to resources, permissions, etc. In other words, instead of modelling the relations of permitted or prohibited requests directly, we model the concrete function that implements the policy decision point in a system. In more detail, UPF is based on the following four principles: 1) Functional representation of policies, 2) No conflicts are possible, 3) Three-valued decision type (allow, deny, undefined), 4) Output type not containing the decision only. notify = adbrucker@0x5f.org, wolff@lri.fr, lukas.a.bruegger@gmail.com [UPF_Firewall] title = Formal Network Models and Their Application to Firewall Policies author = Achim D. Brucker <https://www.brucker.ch>, Lukas Brügger<>, Burkhart Wolff <https://www.lri.fr/~wolff/> topic = Computer science/Security, Computer science/Networks date = 2017-01-08 notify = adbrucker@0x5f.org abstract = We present a formal model of network protocols and their application to modeling firewall policies. The formalization is based on the Unified Policy Framework (UPF). The formalization was originally developed with for generating test cases for testing the security configuration actual firewall and router (middle-boxes) using HOL-TestGen. Our work focuses on modeling application level protocols on top of tcp/ip. [AODV] title = Loop freedom of the (untimed) AODV routing protocol author = Timothy Bourke <http://www.tbrk.org>, Peter Höfner <http://www.hoefner-online.de/> date = 2014-10-23 topic = Computer science/Concurrency/Process calculi abstract = The Ad hoc On-demand Distance Vector (AODV) routing protocol allows the nodes in a Mobile Ad hoc Network (MANET) or a Wireless Mesh Network (WMN) to know where to forward data packets. Such a protocol is ‘loop free’ if it never leads to routing decisions that forward packets in circles. This development mechanises an existing pen-and-paper proof of loop freedom of AODV. The protocol is modelled in the Algebra of Wireless Networks (AWN), which is the subject of an earlier paper and AFP mechanization. The proof relies on a novel compositional approach for lifting invariants to networks of nodes. We exploit the mechanization to analyse several variants of AODV and show that Isabelle/HOL can re-establish most proof obligations automatically and identify exactly the steps that are no longer valid. notify = tim@tbrk.org [Show] title = Haskell's Show Class in Isabelle/HOL author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2014-07-29 topic = Computer science/Functional programming license = LGPL abstract = We implemented a type class for "to-string" functions, similar to Haskell's Show class. Moreover, we provide instantiations for Isabelle/HOL's standard types like bool, prod, sum, nats, ints, and rats. It is further possible, to automatically derive show functions for arbitrary user defined datatypes similar to Haskell's "deriving Show". extra-history = Change history: [2015-03-11]: Adapted development to new-style (BNF-based) datatypes. [2015-04-10]: Moved development for old-style datatypes into subdirectory "Old_Datatype". notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [Certification_Monads] title = Certification Monads author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2014-10-03 topic = Computer science/Functional programming abstract = This entry provides several monads intended for the development of stand-alone certifiers via code generation from Isabelle/HOL. More specifically, there are three flavors of error monads (the sum type, for the case where all monadic functions are total; an instance of the former, the so called check monad, yielding either success without any further information or an error message; as well as a variant of the sum type that accommodates partial functions by providing an explicit bottom element) and a parser monad built on top. All of this monads are heavily used in the IsaFoR/CeTA project which thus provides many examples of their usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [CISC-Kernel] title = Formal Specification of a Generic Separation Kernel author = Freek Verbeek <mailto:Freek.Verbeek@ou.nl>, Sergey Tverdyshev <mailto:stv@sysgo.com>, Oto Havle <mailto:oha@sysgo.com>, Holger Blasum <mailto:holger.blasum@sysgo.com>, Bruno Langenstein <mailto:langenstein@dfki.de>, Werner Stephan <mailto:stephan@dfki.de>, Yakoub Nemouchi <mailto:nemouchi@lri.fr>, Abderrahmane Feliachi <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Julien Schmaltz <mailto:Julien.Schmaltz@ou.nl> date = 2014-07-18 topic = Computer science/Security abstract = Intransitive noninterference has been a widely studied topic in the last few decades. Several well-established methodologies apply interactive theorem proving to formulate a noninterference theorem over abstract academic models. In joint work with several industrial and academic partners throughout Europe, we are helping in the certification process of PikeOS, an industrial separation kernel developed at SYSGO. In this process, established theories could not be applied. We present a new generic model of separation kernels and a new theory of intransitive noninterference. The model is rich in detail, making it suitable for formal verification of realistic and industrial systems such as PikeOS. Using a refinement-based theorem proving approach, we ensure that proofs remain manageable. This document corresponds to the deliverable D31.1 of the EURO-MILS Project <a href="http://www.euromils.eu">http://www.euromils.eu</a>. notify = [pGCL] title = pGCL for Isabelle author = David Cock <mailto:david.cock@nicta.com.au> date = 2014-07-13 topic = Computer science/Programming languages/Language definitions abstract = pGCL is both a programming language and a specification language that incorporates both probabilistic and nondeterministic choice, in a unified manner. Program verification is by refinement or annotation (or both), using either Hoare triples, or weakest-precondition entailment, in the style of GCL. This package provides both a shallow embedding of the language primitives, and an annotation and refinement framework. The generated document includes a brief tutorial. notify = [Noninterference_CSP] title = Noninterference Security in Communicating Sequential Processes author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2014-05-23 topic = Computer science/Security abstract = An extension of classical noninterference security for deterministic state machines, as introduced by Goguen and Meseguer and elegantly formalized by Rushby, to nondeterministic systems should satisfy two fundamental requirements: it should be based on a mathematically precise theory of nondeterminism, and should be equivalent to (or at least not weaker than) the classical notion in the degenerate deterministic case. This paper proposes a definition of noninterference security applying to Hoare's Communicating Sequential Processes (CSP) in the general case of a possibly intransitive noninterference policy, and proves the equivalence of this security property to classical noninterference security for processes representing deterministic state machines. Furthermore, McCullough's generalized noninterference security is shown to be weaker than both the proposed notion of CSP noninterference security for a generic process, and classical noninterference security for processes representing deterministic state machines. This renders CSP noninterference security preferable as an extension of classical noninterference security to nondeterministic systems. notify = pasquale.noce.lavoro@gmail.com [Floyd_Warshall] title = The Floyd-Warshall Algorithm for Shortest Paths author = Simon Wimmer <http://in.tum.de/~wimmers>, Peter Lammich <http://www21.in.tum.de/~lammich> topic = Computer science/Algorithms/Graph date = 2017-05-08 notify = wimmers@in.tum.de abstract = The Floyd-Warshall algorithm [Flo62, Roy59, War62] is a classic dynamic programming algorithm to compute the length of all shortest paths between any two vertices in a graph (i.e. to solve the all-pairs shortest path problem, or APSP for short). Given a representation of the graph as a matrix of weights M, it computes another matrix M' which represents a graph with the same path lengths and contains the length of the shortest path between any two vertices i and j. This is only possible if the graph does not contain any negative cycles. However, in this case the Floyd-Warshall algorithm will detect the situation by calculating a negative diagonal entry. This entry includes a formalization of the algorithm and of these key properties. The algorithm is refined to an efficient imperative version using the Imperative Refinement Framework. [Roy_Floyd_Warshall] title = Transitive closure according to Roy-Floyd-Warshall author = Makarius Wenzel <> date = 2014-05-23 topic = Computer science/Algorithms/Graph abstract = This formulation of the Roy-Floyd-Warshall algorithm for the transitive closure bypasses matrices and arrays, but uses a more direct mathematical model with adjacency functions for immediate predecessors and successors. This can be implemented efficiently in functional programming languages and is particularly adequate for sparse relations. notify = [GPU_Kernel_PL] title = Syntax and semantics of a GPU kernel programming language author = John Wickerson <http://www.doc.ic.ac.uk/~jpw48> date = 2014-04-03 topic = Computer science/Programming languages/Language definitions abstract = This document accompanies the article "The Design and Implementation of a Verification Technique for GPU Kernels" by Adam Betts, Nathan Chong, Alastair F. Donaldson, Jeroen Ketema, Shaz Qadeer, Paul Thomson and John Wickerson. It formalises all of the definitions provided in Sections 3 and 4 of the article. notify = [AWN] title = Mechanization of the Algebra for Wireless Networks (AWN) author = Timothy Bourke <http://www.tbrk.org> date = 2014-03-08 topic = Computer science/Concurrency/Process calculi abstract = AWN is a process algebra developed for modelling and analysing protocols for Mobile Ad hoc Networks (MANETs) and Wireless Mesh Networks (WMNs). AWN models comprise five distinct layers: sequential processes, local parallel compositions, nodes, partial networks, and complete networks. This development mechanises the original operational semantics of AWN and introduces a variant 'open' operational semantics that enables the compositional statement and proof of invariants across distinct network nodes. It supports labels (for weakening invariants) and (abstract) data state manipulations. A framework for compositional invariant proofs is developed, including a tactic (inv_cterms) for inductive invariant proofs of sequential processes, lifting rules for the open versions of the higher layers, and a rule for transferring lifted properties back to the standard semantics. A notion of 'control terms' reduces proof obligations to the subset of subterms that act directly (in contrast to operators for combining terms and joining processes). notify = tim@tbrk.org [Selection_Heap_Sort] title = Verification of Selection and Heap Sort Using Locales author = Danijela Petrovic <http://www.matf.bg.ac.rs/~danijela> date = 2014-02-11 topic = Computer science/Algorithms abstract = Stepwise program refinement techniques can be used to simplify program verification. Programs are better understood since their main properties are clearly stated, and verification of rather complex algorithms is reduced to proving simple statements connecting successive program specifications. Additionally, it is easy to analyze similar algorithms and to compare their properties within a single formalization. Usually, formal analysis is not done in educational setting due to complexity of verification and a lack of tools and procedures to make comparison easy. Verification of an algorithm should not only give correctness proof, but also better understanding of an algorithm. If the verification is based on small step program refinement, it can become simple enough to be demonstrated within the university-level computer science curriculum. In this paper we demonstrate this and give a formal analysis of two well known algorithms (Selection Sort and Heap Sort) using proof assistant Isabelle/HOL and program refinement techniques. notify = [Real_Impl] title = Implementing field extensions of the form Q[sqrt(b)] author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2014-02-06 license = LGPL topic = Mathematics/Analysis abstract = We apply data refinement to implement the real numbers, where we support all numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p + q * sqrt(b) for rational numbers p and q and some fixed natural number b. To this end, we also developed algorithms to precisely compute roots of a rational number, and to perform a factorization of natural numbers which eliminates duplicate prime factors. Our results have been used to certify termination proofs which involve polynomial interpretations over the reals. extra-history = Change history: [2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian. notify = rene.thiemann@uibk.ac.at [ShortestPath] title = An Axiomatic Characterization of the Single-Source Shortest Path Problem author = Christine Rizkallah <https://www.mpi-inf.mpg.de/~crizkall/> date = 2013-05-22 topic = Mathematics/Graph theory abstract = This theory is split into two sections. In the first section, we give a formal proof that a well-known axiomatic characterization of the single-source shortest path problem is correct. Namely, we prove that in a directed graph with a non-negative cost function on the edges the single-source shortest path function is the only function that satisfies a set of four axioms. In the second section, we give a formal proof of the correctness of an axiomatic characterization of the single-source shortest path problem for directed graphs with general cost functions. The axioms here are more involved because we have to account for potential negative cycles in the graph. The axioms are summarized in three Isabelle locales. notify = [Launchbury] title = The Correctness of Launchbury's Natural Semantics for Lazy Evaluation author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner> date = 2013-01-31 topic = Computer science/Programming languages/Lambda calculi, Computer science/Semantics abstract = In his seminal paper "Natural Semantics for Lazy Evaluation", John Launchbury proves his semantics correct with respect to a denotational semantics, and outlines an adequacy proof. We have formalized both semantics and machine-checked the correctness proof, clarifying some details. Furthermore, we provide a new and more direct adequacy proof that does not require intermediate operational semantics. extra-history = Change history: [2014-05-24]: Added the proof of adequacy, as well as simplified and improved the existing proofs. Adjusted abstract accordingly. [2015-03-16]: Booleans and if-then-else added to syntax and semantics, making this entry suitable to be used by the entry "Call_Arity". notify = [Call_Arity] title = The Safety of Call Arity author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner> date = 2015-02-20 topic = Computer science/Programming languages/Transformations abstract = We formalize the Call Arity analysis, as implemented in GHC, and prove both functional correctness and, more interestingly, safety (i.e. the transformation does not increase allocation). We use syntax and the denotational semantics from the entry "Launchbury", where we formalized Launchbury's natural semantics for lazy evaluation. The functional correctness of Call Arity is proved with regard to that denotational semantics. The operational properties are shown with regard to a small-step semantics akin to Sestoft's mark 1 machine, which we prove to be equivalent to Launchbury's semantics. We use Christian Urban's Nominal2 package to define our terms and make use of Brian Huffman's HOLCF package for the domain-theoretical aspects of the development. extra-history = Change history: [2015-03-16]: This entry now builds on top of the Launchbury entry, and the equivalency proof of the natural and the small-step semantics was added. notify = [CCS] title = CCS in nominal logic author = Jesper Bengtson <http://www.itu.dk/people/jebe> date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = We formalise a large portion of CCS as described in Milner's book 'Communication and Concurrency' using the nominal datatype package in Isabelle. Our results include many of the standard theorems of bisimulation equivalence and congruence, for both weak and strong versions. One main goal of this formalisation is to keep the machine-checked proofs as close to their pen-and-paper counterpart as possible. This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>. notify = [Pi_Calculus] title = The pi-calculus in nominal logic author = Jesper Bengtson <http://www.itu.dk/people/jebe> date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = We formalise the pi-calculus using the nominal datatype package, based on ideas from the nominal logic by Pitts et al., and demonstrate an implementation in Isabelle/HOL. The purpose is to derive powerful induction rules for the semantics in order to conduct machine checkable proofs, closely following the intuitive arguments found in manual proofs. In this way we have covered many of the standard theorems of bisimulation equivalence and congruence, both late and early, and both strong and weak in a uniform manner. We thus provide one of the most extensive formalisations of a the pi-calculus ever done inside a theorem prover. A significant gain in our formulation is that agents are identified up to alpha-equivalence, thereby greatly reducing the arguments about bound names. This is a normal strategy for manual proofs about the pi-calculus, but that kind of hand waving has previously been difficult to incorporate smoothly in an interactive theorem prover. We show how the nominal logic formalism and its support in Isabelle accomplishes this and thus significantly reduces the tedium of conducting completely formal proofs. This improves on previous work using weak higher order abstract syntax since we do not need extra assumptions to filter out exotic terms and can keep all arguments within a familiar first-order logic. This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>. notify = [Psi_Calculi] title = Psi-calculi in Isabelle author = Jesper Bengtson <http://www.itu.dk/people/jebe> date = 2012-05-29 topic = Computer science/Concurrency/Process calculi abstract = Psi-calculi are extensions of the pi-calculus, accommodating arbitrary nominal datatypes to represent not only data but also communication channels, assertions and conditions, giving it an expressive power beyond the applied pi-calculus and the concurrent constraint pi-calculus. We have formalised psi-calculi in the interactive theorem prover Isabelle using its nominal datatype package. One distinctive feature is that the framework needs to treat binding sequences, as opposed to single binders, in an efficient way. While different methods for formalising single binder calculi have been proposed over the last decades, representations for such binding sequences are not very well explored. The main effort in the formalisation is to keep the machine checked proofs as close to their pen-and-paper counterparts as possible. This includes treating all binding sequences as atomic elements, and creating custom induction and inversion rules that to remove the bulk of manual alpha-conversions. This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>. notify = [Encodability_Process_Calculi] title = Analysing and Comparing Encodability Criteria for Process Calculi author = Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Rob van Glabbeek <http://theory.stanford.edu/~rvg/> date = 2015-08-10 topic = Computer science/Concurrency/Process calculi abstract = Encodings or the proof of their absence are the main way to compare process calculi. To analyse the quality of encodings and to rule out trivial or meaningless encodings, they are augmented with quality criteria. There exists a bunch of different criteria and different variants of criteria in order to reason in different settings. This leads to incomparable results. Moreover it is not always clear whether the criteria used to obtain a result in a particular setting do indeed fit to this setting. We show how to formally reason about and compare encodability criteria by mapping them on requirements on a relation between source and target terms that is induced by the encoding function. In particular we analyse the common criteria full abstraction, operational correspondence, divergence reflection, success sensitiveness, and respect of barbs; e.g. we analyse the exact nature of the simulation relation (coupled simulation versus bisimulation) that is induced by different variants of operational correspondence. This way we reduce the problem of analysing or comparing encodability criteria to the better understood problem of comparing relations on processes. notify = kirstin.peters@tu-berlin.de [Circus] title = Isabelle/Circus author = Abderrahmane Feliachi <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Marie-Claude Gaudel <mailto:mcg@lri.fr> contributors = Makarius Wenzel <mailto:Makarius.wenzel@lri.fr> date = 2012-05-27 topic = Computer science/Concurrency/Process calculi, Computer science/System description languages abstract = The Circus specification language combines elements for complex data and behavior specifications, using an integration of Z and CSP with a refinement calculus. Its semantics is based on Hoare and He's Unifying Theories of Programming (UTP). Isabelle/Circus is a formalization of the UTP and the Circus language in Isabelle/HOL. It contains proof rules and tactic support that allows for proofs of refinement for Circus processes (involving both data and behavioral aspects). The Isabelle/Circus environment supports a syntax for the semantic definitions which is close to textbook presentations of Circus. This article contains an extended version of corresponding VSTTE Paper together with the complete formal development of its underlying commented theories. extra-history = Change history: [2014-06-05]: More polishing, shorter proofs, added Circus syntax, added Makarius Wenzel as contributor. notify = [Dijkstra_Shortest_Path] title = Dijkstra's Shortest Path Algorithm author = Benedikt Nordhoff <mailto:b.n@wwu.de>, Peter Lammich <http://www21.in.tum.de/~lammich> topic = Computer science/Algorithms/Graph date = 2012-01-30 abstract = We implement and prove correct Dijkstra's algorithm for the single source shortest path problem, conceived in 1956 by E. Dijkstra. The algorithm is implemented using the data refinement framework for monadic, nondeterministic programs. An efficient implementation is derived using data structures from the Isabelle Collection Framework. notify = lammich@in.tum.de [Refine_Monadic] title = Refinement for Monadic Programs author = Peter Lammich <http://www21.in.tum.de/~lammich> topic = Computer science/Programming languages/Logics date = 2012-01-30 abstract = We provide a framework for program and data refinement in Isabelle/HOL. The framework is based on a nondeterminism-monad with assertions, i.e., the monad carries a set of results or an assertion failure. Recursion is expressed by fixed points. For convenience, we also provide while and foreach combinators. The framework provides tools to automatize canonical tasks, such as verification condition generation, finding appropriate data refinement relations, and refine an executable program to a form that is accepted by the Isabelle/HOL code generator. This submission comes with a collection of examples and a user-guide, illustrating the usage of the framework. extra-history = Change history: [2012-04-23] Introduced ordered FOREACH loops [2012-06] New features: REC_rule_arb and RECT_rule_arb allow for generalizing over variables. prepare_code_thms - command extracts code equations for recursion combinators. [2012-07] New example: Nested DFS for emptiness check of Buchi-automata with witness. New feature: fo_rule method to apply resolution using first-order matching. Useful for arg_conf, fun_cong. [2012-08] Adaptation to ICF v2. [2012-10-05] Adaptations to include support for Automatic Refinement Framework. [2013-09] This entry now depends on Automatic Refinement [2014-06] New feature: vc_solve method to solve verification conditions. Maintenace changes: VCG-rules for nfoldli, improved setup for FOREACH-loops. [2014-07] Now defining recursion via flat domain. Dropped many single-valued prerequisites. Changed notion of data refinement. In single-valued case, this matches the old notion. In non-single valued case, the new notion allows for more convenient rules. In particular, the new definitions allow for projecting away ghost variables as a refinement step. [2014-11] New features: le-or-fail relation (leof), modular reasoning about loop invariants. notify = lammich@in.tum.de [Refine_Imperative_HOL] title = The Imperative Refinement Framework author = Peter Lammich <http://www21.in.tum.de/~lammich> notify = lammich@in.tum.de date = 2016-08-08 topic = Computer science/Programming languages/Transformations,Computer science/Data structures abstract = We present the Imperative Refinement Framework (IRF), a tool that supports a stepwise refinement based approach to imperative programs. This entry is based on the material we presented in [ITP-2015, CPP-2016]. It uses the Monadic Refinement Framework as a frontend for the specification of the abstract programs, and Imperative/HOL as a backend to generate executable imperative programs. The IRF comes with tool support to synthesize imperative programs from more abstract, functional ones, using efficient imperative implementations for the abstract data structures. This entry also includes the Imperative Isabelle Collection Framework (IICF), which provides a library of re-usable imperative collection data structures. Moreover, this entry contains a quickstart guide and a reference manual, which provide an introduction to using the IRF for Isabelle/HOL experts. It also provids a collection of (partly commented) practical examples, some highlights being Dijkstra's Algorithm, Nested-DFS, and a generic worklist algorithm with subsumption. Finally, this entry contains benchmark scripts that compare the runtime of some examples against reference implementations of the algorithms in Java and C++. [ITP-2015] Peter Lammich: Refinement to Imperative/HOL. ITP 2015: 253--269 [CPP-2016] Peter Lammich: Refinement based verification of imperative data structures. CPP 2016: 27--36 [Automatic_Refinement] title = Automatic Data Refinement author = Peter Lammich <mailto:lammich@in.tum.de> topic = Computer science/Programming languages/Logics date = 2013-10-02 abstract = We present the Autoref tool for Isabelle/HOL, which automatically refines algorithms specified over abstract concepts like maps and sets to algorithms over concrete implementations like red-black-trees, and produces a refinement theorem. It is based on ideas borrowed from relational parametricity due to Reynolds and Wadler. The tool allows for rapid prototyping of verified, executable algorithms. Moreover, it can be configured to fine-tune the result to the user~s needs. Our tool is able to automatically instantiate generic algorithms, which greatly simplifies the implementation of executable data structures. This AFP-entry provides the basic tool, which is then used by the Refinement and Collection Framework to provide automatic data refinement for the nondeterminism monad and various collection datastructures. notify = lammich@in.tum.de [EdmondsKarp_Maxflow] title = Formalizing the Edmonds-Karp Algorithm author = Peter Lammich <mailto:lammich@in.tum.de>, S. Reza Sefidgar<> notify = lammich@in.tum.de date = 2016-08-12 topic = Computer science/Algorithms/Graph abstract = We present a formalization of the Ford-Fulkerson method for computing the maximum flow in a network. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL--- the interactive theorem prover used for the formalization. We then use stepwise refinement to obtain the Edmonds-Karp algorithm, and formally prove a bound on its complexity. Further refinement yields a verified implementation, whose execution time compares well to an unverified reference implementation in Java. This entry is based on our ITP-2016 paper with the same title. [VerifyThis2018] title = VerifyThis 2018 - Polished Isabelle Solutions author = Peter Lammich <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers> topic = Computer science/Algorithms date = 2018-04-27 notify = lammich@in.tum.de abstract = <a href="http://www.pm.inf.ethz.ch/research/verifythis.html">VerifyThis 2018</a> was a program verification competition associated with ETAPS 2018. It was the 7th event in the VerifyThis competition series. In this entry, we present polished and completed versions of our solutions that we created during the competition. [PseudoHoops] title = Pseudo Hoops author = George Georgescu <>, Laurentiu Leustean <>, Viorel Preoteasa <http://users.abo.fi/vpreotea/> topic = Mathematics/Algebra date = 2011-09-22 abstract = Pseudo-hoops are algebraic structures introduced by B. Bosbach under the name of complementary semigroups. In this formalization we prove some properties of pseudo-hoops and we define the basic concepts of filter and normal filter. The lattice of normal filters is isomorphic with the lattice of congruences of a pseudo-hoop. We also study some important classes of pseudo-hoops. Bounded Wajsberg pseudo-hoops are equivalent to pseudo-Wajsberg algebras and bounded basic pseudo-hoops are equivalent to pseudo-BL algebras. Some examples of pseudo-hoops are given in the last section of the formalization. notify = viorel.preoteasa@aalto.fi [MonoBoolTranAlgebra] title = Algebra of Monotonic Boolean Transformers author = Viorel Preoteasa <http://users.abo.fi/vpreotea/> topic = Computer science/Programming languages/Logics date = 2011-09-22 abstract = Algebras of imperative programming languages have been successful in reasoning about programs. In general an algebra of programs is an algebraic structure with programs as elements and with program compositions (sequential composition, choice, skip) as algebra operations. Various versions of these algebras were introduced to model partial correctness, total correctness, refinement, demonic choice, and other aspects. We formalize here an algebra which can be used to model total correctness, refinement, demonic and angelic choice. The basic model of this algebra are monotonic Boolean transformers (monotonic functions from a Boolean algebra to itself). notify = viorel.preoteasa@aalto.fi [LatticeProperties] title = Lattice Properties author = Viorel Preoteasa <http://users.abo.fi/vpreotea/> topic = Mathematics/Order date = 2011-09-22 abstract = This formalization introduces and collects some algebraic structures based on lattices and complete lattices for use in other developments. The structures introduced are modular, and lattice ordered groups. In addition to the results proved for the new lattices, this formalization also introduces theorems about latices and complete lattices in general. extra-history = Change history: [2012-01-05]: Removed the theory about distributive complete lattices which is in the standard library now. Added a theory about well founded and transitive relations and a result about fixpoints in complete lattices and well founded relations. Moved the results about conjunctive and disjunctive functions to a new theory. Removed the syntactic classes for inf and sup which are in the standard library now. notify = viorel.preoteasa@aalto.fi [Impossible_Geometry] title = Proving the Impossibility of Trisecting an Angle and Doubling the Cube author = Ralph Romanos <mailto:ralph.romanos@student.ecp.fr>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Algebra, Mathematics/Geometry date = 2012-08-05 abstract = Squaring the circle, doubling the cube and trisecting an angle, using a compass and straightedge alone, are classic unsolved problems first posed by the ancient Greeks. All three problems were proved to be impossible in the 19th century. The following document presents the proof of the impossibility of solving the latter two problems using Isabelle/HOL, following a proof by Carrega. The proof uses elementary methods: no Galois theory or field extensions. The set of points constructible using a compass and straightedge is defined inductively. Radical expressions, which involve only square roots and arithmetic of rational numbers, are defined, and we find that all constructive points have radical coordinates. Finally, doubling the cube and trisecting certain angles requires solving certain cubic equations that can be proved to have no rational roots. The Isabelle proofs require a great many detailed calculations. notify = ralph.romanos@student.ecp.fr, lp15@cam.ac.uk [IP_Addresses] title = IP Addresses author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Lars Hupel <https://www21.in.tum.de/~hupel/> notify = diekmann@net.in.tum.de date = 2016-06-28 topic = Computer science/Networks abstract = This entry contains a definition of IP addresses and a library to work with them. Generic IP addresses are modeled as machine words of arbitrary length. Derived from this generic definition, IPv4 addresses are 32bit machine words, IPv6 addresses are 128bit words. Additionally, IPv4 addresses can be represented in dot-decimal notation and IPv6 addresses in (compressed) colon-separated notation. We support toString functions and parsers for both notations. Sets of IP addresses can be represented with a netmask (e.g. 192.168.0.0/255.255.0.0) or in CIDR notation (e.g. 192.168.0.0/16). To provide executable code for set operations on IP address ranges, the library includes a datatype to work on arbitrary intervals of machine words. [Simple_Firewall] title = Simple Firewall author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Maximilian Haslbeck<http://cl-informatik.uibk.ac.at/users/mhaslbeck//> notify = diekmann@net.in.tum.de, max.haslbeck@gmx.de date = 2016-08-24 topic = Computer science/Networks abstract = We present a simple model of a firewall. The firewall can accept or drop a packet and can match on interfaces, IP addresses, protocol, and ports. It was designed to feature nice mathematical properties: The type of match expressions was carefully crafted such that the conjunction of two match expressions is only one match expression. This model is too simplistic to mirror all aspects of the real world. In the upcoming entry "Iptables Semantics", we will translate the Linux firewall iptables to this model. For a fixed service (e.g. ssh, http), we provide an algorithm to compute an overview of the firewall's filtering behavior. The algorithm computes minimal service matrices, i.e. graphs which partition the complete IPv4 and IPv6 address space and visualize the allowed accesses between partitions. For a detailed description, see <a href="http://dl.ifip.org/db/conf/networking/networking2016/1570232858.pdf">Verified iptables Firewall Analysis</a>, IFIP Networking 2016. [Iptables_Semantics] title = Iptables Semantics author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~hupel/> notify = diekmann@net.in.tum.de, hupel@in.tum.de date = 2016-09-09 topic = Computer science/Networks abstract = We present a big step semantics of the filtering behavior of the Linux/netfilter iptables firewall. We provide algorithms to simplify complex iptables rulests to a simple firewall model (c.f. AFP entry <a href="https://www.isa-afp.org/entries/Simple_Firewall.html">Simple_Firewall</a>) and to verify spoofing protection of a ruleset. Internally, we embed our semantics into ternary logic, ultimately supporting every iptables match condition by abstracting over unknowns. Using this AFP entry and all entries it depends on, we created an easy-to-use, stand-alone haskell tool called <a href="http://iptables.isabelle.systems">fffuu</a>. The tool does not require any input —except for the <tt>iptables-save</tt> dump of the analyzed firewall— and presents interesting results about the user's ruleset. Real-Word firewall errors have been uncovered, and the correctness of rulesets has been proved, with the help of our tool. [Routing] title = Routing author = Julius Michaelis <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~diekmann> notify = afp@liftm.de date = 2016-08-31 topic = Computer science/Networks abstract = This entry contains definitions for routing with routing tables/longest prefix matching. A routing table entry is modelled as a record of a prefix match, a metric, an output port, and an optional next hop. A routing table is a list of entries, sorted by prefix length and metric. Additionally, a parser and serializer for the output of the ip-route command, a function to create a relation from output port to corresponding destination IP space, and a model of a Linux-style router are included. [KBPs] title = Knowledge-based programs author = Peter Gammie <http://peteg.org> topic = Computer science/Automata and formal languages date = 2011-05-17 abstract = Knowledge-based programs (KBPs) are a formalism for directly relating agents' knowledge and behaviour. Here we present a general scheme for compiling KBPs to executable automata with a proof of correctness in Isabelle/HOL. We develop the algorithm top-down, using Isabelle's locale mechanism to structure these proofs, and show that two classic examples can be synthesised using Isabelle's code generator. extra-history = Change history: [2012-03-06]: Add some more views and revive the code generation. notify = kleing@cse.unsw.edu.au [Tarskis_Geometry] title = The independence of Tarski's Euclidean axiom author = T. J. M. Makarios <mailto:tjm1983@gmail.com> topic = Mathematics/Geometry date = 2012-10-30 abstract = Tarski's axioms of plane geometry are formalized and, using the standard real Cartesian model, shown to be consistent. A substantial theory of the projective plane is developed. Building on this theory, the Klein-Beltrami model of the hyperbolic plane is defined and shown to satisfy all of Tarski's axioms except his Euclidean axiom; thus Tarski's Euclidean axiom is shown to be independent of his other axioms of plane geometry. An earlier version of this work was the subject of the author's <a href="http://researcharchive.vuw.ac.nz/handle/10063/2315">MSc thesis</a>, which contains natural-language explanations of some of the more interesting proofs. notify = tjm1983@gmail.com [IsaGeoCoq] title = Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid author = Roland Coghetto <mailto:roland_coghetto@hotmail.com> topic = Mathematics/Geometry license = LGPL date = 2021-01-31 notify = roland_coghetto@hotmail.com abstract = The <a href="https://geocoq.github.io/GeoCoq/">GeoCoq library</a> contains a formalization of geometry using the Coq proof assistant. It contains both proofs about the foundations of geometry and high-level proofs in the same style as in high school. We port a part of the GeoCoq 2.4.0 library to Isabelle/HOL: more precisely, the files Chap02.v to Chap13_3.v, suma.v as well as the associated definitions and some useful files for the demonstration of certain parallel postulates. The synthetic approach of the demonstrations is directly inspired by those contained in GeoCoq. The names of the lemmas and theorems used are kept as far as possible as well as the definitions. It should be noted that T.J.M. Makarios has done <a href="https://www.isa-afp.org/entries/Tarskis_Geometry.html">some proofs in Tarski's Geometry</a>. It uses a definition that does not quite coincide with the definition used in Geocoq and here. Furthermore, corresponding definitions in the <a href="https://www.isa-afp.org/entries/Poincare_Disc.html">Poincaré Disc Model development</a> are not identical to those defined in GeoCoq. In the last part, it is formalized that, in the neutral/absolute space, the axiom of the parallels of Tarski's system implies the Playfair axiom, the 5th postulate of Euclid and Euclid's original parallel postulate. These proofs, which are not constructive, are directly inspired by Pierre Boutry, Charly Gries, Julien Narboux and Pascal Schreck. [General-Triangle] title = The General Triangle Is Unique author = Joachim Breitner <mailto:mail@joachim-breitner.de> topic = Mathematics/Geometry date = 2011-04-01 abstract = Some acute-angled triangles are special, e.g. right-angled or isoscele triangles. Some are not of this kind, but, without measuring angles, look as if they were. In that sense, there is exactly one general triangle. This well-known fact is proven here formally. notify = mail@joachim-breitner.de [LightweightJava] title = Lightweight Java author = Rok Strniša <http://rok.strnisa.com/lj/>, Matthew Parkinson <http://research.microsoft.com/people/mattpark/> topic = Computer science/Programming languages/Language definitions date = 2011-02-07 abstract = A fully-formalized and extensible minimal imperative fragment of Java. notify = rok@strnisa.com [Lower_Semicontinuous] title = Lower Semicontinuous Functions author = Bogdan Grechuk <mailto:grechukbogdan@yandex.ru> topic = Mathematics/Analysis date = 2011-01-08 abstract = We define the notions of lower and upper semicontinuity for functions from a metric space to the extended real line. We prove that a function is both lower and upper semicontinuous if and only if it is continuous. We also give several equivalent characterizations of lower semicontinuity. In particular, we prove that a function is lower semicontinuous if and only if its epigraph is a closed set. Also, we introduce the notion of the lower semicontinuous hull of an arbitrary function and prove its basic properties. notify = hoelzl@in.tum.de [RIPEMD-160-SPARK] title = RIPEMD-160 author = Fabian Immler <mailto:immler@in.tum.de> topic = Computer science/Programming languages/Static analysis date = 2011-01-10 abstract = This work presents a verification of an implementation in SPARK/ADA of the cryptographic hash-function RIPEMD-160. A functional specification of RIPEMD-160 is given in Isabelle/HOL. Proofs for the verification conditions generated by the static-analysis toolset of SPARK certify the functional correctness of the implementation. extra-history = Change history: [2015-11-09]: Entry is now obsolete, moved to Isabelle distribution. notify = immler@in.tum.de [Regular-Sets] title = Regular Sets and Expressions author = Alexander Krauss <http://www.in.tum.de/~krauss>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> contributors = Manuel Eberl <https://pruvisto.org> topic = Computer science/Automata and formal languages date = 2010-05-12 abstract = This is a library of constructions on regular expressions and languages. It provides the operations of concatenation, Kleene star and derivative on languages. Regular expressions and their meaning are defined. An executable equivalence checker for regular expressions is verified; it does not need automata but works directly on regular expressions. By mapping regular expressions to binary relations, an automatic and complete proof method for (in)equalities of binary relations over union, concatenation and (reflexive) transitive closure is obtained. Extended regular expressions with complement and intersection are also defined and an equivalence checker is provided. extra-history = Change history: [2011-08-26]: Christian Urban added a theory about derivatives and partial derivatives of regular expressions [2012-05-10]: Tobias Nipkow added extended regular expressions [2012-05-10]: Tobias Nipkow added equivalence checking with partial derivatives notify = nipkow@in.tum.de, krauss@in.tum.de, christian.urban@kcl.ac.uk [Regex_Equivalence] title = Unified Decision Procedures for Regular Expression Equivalence author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Automata and formal languages date = 2014-01-30 abstract = We formalize a unified framework for verified decision procedures for regular expression equivalence. Five recently published formalizations of such decision procedures (three based on derivatives, two on marked regular expressions) can be obtained as instances of the framework. We discover that the two approaches based on marked regular expressions, which were previously thought to be the same, are different, and one seems to produce uniformly smaller automata. The common framework makes it possible to compare the performance of the different decision procedures in a meaningful way. <a href="http://www21.in.tum.de/~nipkow/pubs/itp14.html"> The formalization is described in a paper of the same name presented at Interactive Theorem Proving 2014</a>. notify = nipkow@in.tum.de, traytel@in.tum.de [MSO_Regex_Equivalence] title = Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions author = Dmitriy Traytel <https://traytel.bitbucket.io>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2014-06-12 abstract = Monadic second-order logic on finite words (MSO) is a decidable yet expressive logic into which many decision problems can be encoded. Since MSO formulas correspond to regular languages, equivalence of MSO formulas can be reduced to the equivalence of some regular structures (e.g. automata). We verify an executable decision procedure for MSO formulas that is not based on automata but on regular expressions. Decision procedures for regular expression equivalence have been formalized before, usually based on Brzozowski derivatives. Yet, for a straightforward embedding of MSO formulas into regular expressions an extension of regular expressions with a projection operation is required. We prove total correctness and completeness of an equivalence checker for regular expressions extended in that way. We also define a language-preserving translation of formulas into regular expressions with respect to two different semantics of MSO. The formalization is described in this <a href="http://www21.in.tum.de/~nipkow/pubs/icfp13.html">ICFP 2013 functional pearl</a>. notify = traytel@in.tum.de, nipkow@in.tum.de [Formula_Derivatives] title = Derivatives of Logical Formulas author = Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2015-05-28 abstract = We formalize new decision procedures for WS1S, M2L(Str), and Presburger Arithmetics. Formulas of these logics denote regular languages. Unlike traditional decision procedures, we do not translate formulas into automata (nor into regular expressions), at least not explicitly. Instead we devise notions of derivatives (inspired by Brzozowski derivatives for regular expressions) that operate on formulas directly and compute a syntactic bisimulation using these derivatives. The treatment of Boolean connectives and quantifiers is uniform for all mentioned logics and is abstracted into a locale. This locale is then instantiated by different atomic formulas and their derivatives (which may differ even for the same logic under different encodings of interpretations as formal words). The WS1S instance is described in the draft paper <a href="https://people.inf.ethz.ch/trayteld/papers/csl15-ws1s_derivatives/index.html">A Coalgebraic Decision Procedure for WS1S</a> by the author. notify = traytel@in.tum.de [Myhill-Nerode] title = The Myhill-Nerode Theorem Based on Regular Expressions author = Chunhan Wu <>, Xingyuan Zhang <>, Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/> contributors = Manuel Eberl <https://pruvisto.org> topic = Computer science/Automata and formal languages date = 2011-08-26 abstract = There are many proofs of the Myhill-Nerode theorem using automata. In this library we give a proof entirely based on regular expressions, since regularity of languages can be conveniently defined using regular expressions (it is more painful in HOL to define regularity in terms of automata). We prove the first direction of the Myhill-Nerode theorem by solving equational systems that involve regular expressions. For the second direction we give two proofs: one using tagging-functions and another using partial derivatives. We also establish various closure properties of regular languages. Most details of the theories are described in our ITP 2011 paper. notify = christian.urban@kcl.ac.uk [Universal_Turing_Machine] title = Universal Turing Machine author = Jian Xu<>, Xingyuan Zhang<>, Christian Urban <https://nms.kcl.ac.uk/christian.urban/>, Sebastiaan J. C. Joosten <https://sjcjoosten.nl/> topic = Logic/Computability, Computer science/Automata and formal languages date = 2019-02-08 notify = sjcjoosten@gmail.com, christian.urban@kcl.ac.uk abstract = We formalise results from computability theory: recursive functions, undecidability of the halting problem, and the existence of a universal Turing machine. This formalisation is the AFP entry corresponding to the paper Mechanising Turing Machines and Computability Theory in Isabelle/HOL, ITP 2013. [CYK] title = A formalisation of the Cocke-Younger-Kasami algorithm author = Maksym Bortin <mailto:Maksym.Bortin@nicta.com.au> date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Automata and formal languages abstract = The theory provides a formalisation of the Cocke-Younger-Kasami algorithm (CYK for short), an approach to solving the word problem for context-free languages. CYK decides if a word is in the languages generated by a context-free grammar in Chomsky normal form. The formalized algorithm is executable. notify = maksym.bortin@nicta.com.au [Boolean_Expression_Checkers] title = Boolean Expression Checkers author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2014-06-08 topic = Computer science/Algorithms, Logic/General logic/Mechanization of proofs abstract = This entry provides executable checkers for the following properties of boolean expressions: satisfiability, tautology and equivalence. Internally, the checkers operate on binary decision trees and are reasonably efficient (for purely functional algorithms). extra-history = Change history: [2015-09-23]: Salomon Sickert added an interface that does not require the usage of the Boolean formula datatype. Furthermore the general Mapping type is used instead of an association list. notify = nipkow@in.tum.de [Presburger-Automata] title = Formalizing the Logic-Automaton Connection author = Stefan Berghofer <http://www.in.tum.de/~berghofe>, Markus Reiter <> date = 2009-12-03 topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories abstract = This work presents a formalization of a library for automata on bit strings. It forms the basis of a reflection-based decision procedure for Presburger arithmetic, which is efficiently executable thanks to Isabelle's code generator. With this work, we therefore provide a mechanized proof of a well-known connection between logic and automata theory. The formalization is also described in a publication [TPHOLs 2009]. notify = berghofe@in.tum.de [Functional-Automata] title = Functional Automata author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2004-03-30 topic = Computer science/Automata and formal languages abstract = This theory defines deterministic and nondeterministic automata in a functional representation: the transition function/relation and the finality predicate are just functions. Hence the state space may be infinite. It is shown how to convert regular expressions into such automata. A scanner (generator) is implemented with the help of functional automata: the scanner chops the input up into longest recognized substrings. Finally we also show how to convert a certain subclass of functional automata (essentially the finite deterministic ones) into regular sets. notify = nipkow@in.tum.de [Statecharts] title = Formalizing Statecharts using Hierarchical Automata author = Steffen Helke <mailto:helke@cs.tu-berlin.de>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de> topic = Computer science/Automata and formal languages date = 2010-08-08 abstract = We formalize in Isabelle/HOL the abtract syntax and a synchronous step semantics for the specification language Statecharts. The formalization is based on Hierarchical Automata which allow a structural decomposition of Statecharts into Sequential Automata. To support the composition of Statecharts, we introduce calculating operators to construct a Hierarchical Automaton in a stepwise manner. Furthermore, we present a complete semantics of Statecharts including a theory of data spaces, which enables the modelling of racing effects. We also adapt CTL for Statecharts to build a bridge for future combinations with model checking. However the main motivation of this work is to provide a sound and complete basis for reasoning on Statecharts. As a central meta theorem we prove that the well-formedness of a Statechart is preserved by the semantics. notify = nipkow@in.tum.de [Stuttering_Equivalence] title = Stuttering Equivalence author = Stephan Merz <http://www.loria.fr/~merz> topic = Computer science/Automata and formal languages date = 2012-05-07 abstract = Two omega-sequences are stuttering equivalent if they differ only by finite repetitions of elements. Stuttering equivalence is a fundamental concept in the theory of concurrent and distributed systems. Notably, Lamport argues that refinement notions for such systems should be insensitive to finite stuttering. Peled and Wilke showed that all PLTL (propositional linear-time temporal logic) properties that are insensitive to stuttering equivalence can be expressed without the next-time operator. Stuttering equivalence is also important for certain verification techniques such as partial-order reduction for model checking. We formalize stuttering equivalence in Isabelle/HOL. Our development relies on the notion of stuttering sampling functions that may skip blocks of identical sequence elements. We also encode PLTL and prove the theorem due to Peled and Wilke. extra-history = Change history: [2013-01-31]: Added encoding of PLTL and proved Peled and Wilke's theorem. Adjusted abstract accordingly. notify = Stephan.Merz@loria.fr [Coinductive_Languages] title = A Codatatype of Formal Languages author = Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Automata and formal languages date = 2013-11-15 abstract = We define formal languages as a codataype of infinite trees branching over the alphabet. Each node in such a tree indicates whether the path to this node constitutes a word inside or outside of the language. This codatatype is isormorphic to the set of lists representation of languages, but caters for definitions by corecursion and proofs by coinduction. Regular operations on languages are then defined by primitive corecursion. A difficulty arises here, since the standard definitions of concatenation and iteration from the coalgebraic literature are not primitively corecursive-they require guardedness up-to union/concatenation. Without support for up-to corecursion, these operation must be defined as a composition of primitive ones (and proved being equal to the standard definitions). As an exercise in coinduction we also prove the axioms of Kleene algebra for the defined regular operations. Furthermore, a language for context-free grammars given by productions in Greibach normal form and an initial nonterminal is constructed by primitive corecursion, yielding an executable decision procedure for the word problem without further ado. notify = traytel@in.tum.de [Tree-Automata] title = Tree Automata author = Peter Lammich <http://www21.in.tum.de/~lammich> date = 2009-11-25 topic = Computer science/Automata and formal languages abstract = This work presents a machine-checked tree automata library for Standard-ML, OCaml and Haskell. The algorithms are efficient by using appropriate data structures like RB-trees. The available algorithms for non-deterministic automata include membership query, reduction, intersection, union, and emptiness check with computation of a witness for non-emptiness. The executable algorithms are derived from less-concrete, non-executable algorithms using data-refinement techniques. The concrete data structures are from the Isabelle Collections Framework. Moreover, this work contains a formalization of the class of tree-regular languages and its closure properties under set operations. notify = peter.lammich@uni-muenster.de, nipkow@in.tum.de [Depth-First-Search] title = Depth First Search author = Toshiaki Nishihara <>, Yasuhiko Minamide <> date = 2004-06-24 topic = Computer science/Algorithms/Graph abstract = Depth-first search of a graph is formalized with recdef. It is shown that it visits all of the reachable nodes from a given list of nodes. Executable ML code of depth-first search is obtained using the code generation feature of Isabelle/HOL. notify = lp15@cam.ac.uk, krauss@in.tum.de [FFT] title = Fast Fourier Transform author = Clemens Ballarin <http://www21.in.tum.de/~ballarin/> date = 2005-10-12 topic = Computer science/Algorithms/Mathematical abstract = We formalise a functional implementation of the FFT algorithm over the complex numbers, and its inverse. Both are shown equivalent to the usual definitions of these operations through Vandermonde matrices. They are also shown to be inverse to each other, more precisely, that composition of the inverse and the transformation yield the identity up to a scalar. notify = ballarin@in.tum.de [Gauss-Jordan-Elim-Fun] title = Gauss-Jordan Elimination for Matrices Represented as Functions author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2011-08-19 topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra abstract = This theory provides a compact formulation of Gauss-Jordan elimination for matrices represented as functions. Its distinctive feature is succinctness. It is not meant for large computations. notify = nipkow@in.tum.de [UpDown_Scheme] title = Verification of the UpDown Scheme author = Johannes Hölzl <mailto:hoelzl@in.tum.de> date = 2015-01-28 topic = Computer science/Algorithms/Mathematical abstract = The UpDown scheme is a recursive scheme used to compute the stiffness matrix on a special form of sparse grids. Usually, when discretizing a Euclidean space of dimension d we need O(n^d) points, for n points along each dimension. Sparse grids are a hierarchical representation where the number of points is reduced to O(n * log(n)^d). One disadvantage of such sparse grids is that the algorithm now operate recursively in the dimensions and levels of the sparse grid. The UpDown scheme allows us to compute the stiffness matrix on such a sparse grid. The stiffness matrix represents the influence of each representation function on the L^2 scalar product. For a detailed description see Dirk Pflüger's PhD thesis. This formalization was developed as an interdisciplinary project (IDP) at the Technische Universität München. notify = hoelzl@in.tum.de [GraphMarkingIBP] title = Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/Ralph-Johan.Back/> date = 2010-05-28 topic = Computer science/Algorithms/Graph abstract = The verification of the Deutsch-Schorr-Waite graph marking algorithm is used as a benchmark in many formalizations of pointer programs. The main purpose of this mechanization is to show how data refinement of invariant based programs can be used in verifying practical algorithms. The verification starts with an abstract algorithm working on a graph given by a relation next on nodes. Gradually the abstract program is refined into Deutsch-Schorr-Waite graph marking algorithm where only one bit per graph node of additional memory is used for marking. extra-history = Change history: [2012-01-05]: Updated for the new definition of data refinement and the new syntax for demonic and angelic update statements notify = viorel.preoteasa@aalto.fi [Efficient-Mergesort] title = Efficient Mergesort topic = Computer science/Algorithms date = 2011-11-09 author = Christian Sternagel <mailto:c.sternagel@gmail.com> abstract = We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution. extra-history = Change history: [2012-10-24]: Added reference to journal article. [2018-09-17]: Added theory Efficient_Mergesort that works exclusively with the mutual induction schemas generated by the function package. [2018-09-19]: Added theory Mergesort_Complexity that proves an upper bound on the number of comparisons that are required by mergesort. [2018-09-19]: Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old name Efficient_Sort. [2020-11-20]: Additional theory Natural_Mergesort that developes an efficient mergesort algorithm without key-functions for educational purposes. notify = c.sternagel@gmail.com [SATSolverVerification] title = Formal Verification of Modern SAT Solvers author = Filip Marić <http://poincare.matf.bg.ac.rs/~filip/> date = 2008-07-23 topic = Computer science/Algorithms abstract = This document contains formal correctness proofs of modern SAT solvers. Following (Krstic et al, 2007) and (Nieuwenhuis et al., 2006), solvers are described using state-transition systems. Several different SAT solver descriptions are given and their partial correctness and termination is proved. These include: <ul> <li> a solver based on classical DPLL procedure (using only a backtrack-search with unit propagation),</li> <li> a very general solver with backjumping and learning (similar to the description given in (Nieuwenhuis et al., 2006)), and</li> <li> a solver with a specific conflict analysis algorithm (similar to the description given in (Krstic et al., 2007)).</li> </ul> Within the SAT solver correctness proofs, a large number of lemmas about propositional logic and CNF formulae are proved. This theory is self-contained and could be used for further exploring of properties of CNF based SAT algorithms. notify = [Transitive-Closure] title = Executable Transitive Closures of Finite Relations topic = Computer science/Algorithms/Graph date = 2011-03-14 author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> license = LGPL abstract = We provide a generic work-list algorithm to compute the transitive closure of finite relations where only successors of newly detected states are generated. This algorithm is then instantiated for lists over arbitrary carriers and red black trees (which are faster but require a linear order on the carrier), respectively. Our formalization was performed as part of the IsaFoR/CeTA project where reflexive transitive closures of large tree automata have to be computed. extra-history = Change history: [2014-09-04] added example simprocs in Finite_Transitive_Closure_Simprocs notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [Transitive-Closure-II] title = Executable Transitive Closures topic = Computer science/Algorithms/Graph date = 2012-02-29 author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> license = LGPL abstract = We provide a generic work-list algorithm to compute the (reflexive-)transitive closure of relations where only successors of newly detected states are generated. In contrast to our previous work, the relations do not have to be finite, but each element must only have finitely many (indirect) successors. Moreover, a subsumption relation can be used instead of pure equality. An executable variant of the algorithm is available where the generic operations are instantiated with list operations. This formalization was performed as part of the IsaFoR/CeTA project, and it has been used to certify size-change termination proofs where large transitive closures have to be computed. notify = rene.thiemann@uibk.ac.at [MuchAdoAboutTwo] title = Much Ado About Two author = Sascha Böhme <http://www21.in.tum.de/~boehmes/> date = 2007-11-06 topic = Computer science/Algorithms abstract = This article is an Isabelle formalisation of a paper with the same title. In a similar way as Knuth's 0-1-principle for sorting algorithms, that paper develops a 0-1-2-principle for parallel prefix computations. notify = boehmes@in.tum.de [DiskPaxos] title = Proving the Correctness of Disk Paxos date = 2005-06-22 author = Mauro Jaskelioff <http://www.fceia.unr.edu.ar/~mauro/>, Stephan Merz <http://www.loria.fr/~merz> topic = Computer science/Algorithms/Distributed abstract = Disk Paxos is an algorithm for building arbitrary fault-tolerant distributed systems. The specification of Disk Paxos has been proved correct informally and tested using the TLC model checker, but up to now, it has never been fully formally verified. In this work we have formally verified its correctness using the Isabelle theorem prover and the HOL logic system, showing that Isabelle is a practical tool for verifying properties of TLA+ specifications. notify = kleing@cse.unsw.edu.au [GenClock] title = Formalization of a Generalized Protocol for Clock Synchronization author = Alwen Tiu <http://users.cecs.anu.edu.au/~tiu/> date = 2005-06-24 topic = Computer science/Algorithms/Distributed abstract = We formalize the generalized Byzantine fault-tolerant clock synchronization protocol of Schneider. This protocol abstracts from particular algorithms or implementations for clock synchronization. This abstraction includes several assumptions on the behaviors of physical clocks and on general properties of concrete algorithms/implementations. Based on these assumptions the correctness of the protocol is proved by Schneider. His proof was later verified by Shankar using the theorem prover EHDM (precursor to PVS). Our formalization in Isabelle/HOL is based on Shankar's formalization. notify = kleing@cse.unsw.edu.au [ClockSynchInst] title = Instances of Schneider's generalized protocol of clock synchronization author = Damián Barsotti <http://www.cs.famaf.unc.edu.ar/~damian/> date = 2006-03-15 topic = Computer science/Algorithms/Distributed abstract = F. B. Schneider ("Understanding protocols for Byzantine clock synchronization") generalizes a number of protocols for Byzantine fault-tolerant clock synchronization and presents a uniform proof for their correctness. In Schneider's schema, each processor maintains a local clock by periodically adjusting each value to one computed by a convergence function applied to the readings of all the clocks. Then, correctness of an algorithm, i.e. that the readings of two clocks at any time are within a fixed bound of each other, is based upon some conditions on the convergence function. To prove that a particular clock synchronization algorithm is correct it suffices to show that the convergence function used by the algorithm meets Schneider's conditions. Using the theorem prover Isabelle, we formalize the proofs that the convergence functions of two algorithms, namely, the Interactive Convergence Algorithm (ICA) of Lamport and Melliar-Smith and the Fault-tolerant Midpoint algorithm of Lundelius-Lynch, meet Schneider's conditions. Furthermore, we experiment on handling some parts of the proofs with fully automatic tools like ICS and CVC-lite. These theories are part of a joint work with Alwen Tiu and Leonor P. Nieto <a href="http://users.rsise.anu.edu.au/~tiu/clocksync.pdf">"Verification of Clock Synchronization Algorithms: Experiments on a combination of deductive tools"</a> in proceedings of AVOCS 2005. In this work the correctness of Schneider schema was also verified using Isabelle (entry <a href="GenClock.html">GenClock</a> in AFP). notify = kleing@cse.unsw.edu.au [Heard_Of] title = Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model date = 2012-07-27 author = Henri Debrat <mailto:henri.debrat@loria.fr>, Stephan Merz <http://www.loria.fr/~merz> topic = Computer science/Algorithms/Distributed abstract = Distributed computing is inherently based on replication, promising increased tolerance to failures of individual computing nodes or communication channels. Realizing this promise, however, involves quite subtle algorithmic mechanisms, and requires precise statements about the kinds and numbers of faults that an algorithm tolerates (such as process crashes, communication faults or corrupted values). The landmark theorem due to Fischer, Lynch, and Paterson shows that it is impossible to achieve Consensus among N asynchronously communicating nodes in the presence of even a single permanent failure. Existing solutions must rely on assumptions of "partial synchrony". Indeed, there have been numerous misunderstandings on what exactly a given algorithm is supposed to realize in what kinds of environments. Moreover, the abundance of subtly different computational models complicates comparisons between different algorithms. Charron-Bost and Schiper introduced the Heard-Of model for representing algorithms and failure assumptions in a uniform framework, simplifying comparisons between algorithms. In this contribution, we represent the Heard-Of model in Isabelle/HOL. We define two semantics of runs of algorithms with different unit of atomicity and relate these through a reduction theorem that allows us to verify algorithms in the coarse-grained semantics (where proofs are easier) and infer their correctness for the fine-grained one (which corresponds to actual executions). We instantiate the framework by verifying six Consensus algorithms that differ in the underlying algorithmic mechanisms and the kinds of faults they tolerate. notify = Stephan.Merz@loria.fr [Consensus_Refined] title = Consensus Refined date = 2015-03-18 author = Ognjen Maric <>, Christoph Sprenger <mailto:sprenger@inf.ethz.ch> topic = Computer science/Algorithms/Distributed abstract = Algorithms for solving the consensus problem are fundamental to distributed computing. Despite their brevity, their ability to operate in concurrent, asynchronous and failure-prone environments comes at the cost of complex and subtle behaviors. Accordingly, understanding how they work and proving their correctness is a non-trivial endeavor where abstraction is immensely helpful. Moreover, research on consensus has yielded a large number of algorithms, many of which appear to share common algorithmic ideas. A natural question is whether and how these similarities can be distilled and described in a precise, unified way. In this work, we combine stepwise refinement and lockstep models to provide an abstract and unified view of a sizeable family of consensus algorithms. Our models provide insights into the design choices underlying the different algorithms, and classify them based on those choices. notify = sprenger@inf.ethz.ch [Key_Agreement_Strong_Adversaries] title = Refining Authenticated Key Agreement with Strong Adversaries author = Joseph Lallemand <mailto:joseph.lallemand@loria.fr>, Christoph Sprenger <mailto:sprenger@inf.ethz.ch> topic = Computer science/Security license = LGPL date = 2017-01-31 notify = joseph.lallemand@loria.fr, sprenger@inf.ethz.ch abstract = We develop a family of key agreement protocols that are correct by construction. Our work substantially extends prior work on developing security protocols by refinement. First, we strengthen the adversary by allowing him to compromise different resources of protocol participants, such as their long-term keys or their session keys. This enables the systematic development of protocols that ensure strong properties such as perfect forward secrecy. Second, we broaden the class of protocols supported to include those with non-atomic keys and equationally defined cryptographic operators. We use these extensions to develop key agreement protocols including signed Diffie-Hellman and the core of IKEv1 and SKEME. [Security_Protocol_Refinement] title = Developing Security Protocols by Refinement author = Christoph Sprenger <mailto:sprenger@inf.ethz.ch>, Ivano Somaini<> topic = Computer science/Security license = LGPL date = 2017-05-24 notify = sprenger@inf.ethz.ch abstract = We propose a development method for security protocols based on stepwise refinement. Our refinement strategy transforms abstract security goals into protocols that are secure when operating over an insecure channel controlled by a Dolev-Yao-style intruder. As intermediate levels of abstraction, we employ messageless guard protocols and channel protocols communicating over channels with security properties. These abstractions provide insights on why protocols are secure and foster the development of families of protocols sharing common structure and properties. We have implemented our method in Isabelle/HOL and used it to develop different entity authentication and key establishment protocols, including realistic features such as key confirmation, replay caches, and encrypted tickets. Our development highlights that guard protocols and channel protocols provide fundamental abstractions for bridging the gap between security properties and standard protocol descriptions based on cryptographic messages. It also shows that our refinement approach scales to protocols of nontrivial size and complexity. [Abortable_Linearizable_Modules] title = Abortable Linearizable Modules author = Rachid Guerraoui <mailto:rachid.guerraoui@epfl.ch>, Viktor Kuncak <http://lara.epfl.ch/~kuncak/>, Giuliano Losa <mailto:giuliano.losa@epfl.ch> date = 2012-03-01 topic = Computer science/Algorithms/Distributed abstract = We define the Abortable Linearizable Module automaton (ALM for short) and prove its key composition property using the IOA theory of HOLCF. The ALM is at the heart of the Speculative Linearizability framework. This framework simplifies devising correct speculative algorithms by enabling their decomposition into independent modules that can be analyzed and proved correct in isolation. It is particularly useful when working in a distributed environment, where the need to tolerate faults and asynchrony has made current monolithic protocols so intricate that it is no longer tractable to check their correctness. Our theory contains a typical example of a refinement proof in the I/O-automata framework of Lynch and Tuttle. notify = giuliano@losa.fr, nipkow@in.tum.de [Amortized_Complexity] title = Amortized Complexity Verified author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2014-07-07 topic = Computer science/Data structures abstract = A framework for the analysis of the amortized complexity of functional data structures is formalized in Isabelle/HOL and applied to a number of standard examples and to the folowing non-trivial ones: skew heaps, splay trees, splay heaps and pairing heaps. A preliminary version of this work (without pairing heaps) is described in a <a href="http://www21.in.tum.de/~nipkow/pubs/itp15.html">paper</a> published in the proceedings of the conference on Interactive Theorem Proving ITP 2015. An extended version of this publication is available <a href="http://www21.in.tum.de/~nipkow/pubs/jfp16.html">here</a>. extra-history = Change history: [2015-03-17]: Added pairing heaps by Hauke Brinkop. [2016-07-12]: Moved splay heaps from here to Splay_Tree [2016-07-14]: Moved pairing heaps from here to the new Pairing_Heap notify = nipkow@in.tum.de [Dynamic_Tables] title = Parameterized Dynamic Tables author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2015-06-07 topic = Computer science/Data structures abstract = This article formalizes the amortized analysis of dynamic tables parameterized with their minimal and maximal load factors and the expansion and contraction factors. A full description is found in a <a href="http://www21.in.tum.de/~nipkow/pubs">companion paper</a>. notify = nipkow@in.tum.de [AVL-Trees] title = AVL Trees author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Cornelia Pusch <> date = 2004-03-19 topic = Computer science/Data structures abstract = Two formalizations of AVL trees with room for extensions. The first formalization is monolithic and shorter, the second one in two stages, longer and a bit simpler. The final implementation is the same. If you are interested in developing this further, please contact <tt>gerwin.klein@nicta.com.au</tt>. extra-history = Change history: [2011-04-11]: Ondrej Kuncar added delete function notify = kleing@cse.unsw.edu.au [BDD] title = BDD Normalisation author = Veronika Ortner <>, Norbert Schirmer <> date = 2008-02-29 topic = Computer science/Data structures abstract = We present the verification of the normalisation of a binary decision diagram (BDD). The normalisation follows the original algorithm presented by Bryant in 1986 and transforms an ordered BDD in a reduced, ordered and shared BDD. The verification is based on Hoare logics. notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de [BinarySearchTree] title = Binary Search Trees author = Viktor Kuncak <http://lara.epfl.ch/~kuncak/> date = 2004-04-05 topic = Computer science/Data structures abstract = The correctness is shown of binary search tree operations (lookup, insert and remove) implementing a set. Two versions are given, for both structured and linear (tactic-style) proofs. An implementation of integer-indexed maps is also verified. notify = lp15@cam.ac.uk [Splay_Tree] title = Splay Tree author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> notify = nipkow@in.tum.de date = 2014-08-12 topic = Computer science/Data structures abstract = Splay trees are self-adjusting binary search trees which were invented by Sleator and Tarjan [JACM 1985]. This entry provides executable and verified functional splay trees as well as the related splay heaps (due to Okasaki). The amortized complexity of splay trees and heaps is analyzed in the AFP entry <a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>. extra-history = Change history: [2016-07-12]: Moved splay heaps here from Amortized_Complexity [Root_Balanced_Tree] title = Root-Balanced Tree author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> notify = nipkow@in.tum.de date = 2017-08-20 topic = Computer science/Data structures abstract = Andersson introduced general balanced trees, search trees based on the design principle of partial rebuilding: perform update operations naively until the tree becomes too unbalanced, at which point a whole subtree is rebalanced. This article defines and analyzes a functional version of general balanced trees, which we call root-balanced trees. Using a lightweight model of execution time, amortized logarithmic complexity is verified in the theorem prover Isabelle. This is the Isabelle formalization of the material decribed in the APLAS 2017 article <a href="http://www21.in.tum.de/~nipkow/pubs/aplas17.html">Verified Root-Balanced Trees</a> by the same author, which also presents experimental results that show competitiveness of root-balanced with AVL and red-black trees. [Skew_Heap] title = Skew Heap author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2014-08-13 topic = Computer science/Data structures abstract = Skew heaps are an amazingly simple and lightweight implementation of priority queues. They were invented by Sleator and Tarjan [SIAM 1986] and have logarithmic amortized complexity. This entry provides executable and verified functional skew heaps. The amortized complexity of skew heaps is analyzed in the AFP entry <a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>. notify = nipkow@in.tum.de [Pairing_Heap] title = Pairing Heap author = Hauke Brinkop <mailto:hauke.brinkop@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2016-07-14 topic = Computer science/Data structures abstract = This library defines three different versions of pairing heaps: a functional version of the original design based on binary trees [Fredman et al. 1986], the version by Okasaki [1998] and a modified version of the latter that is free of structural invariants. The amortized complexity of pairing heaps is analyzed in the AFP article <a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>. extra-0 = Origin: This library was extracted from Amortized Complexity and extended. notify = nipkow@in.tum.de [Priority_Queue_Braun] title = Priority Queues Based on Braun Trees author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2014-09-04 topic = Computer science/Data structures abstract = This entry verifies priority queues based on Braun trees. Insertion and deletion take logarithmic time and preserve the balanced nature of Braun trees. Two implementations of deletion are provided. notify = nipkow@in.tum.de extra-history = Change history: [2019-12-16]: Added theory Priority_Queue_Braun2 with second version of del_min [Binomial-Queues] title = Functional Binomial Queues author = René Neumann <mailto:neumannr@in.tum.de> date = 2010-10-28 topic = Computer science/Data structures abstract = Priority queues are an important data structure and efficient implementations of them are crucial. We implement a functional variant of binomial queues in Isabelle/HOL and show its functional correctness. A verification against an abstract reference specification of priority queues has also been attempted, but could not be achieved to the full extent. notify = florian.haftmann@informatik.tu-muenchen.de [Binomial-Heaps] title = Binomial Heaps and Skew Binomial Heaps author = Rene Meis <mailto:rene.meis@uni-muenster.de>, Finn Nielsen <mailto:finn.nielsen@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~lammich> date = 2010-10-28 topic = Computer science/Data structures abstract = We implement and prove correct binomial heaps and skew binomial heaps. Both are data-structures for priority queues. While binomial heaps have logarithmic findMin, deleteMin, insert, and meld operations, skew binomial heaps have constant time findMin, insert, and meld operations, and only the deleteMin-operation is logarithmic. This is achieved by using skew links to avoid cascading linking on insert-operations, and data-structural bootstrapping to get constant-time findMin and meld operations. Our implementation follows the paper by Brodal and Okasaki. notify = peter.lammich@uni-muenster.de [Finger-Trees] title = Finger Trees author = Benedikt Nordhoff <mailto:b_nord01@uni-muenster.de>, Stefan Körner <mailto:s_koer03@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~lammich> date = 2010-10-28 topic = Computer science/Data structures abstract = We implement and prove correct 2-3 finger trees. Finger trees are a general purpose data structure, that can be used to efficiently implement other data structures, such as priority queues. Intuitively, a finger tree is an annotated sequence, where the annotations are elements of a monoid. Apart from operations to access the ends of the sequence, the main operation is to split the sequence at the point where a monotone predicate over the sum of the left part of the sequence becomes true for the first time. The implementation follows the paper of Hinze and Paterson. The code generator can be used to get efficient, verified code. notify = peter.lammich@uni-muenster.de [Trie] title = Trie author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2015-03-30 topic = Computer science/Data structures abstract = This article formalizes the ``trie'' data structure invented by Fredkin [CACM 1960]. It also provides a specialization where the entries in the trie are lists. extra-0 = Origin: This article was extracted from existing articles by the authors. notify = nipkow@in.tum.de [FinFun] title = Code Generation for Functions as Data author = Andreas Lochbihler <http://www.andreas-lochbihler.de> date = 2009-05-06 topic = Computer science/Data structures abstract = FinFuns are total functions that are constant except for a finite set of points, i.e. a generalisation of finite maps. They are formalised as a new type in Isabelle/HOL such that the code generator can handle equality tests and quantification on FinFuns. On the code output level, FinFuns are explicitly represented by constant functions and pointwise updates, similarly to associative lists. Inside the logic, they behave like ordinary functions with extensionality. Via the update/constant pattern, a recursion combinator and an induction rule for FinFuns allow for defining and reasoning about operators on FinFun that are also executable. extra-history = Change history: [2010-08-13]: new concept domain of a FinFun as a FinFun (revision 34b3517cbc09) [2010-11-04]: new conversion function from FinFun to list of elements in the domain (revision 0c167102e6ed) [2012-03-07]: replace sets as FinFuns by predicates as FinFuns because the set type constructor has been reintroduced (revision b7aa87989f3a) notify = nipkow@in.tum.de [Collections] title = Collections Framework author = Peter Lammich <http://www21.in.tum.de/~lammich> contributors = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Thomas Tuerk <> date = 2009-11-25 topic = Computer science/Data structures abstract = This development provides an efficient, extensible, machine checked collections framework. The library adopts the concepts of interface, implementation and generic algorithm from object-oriented programming and implements them in Isabelle/HOL. The framework features the use of data refinement techniques to refine an abstract specification (using high-level concepts like sets) to a more concrete implementation (using collection datastructures, like red-black-trees). The code-generator of Isabelle/HOL can be used to generate efficient code. extra-history = Change history: [2010-10-08]: New Interfaces: OrderedSet, OrderedMap, List. Fifo now implements list-interface: Function names changed: put/get --> enqueue/dequeue. New Implementations: ArrayList, ArrayHashMap, ArrayHashSet, TrieMap, TrieSet. Invariant-free datastructures: Invariant implicitely hidden in typedef. Record-interfaces: All operations of an interface encapsulated as record. Examples moved to examples subdirectory. [2010-12-01]: New Interfaces: Priority Queues, Annotated Lists. Implemented by finger trees, (skew) binomial queues. [2011-10-10]: SetSpec: Added operations: sng, isSng, bexists, size_abort, diff, filter, iterate_rule_insertP MapSpec: Added operations: sng, isSng, iterate_rule_insertP, bexists, size, size_abort, restrict, map_image_filter, map_value_image_filter Some maintenance changes [2012-04-25]: New iterator foundation by Tuerk. Various maintenance changes. [2012-08]: Collections V2. New features: Polymorphic iterators. Generic algorithm instantiation where required. Naming scheme changed from xx_opname to xx.opname. A compatibility file CollectionsV1 tries to simplify porting of existing theories, by providing old naming scheme and the old monomorphic iterator locales. [2013-09]: Added Generic Collection Framework based on Autoref. The GenCF provides: Arbitrary nesting, full integration with Autoref. [2014-06]: Maintenace changes to GenCF: Optimized inj_image on list_set. op_set_cart (Cartesian product). big-Union operation. atLeastLessThan - operation ({a..<b}) notify = lammich@in.tum.de [Containers] title = Light-weight Containers author = Andreas Lochbihler <http://www.andreas-lochbihler.de> contributors = René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2013-04-15 topic = Computer science/Data structures abstract = This development provides a framework for container types like sets and maps such that generated code implements these containers with different (efficient) data structures. Thanks to type classes and refinement during code generation, this light-weight approach can seamlessly replace Isabelle's default setup for code generation. Heuristics automatically pick one of the available data structures depending on the type of elements to be stored, but users can also choose on their own. The extensible design permits to add more implementations at any time. To support arbitrary nesting of sets, we define a linear order on sets based on a linear order of the elements and provide efficient implementations. It even allows to compare complements with non-complements. extra-history = Change history: [2013-07-11]: add pretty printing for sets (revision 7f3f52c5f5fa) [2013-09-20]: provide generators for canonical type class instantiations (revision 159f4401f4a8 by René Thiemann) [2014-07-08]: add support for going from partial functions to mappings (revision 7a6fc957e8ed) [2018-03-05]: add two application examples: depth-first search and 2SAT (revision e5e1a1da2411) notify = mail@andreas-lochbihler.de [FileRefinement] title = File Refinement author = Karen Zee <http://www.mit.edu/~kkz/>, Viktor Kuncak <http://lara.epfl.ch/~kuncak/> date = 2004-12-09 topic = Computer science/Data structures abstract = These theories illustrates the verification of basic file operations (file creation, file read and file write) in the Isabelle theorem prover. We describe a file at two levels of abstraction: an abstract file represented as a resizable array, and a concrete file represented using data blocks. notify = kkz@mit.edu [Datatype_Order_Generator] title = Generating linear orders for datatypes author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2012-08-07 topic = Computer science/Data structures abstract = We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature. We further implemented such automatic methods to derive (linear) orders or hash-functions which are required in the Isabelle Collection Framework. Moreover, for the tactic of Huffman and Krauss to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> project. With our new tactic we could completely remove tedious proofs for linear orders of two datatypes. This development is aimed at datatypes generated by the "old_datatype" command. notify = rene.thiemann@uibk.ac.at [Deriving] title = Deriving class instances for datatypes author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2015-03-11 topic = Computer science/Data structures abstract = We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature. We further implemented such automatic methods to derive comparators, linear orders, parametrizable equality functions, and hash-functions which are required in the Isabelle Collection Framework and the Container Framework. Moreover, for the tactic of Blanchette to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. All of the generators are based on the infrastructure that is provided by the BNF-based datatype package. Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> project. With our new tactics we could remove several tedious proofs for (conditional) linear orders, and conditional equality operators within IsaFoR and the Container Framework. notify = rene.thiemann@uibk.ac.at [List-Index] title = List Index date = 2010-02-20 author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> topic = Computer science/Data structures abstract = This theory provides functions for finding the index of an element in a list, by predicate and by value. notify = nipkow@in.tum.de [List-Infinite] title = Infinite Lists date = 2011-02-23 author = David Trachtenherz <> topic = Computer science/Data structures abstract = We introduce a theory of infinite lists in HOL formalized as functions over naturals (folder ListInf, theories ListInf and ListInf_Prefix). It also provides additional results for finite lists (theory ListInf/List2), natural numbers (folder CommonArith, esp. division/modulo, naturals with infinity), sets (folder CommonSet, esp. cutting/truncating sets, traversing sets of naturals). notify = nipkow@in.tum.de [Matrix] title = Executable Matrix Operations on Matrices of Arbitrary Dimensions topic = Computer science/Data structures date = 2010-06-17 author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann> license = LGPL abstract = We provide the operations of matrix addition, multiplication, transposition, and matrix comparisons as executable functions over ordered semirings. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over matrices. We further show that the standard semirings over the naturals, integers, and rationals, as well as the arctic semirings satisfy the axioms that are required by our matrix theory. Our formalization is part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> system which contains several termination techniques. The provided theories have been essential to formalize matrix-interpretations and arctic interpretations. extra-history = Change history: [2010-09-17]: Moved theory on arbitrary (ordered) semirings to Abstract Rewriting. notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at [Matrix_Tensor] title = Tensor Product of Matrices topic = Computer science/Data structures, Mathematics/Algebra date = 2016-01-18 author = T.V.H. Prathamesh <mailto:prathamesh@imsc.res.in> abstract = In this work, the Kronecker tensor product of matrices and the proofs of some of its properties are formalized. Properties which have been formalized include associativity of the tensor product and the mixed-product property. notify = prathamesh@imsc.res.in [Huffman] title = The Textbook Proof of Huffman's Algorithm author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet> date = 2008-10-15 topic = Computer science/Data structures abstract = Huffman's algorithm is a procedure for constructing a binary tree with minimum weighted path length. This report presents a formal proof of the correctness of Huffman's algorithm written using Isabelle/HOL. Our proof closely follows the sketches found in standard algorithms textbooks, uncovering a few snags in the process. Another distinguishing feature of our formalization is the use of custom induction rules to help Isabelle's automatic tactics, leading to very short proofs for most of the lemmas. notify = jasmin.blanchette@gmail.com [Partial_Function_MR] title = Mutually Recursive Partial Functions author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Computer science/Functional programming date = 2014-02-18 license = LGPL abstract = We provide a wrapper around the partial-function command that supports mutual recursion. notify = rene.thiemann@uibk.ac.at [Lifting_Definition_Option] title = Lifting Definition Option author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Computer science/Functional programming date = 2014-10-13 license = LGPL abstract = We implemented a command that can be used to easily generate elements of a restricted type <tt>{x :: 'a. P x}</tt>, provided the definition is of the form <tt>f ys = (if check ys then Some(generate ys :: 'a) else None)</tt> where <tt>ys</tt> is a list of variables <tt>y1 ... yn</tt> and <tt>check ys ==> P(generate ys)</tt> can be proved. In principle, such a definition is also directly possible using the <tt>lift_definition</tt> command. However, then this definition will not be suitable for code-generation. To this end, we automated a more complex construction of Joachim Breitner which is amenable for code-generation, and where the test <tt>check ys</tt> will only be performed once. In the automation, one auxiliary type is created, and Isabelle's lifting- and transfer-package is invoked several times. notify = rene.thiemann@uibk.ac.at [Coinductive] title = Coinductive topic = Computer science/Functional programming author = Andreas Lochbihler <http://www.andreas-lochbihler.de> contributors = Johannes Hölzl <mailto:hoelzl@in.tum.de> date = 2010-02-12 abstract = This article collects formalisations of general-purpose coinductive data types and sets. Currently, it contains coinductive natural numbers, coinductive lists, i.e. lazy lists or streams, infinite streams, coinductive terminated lists, coinductive resumptions, a library of operations on coinductive lists, and a version of König's lemma as an application for coinductive lists. The initial theory was contributed by Paulson and Wenzel. Extensions and other coinductive formalisations of general interest are welcome. extra-history = Change history: [2010-06-10]: coinductive lists: setup for quotient package (revision 015574f3bf3c) [2010-06-28]: new codatatype terminated lazy lists (revision e12de475c558) [2010-08-04]: terminated lazy lists: setup for quotient package; more lemmas (revision 6ead626f1d01) [2010-08-17]: Koenig's lemma as an example application for coinductive lists (revision f81ce373fa96) [2011-02-01]: lazy implementation of coinductive (terminated) lists for the code generator (revision 6034973dce83) [2011-07-20]: new codatatype resumption (revision 811364c776c7) [2012-06-27]: new codatatype stream with operations (with contributions by Peter Gammie) (revision dd789a56473c) [2013-03-13]: construct codatatypes with the BNF package and adjust the definitions and proofs, setup for lifting and transfer packages (revision f593eda5b2c0) [2013-09-20]: stream theory uses type and operations from HOL/BNF/Examples/Stream (revision 692809b2b262) [2014-04-03]: ccpo structure on codatatypes used to define ldrop, ldropWhile, lfilter, lconcat as least fixpoint; ccpo topology on coinductive lists contributed by Johannes Hölzl; added examples (revision 23cd8156bd42) notify = mail@andreas-lochbihler.de [Stream-Fusion] title = Stream Fusion author = Brian Huffman <http://cs.pdx.edu/~brianh> topic = Computer science/Functional programming date = 2009-04-29 abstract = Stream Fusion is a system for removing intermediate list structures from Haskell programs; it consists of a Haskell library along with several compiler rewrite rules. (The library is available <a href="http://hackage.haskell.org/package/stream-fusion">online</a>.) These theories contain a formalization of much of the Stream Fusion library in HOLCF. Lazy list and stream types are defined, along with coercions between the two types, as well as an equivalence relation for streams that generate the same list. List and stream versions of map, filter, foldr, enumFromTo, append, zipWith, and concatMap are defined, and the stream versions are shown to respect stream equivalence. notify = brianh@cs.pdx.edu [Tycon] title = Type Constructor Classes and Monad Transformers author = Brian Huffman <mailto:huffman@in.tum.de> date = 2012-06-26 topic = Computer science/Functional programming abstract = These theories contain a formalization of first class type constructors and axiomatic constructor classes for HOLCF. This work is described in detail in the ICFP 2012 paper Formal Verification of Monad Transformers by the author. The formalization is a revised and updated version of earlier joint work with Matthews and White. Based on the hierarchy of type classes in Haskell, we define classes for functors, monads, monad-plus, etc. Each one includes all the standard laws as axioms. We also provide a new user command, tycondef, for defining new type constructors in HOLCF. Using tycondef, we instantiate the type class hierarchy with various monads and monad transformers. notify = huffman@in.tum.de [CoreC++] title = CoreC++ author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2006-05-15 topic = Computer science/Programming languages/Language definitions abstract = We present an operational semantics and type safety proof for multiple inheritance in C++. The semantics models the behavior of method calls, field accesses, and two forms of casts in C++ class hierarchies. For explanations see the OOPSLA 2006 paper by Wasserrab, Nipkow, Snelting and Tip. notify = nipkow@in.tum.de [FeatherweightJava] title = A Theory of Featherweight Java in Isabelle/HOL author = J. Nathan Foster <http://www.cs.cornell.edu/~jnfoster/>, Dimitrios Vytiniotis <http://research.microsoft.com/en-us/people/dimitris/> date = 2006-03-31 topic = Computer science/Programming languages/Language definitions abstract = We formalize the type system, small-step operational semantics, and type soundness proof for Featherweight Java, a simple object calculus, in Isabelle/HOL. notify = kleing@cse.unsw.edu.au [Jinja] title = Jinja is not Java author = Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2005-06-01 topic = Computer science/Programming languages/Language definitions abstract = We introduce Jinja, a Java-like programming language with a formal semantics designed to exhibit core features of the Java language architecture. Jinja is a compromise between realism of the language and tractability and clarity of the formal semantics. The following aspects are formalised: a big and a small step operational semantics for Jinja and a proof of their equivalence; a type system and a definite initialisation analysis; a type safety proof of the small step semantics; a virtual machine (JVM), its operational semantics and its type system; a type safety proof for the JVM; a bytecode verifier, i.e. data flow analyser for the JVM; a correctness proof of the bytecode verifier w.r.t. the type system; a compiler and a proof that it preserves semantics and well-typedness. The emphasis of this work is not on particular language features but on providing a unified model of the source language, the virtual machine and the compiler. The whole development has been carried out in the theorem prover Isabelle/HOL. notify = kleing@cse.unsw.edu.au, nipkow@in.tum.de [JinjaThreads] title = Jinja with Threads author = Andreas Lochbihler <http://www.andreas-lochbihler.de> date = 2007-12-03 topic = Computer science/Programming languages/Language definitions abstract = We extend the Jinja source code semantics by Klein and Nipkow with Java-style arrays and threads. Concurrency is captured in a generic framework semantics for adding concurrency through interleaving to a sequential semantics, which features dynamic thread creation, inter-thread communication via shared memory, lock synchronisation and joins. Also, threads can suspend themselves and be notified by others. We instantiate the framework with the adapted versions of both Jinja source and byte code and show type safety for the multithreaded case. Equally, the compiler from source to byte code is extended, for which we prove weak bisimilarity between the source code small step semantics and the defensive Jinja virtual machine. On top of this, we formalise the JMM and show the DRF guarantee and consistency. For description of the different parts, see Lochbihler's papers at FOOL 2008, ESOP 2010, ITP 2011, and ESOP 2012. extra-history = Change history: [2008-04-23]: added bytecode formalisation with arrays and threads, added thread joins (revision f74a8be156a7) [2009-04-27]: added verified compiler from source code to bytecode; encapsulate native methods in separate semantics (revision e4f26541e58a) [2009-11-30]: extended compiler correctness proof to infinite and deadlocking computations (revision e50282397435) [2010-06-08]: added thread interruption; new abstract memory model with sequential consistency as implementation (revision 0cb9e8dbd78d) [2010-06-28]: new thread interruption model (revision c0440d0a1177) [2010-10-15]: preliminary version of the Java memory model for source code (revision 02fee0ef3ca2) [2010-12-16]: improved version of the Java memory model, also for bytecode executable scheduler for source code semantics (revision 1f41c1842f5a) [2011-02-02]: simplified code generator setup new random scheduler (revision 3059dafd013f) [2011-07-21]: new interruption model, generalized JMM proof of DRF guarantee, allow class Object to declare methods and fields, simplified subtyping relation, corrected division and modulo implementation (revision 46e4181ed142) [2012-02-16]: added example programs (revision bf0b06c8913d) [2012-11-21]: type safety proof for the Java memory model, allow spurious wake-ups (revision 76063d860ae0) [2013-05-16]: support for non-deterministic memory allocators (revision cc3344a49ced) [2017-10-20]: add an atomic compare-and-swap operation for volatile fields (revision a6189b1d6b30) notify = mail@andreas-lochbihler.de [Locally-Nameless-Sigma] title = Locally Nameless Sigma Calculus author = Ludovic Henrio <mailto:Ludovic.Henrio@sophia.inria.fr>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de>, Bianca Lutz <mailto:sowilo@cs.tu-berlin.de>, Henry Sudhof <mailto:hsudhof@cs.tu-berlin.de> date = 2010-04-30 topic = Computer science/Programming languages/Language definitions abstract = We present a Theory of Objects based on the original functional sigma-calculus by Abadi and Cardelli but with an additional parameter to methods. We prove confluence of the operational semantics following the outline of Nipkow's proof of confluence for the lambda-calculus reusing his theory Commutation, a generic diamond lemma reduction. We furthermore formalize a simple type system for our sigma-calculus including a proof of type safety. The entire development uses the concept of Locally Nameless representation for binders. We reuse an earlier proof of confluence for a simpler sigma-calculus based on de Bruijn indices and lists to represent objects. notify = nipkow@in.tum.de [Attack_Trees] title = Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems author = Florian Kammueller <http://www.cs.mdx.ac.uk/people/florian-kammueller/> topic = Computer science/Security date = 2020-04-27 notify = florian.kammuller@gmail.com abstract = In this article, we present a proof theory for Attack Trees. Attack Trees are a well established and useful model for the construction of attacks on systems since they allow a stepwise exploration of high level attacks in application scenarios. Using the expressiveness of Higher Order Logic in Isabelle, we develop a generic theory of Attack Trees with a state-based semantics based on Kripke structures and CTL. The resulting framework allows mechanically supported logic analysis of the meta-theory of the proof calculus of Attack Trees and at the same time the developed proof theory enables application to case studies. A central correctness and completeness result proved in Isabelle establishes a connection between the notion of Attack Tree validity and CTL. The application is illustrated on the example of a healthcare IoT system and GDPR compliance verification. [AutoFocus-Stream] title = AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics author = David Trachtenherz <> date = 2011-02-23 topic = Computer science/Programming languages/Language definitions abstract = We formalize the AutoFocus Semantics (a time-synchronous subset of the Focus formalism) as stream processing functions on finite and infinite message streams represented as finite/infinite lists. The formalization comprises both the conventional single-clocking semantics (uniform global clock for all components and communications channels) and its extension to multi-clocking semantics (internal execution clocking of a component may be a multiple of the external communication clocking). The semantics is defined by generic stream processing functions making it suitable for simulation/code generation in Isabelle/HOL. Furthermore, a number of AutoFocus semantics properties are formalized using definitions from the IntervalLogic theories. notify = nipkow@in.tum.de [FocusStreamsCaseStudies] title = Stream Processing Components: Isabelle/HOL Formalisation and Case Studies author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au> date = 2013-11-14 topic = Computer science/Programming languages/Language definitions abstract = This set of theories presents an Isabelle/HOL formalisation of stream processing components introduced in Focus, a framework for formal specification and development of interactive systems. This is an extended and updated version of the formalisation, which was elaborated within the methodology "Focus on Isabelle". In addition, we also applied the formalisation on three case studies that cover different application areas: process control (Steam Boiler System), data transmission (FlexRay communication protocol), memory and processing components (Automotive-Gateway System). notify = lp15@cam.ac.uk, maria.spichkova@rmit.edu.au [Isabelle_Meta_Model] title = A Meta-Model for the Isabelle API author = Frédéric Tuong <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/> date = 2015-09-16 topic = Computer science/Programming languages/Language definitions abstract = We represent a theory of (a fragment of) Isabelle/HOL in Isabelle/HOL. The purpose of this exercise is to write packages for domain-specific specifications such as class models, B-machines, ..., and generally speaking, any domain-specific languages whose abstract syntax can be defined by a HOL "datatype". On this basis, the Isabelle code-generator can then be used to generate code for global context transformations as well as tactic code. Consequently the package is geared towards parsing, printing and code-generation to the Isabelle API. It is at the moment not sufficiently rich for doing meta theory on Isabelle itself. Extensions in this direction are possible though. Moreover, the chosen fragment is fairly rudimentary. However it should be easily adapted to one's needs if a package is written on top of it. The supported API contains types, terms, transformation of global context like definitions and data-type declarations as well as infrastructure for Isar-setups. This theory is drawn from the <a href="http://isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a> project where it is used to construct a package for object-oriented data-type theories generated from UML class diagrams. The Featherweight OCL, for example, allows for both the direct execution of compiled tactic code by the Isabelle API as well as the generation of ".thy"-files for debugging purposes. Gained experience from this project shows that the compiled code is sufficiently efficient for practical purposes while being based on a formal model on which properties of the package can be proven such as termination of certain transformations, correctness, etc. notify = tuong@users.gforge.inria.fr, wolff@lri.fr [Clean] title = Clean - An Abstract Imperative Programming Language and its Theory author = Frédéric Tuong <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~wolff/> topic = Computer science/Programming languages, Computer science/Semantics date = 2019-10-04 notify = wolff@lri.fr, ftuong@lri.fr abstract = Clean is based on a simple, abstract execution model for an imperative target language. “Abstract” is understood in contrast to “Concrete Semantics”; alternatively, the term “shallow-style embedding” could be used. It strives for a type-safe notion of program-variables, an incremental construction of the typed state-space, support of incremental verification, and open-world extensibility of new type definitions being intertwined with the program definitions. Clean is based on a “no-frills” state-exception monad with the usual definitions of bind and unit for the compositional glue of state-based computations. Clean offers conditionals and loops supporting C-like control-flow operators such as break and return. The state-space construction is based on the extensible record package. Direct recursion of procedures is supported. Clean’s design strives for extreme simplicity. It is geared towards symbolic execution and proven correct verification tools. The underlying libraries of this package, however, deliberately restrict themselves to the most elementary infrastructure for these tasks. The package is intended to serve as demonstrator semantic backend for Isabelle/C, or for the test-generation techniques. [PCF] title = Logical Relations for PCF author = Peter Gammie <mailto:peteg42@gmail.com> date = 2012-07-01 topic = Computer science/Programming languages/Lambda calculi abstract = We apply Andy Pitts's methods of defining relations over domains to several classical results in the literature. We show that the Y combinator coincides with the domain-theoretic fixpoint operator, that parallel-or and the Plotkin existential are not definable in PCF, that the continuation semantics for PCF coincides with the direct semantics, and that our domain-theoretic semantics for PCF is adequate for reasoning about contextual equivalence in an operational semantics. Our version of PCF is untyped and has both strict and non-strict function abstractions. The development is carried out in HOLCF. notify = peteg42@gmail.com [POPLmark-deBruijn] title = POPLmark Challenge Via de Bruijn Indices author = Stefan Berghofer <http://www.in.tum.de/~berghofe> date = 2007-08-02 topic = Computer science/Programming languages/Lambda calculi abstract = We present a solution to the POPLmark challenge designed by Aydemir et al., which has as a goal the formalization of the meta-theory of System F<:. The formalization is carried out in the theorem prover Isabelle/HOL using an encoding based on de Bruijn indices. We start with a relatively simple formalization covering only the basic features of System F<:, and explain how it can be extended to also cover records and more advanced binding constructs. notify = berghofe@in.tum.de [Lam-ml-Normalization] title = Strong Normalization of Moggis's Computational Metalanguage author = Christian Doczkal <mailto:doczkal@ps.uni-saarland.de> date = 2010-08-29 topic = Computer science/Programming languages/Lambda calculi abstract = Handling variable binding is one of the main difficulties in formal proofs. In this context, Moggi's computational metalanguage serves as an interesting case study. It features monadic types and a commuting conversion rule that rearranges the binding structure. Lindley and Stark have given an elegant proof of strong normalization for this calculus. The key construction in their proof is a notion of relational TT-lifting, using stacks of elimination contexts to obtain a Girard-Tait style logical relation. I give a formalization of their proof in Isabelle/HOL-Nominal with a particular emphasis on the treatment of bound variables. notify = doczkal@ps.uni-saarland.de, nipkow@in.tum.de [MiniML] title = Mini ML author = Wolfgang Naraschewski <>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2004-03-19 topic = Computer science/Programming languages/Type systems abstract = This theory defines the type inference rules and the type inference algorithm W for MiniML (simply-typed lambda terms with <tt>let</tt>) due to Milner. It proves the soundness and completeness of W w.r.t. the rules. notify = kleing@cse.unsw.edu.au [Simpl] title = A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment author = Norbert Schirmer <> date = 2008-02-29 topic = Computer science/Programming languages/Language definitions, Computer science/Programming languages/Logics license = LGPL abstract = We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism. notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de [Separation_Algebra] title = Separation Algebra author = Gerwin Klein <mailto:kleing@cse.unsw.edu.au>, Rafal Kolanski <mailto:rafal.kolanski@nicta.com.au>, Andrew Boyton <mailto:andrew.boyton@nicta.com.au> date = 2012-05-11 topic = Computer science/Programming languages/Logics license = BSD abstract = We present a generic type class implementation of separation algebra for Isabelle/HOL as well as lemmas and generic tactics which can be used directly for any instantiation of the type class. The ex directory contains example instantiations that include structures such as a heap or virtual memory. The abstract separation algebra is based upon "Abstract Separation Logic" by Calcagno et al. These theories are also the basis of the ITP 2012 rough diamond "Mechanised Separation Algebra" by the authors. The aim of this work is to support and significantly reduce the effort for future separation logic developments in Isabelle/HOL by factoring out the part of separation logic that can be treated abstractly once and for all. This includes developing typical default rule sets for reasoning as well as automated tactic support for separation logic. notify = kleing@cse.unsw.edu.au, rafal.kolanski@nicta.com.au [Separation_Logic_Imperative_HOL] title = A Separation Logic Framework for Imperative HOL author = Peter Lammich <http://www21.in.tum.de/~lammich>, Rene Meis <mailto:rene.meis@uni-due.de> date = 2012-11-14 topic = Computer science/Programming languages/Logics license = BSD abstract = We provide a framework for separation-logic based correctness proofs of Imperative HOL programs. Our framework comes with a set of proof methods to automate canonical tasks such as verification condition generation and frame inference. Moreover, we provide a set of examples that show the applicability of our framework. The examples include algorithms on lists, hash-tables, and union-find trees. We also provide abstract interfaces for lists, maps, and sets, that allow to develop generic imperative algorithms and use data-refinement techniques. As we target Imperative HOL, our programs can be translated to efficiently executable code in various target languages, including ML, OCaml, Haskell, and Scala. notify = lammich@in.tum.de [Inductive_Confidentiality] title = Inductive Study of Confidentiality author = Giampaolo Bella <http://www.dmi.unict.it/~giamp/> date = 2012-05-02 topic = Computer science/Security abstract = This document contains the full theory files accompanying article Inductive Study of Confidentiality --- for Everyone in Formal Aspects of Computing. They aim at an illustrative and didactic presentation of the Inductive Method of protocol analysis, focusing on the treatment of one of the main goals of security protocols: confidentiality against a threat model. The treatment of confidentiality, which in fact forms a key aspect of all protocol analysis tools, has been found cryptic by many learners of the Inductive Method, hence the motivation for this work. The theory files in this document guide the reader step by step towards design and proof of significant confidentiality theorems. These are developed against two threat models, the standard Dolev-Yao and a more audacious one, the General Attacker, which turns out to be particularly useful also for teaching purposes. notify = giamp@dmi.unict.it [Possibilistic_Noninterference] title = Possibilistic Noninterference author = Andrei Popescu <https://www.andreipopescu.uk>, Johannes Hölzl <mailto:hoelzl@in.tum.de> date = 2012-09-10 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = We formalize a wide variety of Volpano/Smith-style noninterference notions for a while language with parallel composition. We systematize and classify these notions according to compositionality w.r.t. the language constructs. Compositionality yields sound syntactic criteria (a.k.a. type systems) in a uniform way. An <a href="http://www21.in.tum.de/~nipkow/pubs/cpp12.html">article</a> about these proofs is published in the proceedings of the conference Certified Programs and Proofs 2012. notify = hoelzl@in.tum.de [SIFUM_Type_Systems] title = A Formalization of Assumptions and Guarantees for Compositional Noninterference author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Daniel Schoepe <mailto:daniel@schoepe.org> date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private (high) sources to public (low) sinks. For a concurrent system, it is desirable to have compositional analysis methods that allow for analyzing each thread independently and that nevertheless guarantee that the parallel composition of successfully analyzed threads satisfies a global security guarantee. However, such a compositional analysis should not be overly pessimistic about what an environment might do with shared resources. Otherwise, the analysis will reject many intuitively secure programs. The paper "Assumptions and Guarantees for Compositional Noninterference" by Mantel et. al. presents one solution for this problem: an approach for compositionally reasoning about non-interference in concurrent programs via rely-guarantee-style reasoning. We present an Isabelle/HOL formalization of the concepts and proofs of this approach. notify = [Dependent_SIFUM_Type_Systems] title = A Dependent Security Type System for Concurrent Imperative Programs author = Toby Murray <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/> notify = toby.murray@unimelb.edu.au date = 2016-06-25 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a dependent security type system for compositionally verifying a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that security definition, the type system and its soundness proof, and demonstrates its application on some small examples. It was derived from the SIFUM_Type_Systems AFP entry, by Sylvia Grewe, Heiko Mantel and Daniel Schoepe, and whose structure it inherits. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameter and "stop_no_eval" assumption from the sifum_security locale. (revision dbc482d36372) [2016-09-27]: Added security locale support for the imposition of requirements on the initial memory. (revision cce4ceb74ddb) [Dependent_SIFUM_Refinement] title = Compositional Security-Preserving Refinement for Concurrent Imperative Programs author = Toby Murray <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/> notify = toby.murray@unimelb.edu.au date = 2016-06-28 topic = Computer science/Security abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a compositional theory of refinement for a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that refinement theory, and demonstrates its application on some small examples. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameters from the sifum_refinement locale. (revision dbc482d36372) [2016-09-02]: TobyM extended "simple" refinement theory to be usable for all bisimulations. (revision 547f31c25f60) [Relational-Incorrectness-Logic] title = An Under-Approximate Relational Logic author = Toby Murray <https://people.eng.unimelb.edu.au/tobym/> topic = Computer science/Programming languages/Logics, Computer science/Security date = 2020-03-12 notify = toby.murray@unimelb.edu.au abstract = Recently, authors have proposed under-approximate logics for reasoning about programs. So far, all such logics have been confined to reasoning about individual program behaviours. Yet there exist many over-approximate relational logics for reasoning about pairs of programs and relating their behaviours. We present the first under-approximate relational logic, for the simple imperative language IMP. We prove our logic is both sound and complete. Additionally, we show how reasoning in this logic can be decomposed into non-relational reasoning in an under-approximate Hoare logic, mirroring Beringer’s result for over-approximate relational logics. We illustrate the application of our logic on some small examples in which we provably demonstrate the presence of insecurity. [Strong_Security] title = A Formalization of Strong Security author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de> date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition. Strong security from Sabelfeld and Sands formalizes noninterference for concurrent systems. We present an Isabelle/HOL formalization of strong security for arbitrary security lattices (Sabelfeld and Sands use a two-element security lattice in the original publication). The formalization includes compositionality proofs for strong security and a soundness proof for a security type system that checks strong security for programs in a simple while language with dynamic thread creation. Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions. notify = [WHATandWHERE_Security] title = A Formalization of Declassification with WHAT-and-WHERE-Security author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de> date = 2014-04-23 topic = Computer science/Security, Computer science/Programming languages/Type systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition by requiring that no information whatsoever flows from private sources to public sinks. However, in practice this definition is often too strict: Depending on the intuitive desired security policy, the controlled declassification of certain private information (WHAT) at certain points in the program (WHERE) might not result in an undesired information leak. We present an Isabelle/HOL formalization of such a security property for controlled declassification, namely WHAT&WHERE-security from "Scheduler-Independent Declassification" by Lux, Mantel, and Perner. The formalization includes compositionality proofs for and a soundness proof for a security type system that checks for programs in a simple while language with dynamic thread creation. Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions. This Isabelle/HOL formalization uses theories from the entry Strong Security. notify = [VolpanoSmith] title = A Correctness Proof for the Volpano/Smith Security Typing System author = Gregor Snelting <http://pp.info.uni-karlsruhe.de/personhp/gregor_snelting.php>, Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2008-09-02 topic = Computer science/Programming languages/Type systems, Computer science/Security abstract = The Volpano/Smith/Irvine security type systems requires that variables are annotated as high (secret) or low (public), and provides typing rules which guarantee that secret values cannot leak to public output ports. This property of a program is called confidentiality. For a simple while-language without threads, our proof shows that typeability in the Volpano/Smith system guarantees noninterference. Noninterference means that if two initial states for program execution are low-equivalent, then the final states are low-equivalent as well. This indeed implies that secret values cannot leak to public ports. The proof defines an abstract syntax and operational semantics for programs, formalizes noninterference, and then proceeds by rule induction on the operational semantics. The mathematically most intricate part is the treatment of implicit flows. Note that the Volpano/Smith system is not flow-sensitive and thus quite unprecise, resulting in false alarms. However, due to the correctness property, all potential breaks of confidentiality are discovered. notify = [Abstract-Hoare-Logics] title = Abstract Hoare Logics author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2006-08-08 topic = Computer science/Programming languages/Logics abstract = These therories describe Hoare logics for a number of imperative language constructs, from while-loops to mutually recursive procedures. Both partial and total correctness are treated. In particular a proof system for total correctness of recursive procedures in the presence of unbounded nondeterminism is presented. notify = nipkow@in.tum.de [Stone_Algebras] title = Stone Algebras author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/> notify = walter.guttmann@canterbury.ac.nz date = 2016-09-06 topic = Mathematics/Order abstract = A range of algebras between lattices and Boolean algebras generalise the notion of a complement. We develop a hierarchy of these pseudo-complemented algebras that includes Stone algebras. Independently of this theory we study filters based on partial orders. Both theories are combined to prove Chen and Grätzer's construction theorem for Stone algebras. The latter involves extensive reasoning about algebraic structures in addition to reasoning in algebraic structures. [Kleene_Algebra] title = Kleene Algebra author = Alasdair Armstrong <>, Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>, Tjark Weber <http://user.it.uu.se/~tjawe125/> date = 2013-01-15 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = These files contain a formalisation of variants of Kleene algebras and their most important models as axiomatic type classes in Isabelle/HOL. Kleene algebras are foundational structures in computing with applications ranging from automata and language theory to computational modeling, program construction and verification. We start with formalising dioids, which are additively idempotent semirings, and expand them by axiomatisations of the Kleene star for finite iteration and an omega operation for infinite iteration. We show that powersets over a given monoid, (regular) languages, sets of paths in a graph, sets of computation traces, binary relations and formal power series form Kleene algebras, and consider further models based on lattices, max-plus semirings and min-plus semirings. We also demonstrate that dioids are closed under the formation of matrices (proofs for Kleene algebras remain to be completed). On the one hand we have aimed at a reference formalisation of variants of Kleene algebras that covers a wide range of variants and the core theorems in a structured and modular way and provides readable proofs at text book level. On the other hand, we intend to use this algebraic hierarchy and its models as a generic algebraic middle-layer from which programming applications can quickly be explored, implemented and verified. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [KAT_and_DRA] title = Kleene Algebra with Tests and Demonic Refinement Algebras author = Alasdair Armstrong <>, Victor B. F. Gomes <http://www.dcs.shef.ac.uk/~victor>, Georg Struth <http://www.dcs.shef.ac.uk/~georg> date = 2014-01-23 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = We formalise Kleene algebra with tests (KAT) and demonic refinement algebra (DRA) in Isabelle/HOL. KAT is relevant for program verification and correctness proofs in the partial correctness setting. While DRA targets similar applications in the context of total correctness. Our formalisation contains the two most important models of these algebras: binary relations in the case of KAT and predicate transformers in the case of DRA. In addition, we derive the inference rules for Hoare logic in KAT and its relational model and present a simple formally verified program verification tool prototype based on the algebraic approach. notify = g.struth@dcs.shef.ac.uk [KAD] title = Kleene Algebras with Domain author = Victor B. F. Gomes <http://www.dcs.shef.ac.uk/~victor>, Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>, Tjark Weber <http://user.it.uu.se/~tjawe125/> date = 2016-04-12 topic = Computer science/Programming languages/Logics, Computer science/Automata and formal languages, Mathematics/Algebra abstract = Kleene algebras with domain are Kleene algebras endowed with an operation that maps each element of the algebra to its domain of definition (or its complement) in abstract fashion. They form a simple algebraic basis for Hoare logics, dynamic logics or predicate transformer semantics. We formalise a modular hierarchy of algebras with domain and antidomain (domain complement) operations in Isabelle/HOL that ranges from domain and antidomain semigroups to modal Kleene algebras and divergence Kleene algebras. We link these algebras with models of binary relations and program traces. We include some examples from modal logics, termination and program analysis. notify = walter.guttman@canterbury.ac.nz, g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [Regular_Algebras] title = Regular Algebras author = Simon Foster <http://www-users.cs.york.ac.uk/~simonf>, Georg Struth <http://www.dcs.shef.ac.uk/~georg> date = 2014-05-21 topic = Computer science/Automata and formal languages, Mathematics/Algebra abstract = Regular algebras axiomatise the equational theory of regular expressions as induced by regular language identity. We use Isabelle/HOL for a detailed systematic study of regular algebras given by Boffa, Conway, Kozen and Salomaa. We investigate the relationships between these classes, formalise a soundness proof for the smallest class (Salomaa's) and obtain completeness of the largest one (Boffa's) relative to a deep result by Krob. In addition we provide a large collection of regular identities in the general setting of Boffa's axiom. Our regular algebra hierarchy is orthogonal to the Kleene algebra hierarchy in the Archive of Formal Proofs; we have not aimed at an integration for pragmatic reasons. notify = simon.foster@york.ac.uk, g.struth@sheffield.ac.uk [BytecodeLogicJmlTypes] title = A Bytecode Logic for JML and Types author = Lennart Beringer <>, Martin Hofmann <http://www.tcs.informatik.uni-muenchen.de/~mhofmann> date = 2008-12-12 topic = Computer science/Programming languages/Logics abstract = This document contains the Isabelle/HOL sources underlying the paper A bytecode logic for JML and types by Beringer and Hofmann, updated to Isabelle 2008. We present a program logic for a subset of sequential Java bytecode that is suitable for representing both, features found in high-level specification language JML as well as interpretations of high-level type systems. To this end, we introduce a fine-grained collection of assertions, including strong invariants, local annotations and VDM-reminiscent partial-correctness specifications. Thanks to a goal-oriented structure and interpretation of judgements, verification may proceed without recourse to an additional control flow analysis. The suitability for interpreting intensional type systems is illustrated by the proof-carrying-code style encoding of a type system for a first-order functional language which guarantees a constant upper bound on the number of objects allocated throughout an execution, be the execution terminating or non-terminating. Like the published paper, the formal development is restricted to a comparatively small subset of the JVML, lacking (among other features) exceptions, arrays, virtual methods, and static fields. This shortcoming has been overcome meanwhile, as our paper has formed the basis of the Mobius base logic, a program logic for the full sequential fragment of the JVML. Indeed, the present formalisation formed the basis of a subsequent formalisation of the Mobius base logic in the proof assistant Coq, which includes a proof of soundness with respect to the Bicolano operational semantics by Pichardie. notify = [DataRefinementIBP] title = Semantics and Data Refinement of Invariant Based Programs author = Viorel Preoteasa <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/Ralph-Johan.Back/> date = 2010-05-28 topic = Computer science/Programming languages/Logics abstract = The invariant based programming is a technique of constructing correct programs by first identifying the basic situations (pre- and post-conditions and invariants) that can occur during the execution of the program, and then defining the transitions and proving that they preserve the invariants. Data refinement is a technique of building correct programs working on concrete datatypes as refinements of more abstract programs. In the theories presented here we formalize the predicate transformer semantics for invariant based programs and their data refinement. extra-history = Change history: [2012-01-05]: Moved some general complete lattice properties to the AFP entry Lattice Properties. Changed the definition of the data refinement relation to be more general and updated all corresponding theorems. Added new syntax for demonic and angelic update statements. notify = viorel.preoteasa@aalto.fi [RefinementReactive] title = Formalization of Refinement Calculus for Reactive Systems author = Viorel Preoteasa <mailto:viorel.preoteasa@aalto.fi> date = 2014-10-08 topic = Computer science/Programming languages/Logics abstract = We present a formalization of refinement calculus for reactive systems. Refinement calculus is based on monotonic predicate transformers (monotonic functions from sets of post-states to sets of pre-states), and it is a powerful formalism for reasoning about imperative programs. We model reactive systems as monotonic property transformers that transform sets of output infinite sequences into sets of input infinite sequences. Within this semantics we can model refinement of reactive systems, (unbounded) angelic and demonic nondeterminism, sequential composition, and other semantic properties. We can model systems that may fail for some inputs, and we can model compatibility of systems. We can specify systems that have liveness properties using linear temporal logic, and we can refine system specifications into systems based on symbolic transitions systems, suitable for implementations. notify = viorel.preoteasa@aalto.fi [SIFPL] title = Secure information flow and program logics author = Lennart Beringer <>, Martin Hofmann <http://www.tcs.informatik.uni-muenchen.de/~mhofmann> date = 2008-11-10 topic = Computer science/Programming languages/Logics, Computer science/Security abstract = We present interpretations of type systems for secure information flow in Hoare logic, complementing previous encodings in relational program logics. We first treat the imperative language IMP, extended by a simple procedure call mechanism. For this language we consider base-line non-interference in the style of Volpano et al. and the flow-sensitive type system by Hunt and Sands. In both cases, we show how typing derivations may be used to automatically generate proofs in the program logic that certify the absence of illicit flows. We then add instructions for object creation and manipulation, and derive appropriate proof rules for base-line non-interference. As a consequence of our work, standard verification technology may be used for verifying that a concrete program satisfies the non-interference property. The present proof development represents an update of the formalisation underlying our paper [CSF 2007] and is intended to resolve any ambiguities that may be present in the paper. notify = lennart.beringer@ifi.lmu.de [TLA] title = A Definitional Encoding of TLA* in Isabelle/HOL author = Gudmund Grov <http://homepages.inf.ed.ac.uk/ggrov>, Stephan Merz <http://www.loria.fr/~merz> date = 2011-11-19 topic = Computer science/Programming languages/Logics abstract = We mechanise the logic TLA* <a href="http://www.springerlink.com/content/ax3qk557qkdyt7n6/">[Merz 1999]</a>, an extension of Lamport's Temporal Logic of Actions (TLA) <a href="http://dl.acm.org/citation.cfm?doid=177492.177726">[Lamport 1994]</a> for specifying and reasoning about concurrent and reactive systems. Aiming at a framework for mechanising] the verification of TLA (or TLA*) specifications, this contribution reuses some elements from a previous axiomatic encoding of TLA in Isabelle/HOL by the second author [Merz 1998], which has been part of the Isabelle distribution. In contrast to that previous work, we give here a shallow, definitional embedding, with the following highlights: <ul> <li>a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*; <li>a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas; <li>a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification; <li>a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems. </ul> Note that this work is unrelated to the ongoing development of a proof system for the specification language TLA+, which includes an encoding of TLA+ as a new Isabelle object logic <a href="http://www.springerlink.com/content/354026160p14j175/">[Chaudhuri et al 2010]</a>. notify = ggrov@inf.ed.ac.uk [Compiling-Exceptions-Correctly] title = Compiling Exceptions Correctly author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2004-07-09 topic = Computer science/Programming languages/Compiling abstract = An exception compilation scheme that dynamically creates and removes exception handler entries on the stack. A formalization of an article of the same name by <a href="http://www.cs.nott.ac.uk/~gmh/">Hutton</a> and Wright. notify = nipkow@in.tum.de [NormByEval] title = Normalization by Evaluation author = Klaus Aehlig <http://www.linta.de/~aehlig/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2008-02-18 topic = Computer science/Programming languages/Compiling abstract = This article formalizes normalization by evaluation as implemented in Isabelle. Lambda calculus plus term rewriting is compiled into a functional program with pattern matching. It is proved that the result of a successful evaluation is a) correct, i.e. equivalent to the input, and b) in normal form. notify = nipkow@in.tum.de [Program-Conflict-Analysis] title = Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors topic = Computer science/Programming languages/Static analysis author = Peter Lammich <http://www21.in.tum.de/~lammich>, Markus Müller-Olm <http://cs.uni-muenster.de/u/mmo/> date = 2007-12-14 abstract = In this work we formally verify the soundness and precision of a static program analysis that detects conflicts (e. g. data races) in programs with procedures, thread creation and monitors with the Isabelle theorem prover. As common in static program analysis, our program model abstracts guarded branching by nondeterministic branching, but completely interprets the call-/return behavior of procedures, synchronization by monitors, and thread creation. The analysis is based on the observation that all conflicts already occur in a class of particularly restricted schedules. These restricted schedules are suited to constraint-system-based program analysis. The formalization is based upon a flowgraph-based program model with an operational semantics as reference point. notify = peter.lammich@uni-muenster.de [Shivers-CFA] title = Shivers' Control Flow Analysis topic = Computer science/Programming languages/Static analysis author = Joachim Breitner <mailto:mail@joachim-breitner.de> date = 2010-11-16 abstract = In his dissertation, Olin Shivers introduces a concept of control flow graphs for functional languages, provides an algorithm to statically derive a safe approximation of the control flow graph and proves this algorithm correct. In this research project, Shivers' algorithms and proofs are formalized in the HOLCF extension of HOL. notify = mail@joachim-breitner.de, nipkow@in.tum.de [Slicing] title = Towards Certified Slicing author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2008-09-16 topic = Computer science/Programming languages/Static analysis abstract = Slicing is a widely-used technique with applications in e.g. compiler technology and software security. Thus verification of algorithms in these areas is often based on the correctness of slicing, which should ideally be proven independent of concrete programming languages and with the help of well-known verifying techniques such as proof assistants. As a first step in this direction, this contribution presents a framework for dynamic and static intraprocedural slicing based on control flow and program dependence graphs. Abstracting from concrete syntax we base the framework on a graph representation of the program fulfilling certain structural and well-formedness properties. The formalization consists of the basic framework (in subdirectory Basic/), the correctness proof for dynamic slicing (in subdirectory Dynamic/), the correctness proof for static intraprocedural slicing (in subdirectory StaticIntra/) and instantiations of the framework with a simple While language (in subdirectory While/) and the sophisticated object-oriented bytecode language of Jinja (in subdirectory JinjaVM/). For more information on the framework, see the TPHOLS 2008 paper by Wasserrab and Lochbihler and the PLAS 2009 paper by Wasserrab et al. notify = [HRB-Slicing] title = Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2009-11-13 topic = Computer science/Programming languages/Static analysis abstract = After verifying <a href="Slicing.html">dynamic and static interprocedural slicing</a>, we present a modular framework for static interprocedural slicing. To this end, we formalized the standard two-phase slicer from Horwitz, Reps and Binkley (see their TOPLAS 12(1) 1990 paper) together with summary edges as presented by Reps et al. (see FSE 1994). The framework is again modular in the programming language by using an abstract CFG, defined via structural and well-formedness properties. Using a weak simulation between the original and sliced graph, we were able to prove the correctness of static interprocedural slicing. We also instantiate our framework with a simple While language with procedures. This shows that the chosen abstractions are indeed valid. notify = nipkow@in.tum.de [WorkerWrapper] title = The Worker/Wrapper Transformation author = Peter Gammie <http://peteg.org> date = 2009-10-30 topic = Computer science/Programming languages/Transformations abstract = Gill and Hutton formalise the worker/wrapper transformation, building on the work of Launchbury and Peyton-Jones who developed it as a way of changing the type at which a recursive function operates. This development establishes the soundness of the technique and several examples of its use. notify = peteg42@gmail.com, nipkow@in.tum.de [JiveDataStoreModel] title = Jive Data and Store Model author = Nicole Rauch <mailto:rauch@informatik.uni-kl.de>, Norbert Schirmer <> date = 2005-06-20 license = LGPL topic = Computer science/Programming languages/Misc abstract = This document presents the formalization of an object-oriented data and store model in Isabelle/HOL. This model is being used in the Java Interactive Verification Environment, Jive. notify = kleing@cse.unsw.edu.au, schirmer@in.tum.de [HotelKeyCards] title = Hotel Key Card System author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2006-09-09 topic = Computer science/Security abstract = Two models of an electronic hotel key card system are contrasted: a state based and a trace based one. Both are defined, verified, and proved equivalent in the theorem prover Isabelle/HOL. It is shown that if a guest follows a certain safety policy regarding her key cards, she can be sure that nobody but her can enter her room. notify = nipkow@in.tum.de [RSAPSS] title = SHA1, RSA, PSS and more author = Christina Lindenberg <>, Kai Wirt <> date = 2005-05-02 topic = Computer science/Security/Cryptography abstract = Formal verification is getting more and more important in computer science. However the state of the art formal verification methods in cryptography are very rudimentary. These theories are one step to provide a tool box allowing the use of formal methods in every aspect of cryptography. Moreover we present a proof of concept for the feasibility of verification techniques to a standard signature algorithm. notify = nipkow@in.tum.de [InformationFlowSlicing] title = Information Flow Noninterference via Slicing author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2010-03-23 topic = Computer science/Security abstract = In this contribution, we show how correctness proofs for <a href="Slicing.html">intra-</a> and <a href="HRB-Slicing.html">interprocedural slicing</a> can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al. This entry contains the part for intra-procedural slicing. See entry <a href="InformationFlowSlicing_Inter.html">InformationFlowSlicing_Inter</a> for the inter-procedural part. extra-history = Change history: [2016-06-10]: The original entry <a href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a href="InformationFlowSlicing.html">intra-procedural</a> case was split into two for easier maintenance. notify = [InformationFlowSlicing_Inter] title = Inter-Procedural Information Flow Noninterference via Slicing author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php> date = 2010-03-23 topic = Computer science/Security abstract = In this contribution, we show how correctness proofs for <a href="Slicing.html">intra-</a> and <a href="HRB-Slicing.html">interprocedural slicing</a> can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al. This entry contains the part for inter-procedural slicing. See entry <a href="InformationFlowSlicing.html">InformationFlowSlicing</a> for the intra-procedural part. extra-history = Change history: [2016-06-10]: The original entry <a href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a href="InformationFlowSlicing.html">intra-procedural</a> case was split into two for easier maintenance. notify = [ComponentDependencies] title = Formalisation and Analysis of Component Dependencies author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au> date = 2014-04-28 topic = Computer science/System description languages abstract = This set of theories presents a formalisation in Isabelle/HOL of data dependencies between components. The approach allows to analyse system structure oriented towards efficient checking of system: it aims at elaborating for a concrete system, which parts of the system are necessary to check a given property. notify = maria.spichkova@rmit.edu.au [Verified-Prover] title = A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic author = Tom Ridge <> date = 2004-09-28 topic = Logic/General logic/Mechanization of proofs abstract = Soundness and completeness for a system of first order logic are formally proved, building on James Margetson's formalization of work by Wainer and Wallen. The completeness proofs naturally suggest an algorithm to derive proofs. This algorithm, which can be implemented tail recursively, is formalized in Isabelle/HOL. The algorithm can be executed via the rewriting tactics of Isabelle. Alternatively, the definitions can be exported to OCaml, yielding a directly executable program. notify = lp15@cam.ac.uk [Completeness] title = Completeness theorem author = James Margetson <>, Tom Ridge <> date = 2004-09-20 topic = Logic/Proof theory abstract = The completeness of first-order logic is proved, following the first five pages of Wainer and Wallen's chapter of the book Proof Theory by Aczel et al., CUP, 1992. Their presentation of formulas allows the proofs to use symmetry arguments. Margetson formalized this theorem by early 2000. The Isar conversion is thanks to Tom Ridge. A paper describing the formalization is available <a href="Completeness-paper.pdf">[pdf]</a>. notify = lp15@cam.ac.uk [Ordinal] title = Countable Ordinals author = Brian Huffman <http://web.cecs.pdx.edu/~brianh/> date = 2005-11-11 topic = Logic/Set theory abstract = This development defines a well-ordered type of countable ordinals. It includes notions of continuous and normal functions, recursively defined functions over ordinals, least fixed-points, and derivatives. Much of ordinal arithmetic is formalized, including exponentials and logarithms. The development concludes with formalizations of Cantor Normal Form and Veblen hierarchies over normal functions. notify = lcp@cl.cam.ac.uk [Ordinals_and_Cardinals] title = Ordinals and Cardinals author = Andrei Popescu <https://www.andreipopescu.uk> date = 2009-09-01 topic = Logic/Set theory abstract = We develop a basic theory of ordinals and cardinals in Isabelle/HOL, up to the point where some cardinality facts relevant for the ``working mathematician" become available. Unlike in set theory, here we do not have at hand canonical notions of ordinal and cardinal. Therefore, here an ordinal is merely a well-order relation and a cardinal is an ordinal minim w.r.t. order embedding on its field. extra-history = Change history: [2012-09-25]: This entry has been discontinued because it is now part of the Isabelle distribution. notify = uuomul@yahoo.com, nipkow@in.tum.de [FOL-Fitting] title = First-Order Logic According to Fitting author = Stefan Berghofer <http://www.in.tum.de/~berghofe> contributors = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> date = 2007-08-02 topic = Logic/General logic/Classical first-order logic abstract = We present a formalization of parts of Melvin Fitting's book "First-Order Logic and Automated Theorem Proving". The formalization covers the syntax of first-order logic, its semantics, the model existence theorem, a natural deduction proof calculus together with a proof of correctness and completeness, as well as the Löwenheim-Skolem theorem. extra-history = Change history: [2018-07-21]: Proved completeness theorem for open formulas. Proofs are now written in the declarative style. Enumeration of pairs and datatypes is automated using the Countable theory. notify = berghofe@in.tum.de [Epistemic_Logic] title = Epistemic Logic: Completeness of Modal Logics author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> topic = Logic/General logic/Logics of knowledge and belief date = 2018-10-29 notify = ahfrom@dtu.dk abstract = This work is a formalization of epistemic logic with countably many agents. It includes proofs of soundness and completeness for the axiom system K. The completeness proof is based on the textbook "Reasoning About Knowledge" by Fagin, Halpern, Moses and Vardi (MIT Press 1995). The extensions of system K (T, KB, K4, S4, S5) and their completeness proofs are based on the textbook "Modal Logic" by Blackburn, de Rijke and Venema (Cambridge University Press 2001). Papers: <a href="https://doi.org/10.1007/978-3-030-88853-4_1">https://doi.org/10.1007/978-3-030-88853-4_1</a>, <a href="https://doi.org/10.1007/978-3-030-90138-7_2">https://doi.org/10.1007/978-3-030-90138-7_2</a>. extra-history = Change history: [2021-04-15]: Added completeness of modal logics T, KB, K4, S4 and S5. [SequentInvertibility] title = Invertibility in Sequent Calculi author = Peter Chapman <> date = 2009-08-28 topic = Logic/Proof theory license = LGPL abstract = The invertibility of the rules of a sequent calculus is important for guiding proof search and can be used in some formalised proofs of Cut admissibility. We present sufficient conditions for when a rule is invertible with respect to a calculus. We illustrate the conditions with examples. It must be noted we give purely syntactic criteria; no guarantees are given as to the suitability of the rules. notify = pc@cs.st-andrews.ac.uk, nipkow@in.tum.de [LinearQuantifierElim] title = Quantifier Elimination for Linear Arithmetic author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2008-01-11 topic = Logic/General logic/Decidability of theories abstract = This article formalizes quantifier elimination procedures for dense linear orders, linear real arithmetic and Presburger arithmetic. In each case both a DNF-based non-elementary algorithm and one or more (doubly) exponential NNF-based algorithms are formalized, including the well-known algorithms by Ferrante and Rackoff and by Cooper. The NNF-based algorithms for dense linear orders are new but based on Ferrante and Rackoff and on an algorithm by Loos and Weisspfenning which simulates infenitesimals. All algorithms are directly executable. In particular, they yield reflective quantifier elimination procedures for HOL itself. The formalization makes heavy use of locales and is therefore highly modular. notify = nipkow@in.tum.de [Nat-Interval-Logic] title = Interval Temporal Logic on Natural Numbers author = David Trachtenherz <> date = 2011-02-23 topic = Logic/General logic/Temporal logic abstract = We introduce a theory of temporal logic operators using sets of natural numbers as time domain, formalized in a shallow embedding manner. The theory comprises special natural intervals (theory IL_Interval: open and closed intervals, continuous and modulo intervals, interval traversing results), operators for shifting intervals to left/right on the number axis as well as expanding/contracting intervals by constant factors (theory IL_IntervalOperators.thy), and ultimately definitions and results for unary and binary temporal operators on arbitrary natural sets (theory IL_TemporalOperators). notify = nipkow@in.tum.de [Recursion-Theory-I] title = Recursion Theory I author = Michael Nedzelsky <> date = 2008-04-05 topic = Logic/Computability abstract = This document presents the formalization of introductory material from recursion theory --- definitions and basic properties of primitive recursive functions, Cantor pairing function and computably enumerable sets (including a proof of existence of a one-complete computably enumerable set and a proof of the Rice's theorem). notify = MichaelNedzelsky@yandex.ru [Free-Boolean-Algebra] topic = Logic/General logic/Classical propositional logic title = Free Boolean Algebra author = Brian Huffman <http://web.cecs.pdx.edu/~brianh/> date = 2010-03-29 abstract = This theory defines a type constructor representing the free Boolean algebra over a set of generators. Values of type (α)formula represent propositional formulas with uninterpreted variables from type α, ordered by implication. In addition to all the standard Boolean algebra operations, the library also provides a function for building homomorphisms to any other Boolean algebra type. notify = brianh@cs.pdx.edu [Sort_Encodings] title = Sound and Complete Sort Encodings for First-Order Logic author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk> date = 2013-06-27 topic = Logic/General logic/Mechanization of proofs abstract = This is a formalization of the soundness and completeness properties for various efficient encodings of sorts in unsorted first-order logic used by Isabelle's Sledgehammer tool. Essentially, the encodings proceed as follows: a many-sorted problem is decorated with (as few as possible) tags or guards that make the problem monotonic; then sorts can be soundly erased. The development employs a formalization of many-sorted first-order logic in clausal form (clauses, structures and the basic properties of the satisfaction relation), which could be of interest as the starting point for other formalizations of first-order logic metatheory. notify = uuomul@yahoo.com [Lambda_Free_RPOs] title = Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de> date = 2016-09-23 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines recursive path orders (RPOs) for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard RPO on first-order terms also in the presence of currying, distinguishing it from previous work. An optimized variant is formalized as well. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_KBOs] title = Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms author = Heiko Becker <mailto:hbecker@mpi-sws.org>, Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de> date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines Knuth–Bendix orders for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard transfinite KBO with subterm coefficients on first-order terms. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_EPO] title = Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms author = Alexander Bentkamp <https://www.cs.vu.nl/~abp290/> topic = Logic/Rewriting date = 2018-10-19 notify = a.bentkamp@vu.nl abstract = This Isabelle/HOL formalization defines the Embedding Path Order (EPO) for higher-order terms without lambda-abstraction and proves many useful properties about it. In contrast to the lambda-free recursive path orders, it does not fully coincide with RPO on first-order terms, but it is compatible with arbitrary higher-order contexts. [Nested_Multisets_Ordinals] title = Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Mathias Fleury <mailto:fleury@mpi-inf.mpg.de>, Dmitriy Traytel <https://traytel.bitbucket.io> date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization introduces a nested multiset datatype and defines Dershowitz and Manna's nested multiset order. The order is proved well founded and linear. By removing one constructor, we transform the nested multisets into hereditary multisets. These are isomorphic to the syntactic ordinals—the ordinals can be recursively expressed in Cantor normal form. Addition, subtraction, multiplication, and linear orders are provided on this type. notify = jasmin.blanchette@gmail.com [Abstract-Rewriting] title = Abstract Rewriting topic = Logic/Rewriting date = 2010-06-14 author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann> license = LGPL abstract = We present an Isabelle formalization of abstract rewriting (see, e.g., the book by Baader and Nipkow). First, we define standard relations like joinability, meetability, conversion, etc. Then, we formalize important properties of abstract rewrite systems, e.g., confluence and strong normalization. Our main concern is on strong normalization, since this formalization is the basis of <a href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> (which is mainly about strong normalization of term rewrite systems). Hence lemmas involving strong normalization constitute by far the biggest part of this theory. One of those is Newman's lemma. extra-history = Change history: [2010-09-17]: Added theories defining several (ordered) semirings related to strong normalization and giving some standard instances. [2013-10-16]: Generalized delta-orders from rationals to Archimedean fields. notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [First_Order_Terms] title = First-Order Terms author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/> topic = Logic/Rewriting, Computer science/Algorithms license = LGPL date = 2018-02-06 notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at abstract = We formalize basic results on first-order terms, including matching and a first-order unification algorithm, as well as well-foundedness of the subsumption order. This entry is part of the Isabelle Formalization of Rewriting <a href="http://cl-informatik.uibk.ac.at/isafor">IsaFoR</a>, where first-order terms are omni-present: the unification algorithm is used to certify several confluence and termination techniques, like critical-pair computation and dependency graph approximations; and the subsumption order is a crucial ingredient for completion. [Free-Groups] title = Free Groups author = Joachim Breitner <mailto:mail@joachim-breitner.de> date = 2010-06-24 topic = Mathematics/Algebra abstract = Free Groups are, in a sense, the most generic kind of group. They are defined over a set of generators with no additional relations in between them. They play an important role in the definition of group presentations and in other fields. This theory provides the definition of Free Group as the set of fully canceled words in the generators. The universal property is proven, as well as some isomorphisms results about Free Groups. extra-history = Change history: [2011-12-11]: Added the Ping Pong Lemma. notify = [CofGroups] title = An Example of a Cofinitary Group in Isabelle/HOL author = Bart Kastermans <http://kasterma.net> date = 2009-08-04 topic = Mathematics/Algebra abstract = We formalize the usual proof that the group generated by the function k -> k + 1 on the integers gives rise to a cofinitary group. notify = nipkow@in.tum.de [Finitely_Generated_Abelian_Groups] title = Finitely Generated Abelian Groups author = Joseph Thommes<>, Manuel Eberl <https://pruvisto.org> topic = Mathematics/Algebra date = 2021-07-07 notify = joseph-thommes@gmx.de, manuel@pruvisto.org abstract = This article deals with the formalisation of some group-theoretic results including the fundamental theorem of finitely generated abelian groups characterising the structure of these groups as a uniquely determined product of cyclic groups. Both the invariant factor decomposition and the primary decomposition are covered. Additional work includes results about the direct product, the internal direct product and more group-theoretic lemmas. [Group-Ring-Module] title = Groups, Rings and Modules author = Hidetsune Kobayashi <>, L. Chen <>, H. Murao <> date = 2004-05-18 topic = Mathematics/Algebra abstract = The theory of groups, rings and modules is developed to a great depth. Group theory results include Zassenhaus's theorem and the Jordan-Hoelder theorem. The ring theory development includes ideals, quotient rings and the Chinese remainder theorem. The module development includes the Nakayama lemma, exact sequences and Tensor products. notify = lp15@cam.ac.uk [Robbins-Conjecture] title = A Complete Proof of the Robbins Conjecture author = Matthew Wampler-Doty <> date = 2010-05-22 topic = Mathematics/Algebra abstract = This document gives a formalization of the proof of the Robbins conjecture, following A. Mann, A Complete Proof of the Robbins Conjecture, 2003. notify = nipkow@in.tum.de [Valuation] title = Fundamental Properties of Valuation Theory and Hensel's Lemma author = Hidetsune Kobayashi <> date = 2007-08-08 topic = Mathematics/Algebra abstract = Convergence with respect to a valuation is discussed as convergence of a Cauchy sequence. Cauchy sequences of polynomials are defined. They are used to formalize Hensel's lemma. notify = lp15@cam.ac.uk [Rank_Nullity_Theorem] title = Rank-Nullity Theorem in Linear Algebra author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa> topic = Mathematics/Algebra date = 2013-01-16 abstract = In this contribution, we present some formalizations based on the HOL-Multivariate-Analysis session of Isabelle. Firstly, a generalization of several theorems of such library are presented. Secondly, some definitions and proofs involving Linear Algebra and the four fundamental subspaces of a matrix are shown. Finally, we present a proof of the result known in Linear Algebra as the ``Rank-Nullity Theorem'', which states that, given any linear map f from a finite dimensional vector space V to a vector space W, then the dimension of V is equal to the dimension of the kernel of f (which is a subspace of V) and the dimension of the range of f (which is a subspace of W). The proof presented here is based on the one given by Sheldon Axler in his book Linear Algebra Done Right. As a corollary of the previous theorem, and taking advantage of the relationship between linear maps and matrices, we prove that, for every matrix A (which has associated a linear map between finite dimensional vector spaces), the sum of its null space and its column space (which is equal to the range of the linear map) is equal to the number of columns of A. extra-history = Change history: [2014-07-14]: Added some generalizations that allow us to formalize the Rank-Nullity Theorem over finite dimensional vector spaces, instead of over the more particular euclidean spaces. Updated abstract. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Affine_Arithmetic] title = Affine Arithmetic author = Fabian Immler <http://www21.in.tum.de/~immler> date = 2014-02-07 topic = Mathematics/Analysis abstract = We give a formalization of affine forms as abstract representations of zonotopes. We provide affine operations as well as overapproximations of some non-affine operations like multiplication and division. Expressions involving those operations can automatically be turned into (executable) functions approximating the original expression in affine arithmetic. extra-history = Change history: [2015-01-31]: added algorithm for zonotope/hyperplane intersection [2017-09-20]: linear approximations for all symbols from the floatarith data type notify = immler@in.tum.de [Laplace_Transform] title = Laplace Transform author = Fabian Immler <https://home.in.tum.de/~immler/> topic = Mathematics/Analysis date = 2019-08-14 notify = fimmler@cs.cmu.edu abstract = This entry formalizes the Laplace transform and concrete Laplace transforms for arithmetic functions, frequency shift, integration and (higher) differentiation in the time domain. It proves Lerch's lemma and uniqueness of the Laplace transform for continuous functions. In order to formalize the foundational assumptions, this entry contains a formalization of piecewise continuous functions and functions of exponential order. [Cauchy] title = Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality author = Benjamin Porter <> date = 2006-03-14 topic = Mathematics/Analysis abstract = This document presents the mechanised proofs of two popular theorems attributed to Augustin Louis Cauchy - Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality. notify = kleing@cse.unsw.edu.au [Integration] title = Integration theory and random variables author = Stefan Richter <http://www-lti.informatik.rwth-aachen.de/~richter/> date = 2004-11-19 topic = Mathematics/Analysis abstract = Lebesgue-style integration plays a major role in advanced probability. We formalize concepts of elementary measure theory, real-valued random variables as Borel-measurable functions, and a stepwise inductive definition of the integral itself. All proofs are carried out in human readable style using the Isar language. extra-note = Note: This article is of historical interest only. Lebesgue-style integration and probability theory are now available as part of the Isabelle/HOL distribution (directory Probability). notify = richter@informatik.rwth-aachen.de, nipkow@in.tum.de, hoelzl@in.tum.de [Ordinary_Differential_Equations] title = Ordinary Differential Equations author = Fabian Immler <http://www21.in.tum.de/~immler>, Johannes Hölzl <http://in.tum.de/~hoelzl> topic = Mathematics/Analysis date = 2012-04-26 abstract = Session Ordinary-Differential-Equations formalizes ordinary differential equations (ODEs) and initial value problems. This work comprises proofs for local and global existence of unique solutions (Picard-Lindelöf theorem). Moreover, it contains a formalization of the (continuous or even differentiable) dependency of the flow on initial conditions as the flow of ODEs. Not in the generated document are the following sessions: <ul> <li> HOL-ODE-Numerics: Rigorous numerical algorithms for computing enclosures of solutions based on Runge-Kutta methods and affine arithmetic. Reachability analysis with splitting and reduction at hyperplanes.</li> <li> HOL-ODE-Examples: Applications of the numerical algorithms to concrete systems of ODEs.</li> <li> Lorenz_C0, Lorenz_C1: Verified algorithms for checking C1-information according to Tucker's proof, computation of C0-information.</li> </ul> extra-history = Change history: [2014-02-13]: added an implementation of the Euler method based on affine arithmetic [2016-04-14]: added flow and variational equation [2016-08-03]: numerical algorithms for reachability analysis (using second-order Runge-Kutta methods, splitting, and reduction) implemented using Lammich's framework for automatic refinement [2017-09-20]: added Poincare map and propagation of variational equation in reachability analysis, verified algorithms for C1-information and computations for C0-information of the Lorenz attractor. notify = immler@in.tum.de, hoelzl@in.tum.de [Polynomials] title = Executable Multivariate Polynomials author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>, Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>, Fabian Immler <http://www21.in.tum.de/~immler>, Florian Haftmann <http://isabelle.in.tum.de/~haftmann>, Andreas Lochbihler <http://www.andreas-lochbihler.de>, Alexander Bentkamp <mailto:bentkamp@gmail.com> date = 2010-08-10 topic = Mathematics/Analysis, Mathematics/Algebra, Computer science/Algorithms/Mathematical license = LGPL abstract = We define multivariate polynomials over arbitrary (ordered) semirings in combination with (executable) operations like addition, multiplication, and substitution. We also define (weak) monotonicity of polynomials and comparison of polynomials where we provide standard estimations like absolute positiveness or the more recent approach of Neurauter, Zankl, and Middeldorp. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over polynomials. Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA-system</a> which contains several termination techniques. The provided theories have been essential to formalize polynomial interpretations. This formalization also contains an abstract representation as coefficient functions with finite support and a type of power-products. If this type is ordered by a linear (term) ordering, various additional notions, such as leading power-product, leading coefficient etc., are introduced as well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y]. extra-history = Change history: [2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting. [2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler. [2018-01-23]: Added authors Haftmann, Lochbihler after incorporating their formalization of multivariate polynomials based on Polynomial mappings. Moved material from Bentkamp's entry "Deep Learning". [2019-04-18]: Added material about polynomials whose power-products are represented themselves by polynomial mappings. notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at, alexander.maletzky@risc.jku.at, immler@in.tum.de [Sqrt_Babylonian] title = Computing N-th Roots using the Babylonian Method author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2013-01-03 topic = Mathematics/Analysis license = LGPL abstract = We implement the Babylonian method to compute n-th roots of numbers. We provide precise algorithms for naturals, integers and rationals, and offer an approximation algorithm for square roots over linear ordered fields. Moreover, there are precise algorithms to compute the floor and the ceiling of n-th roots. extra-history = Change history: [2013-10-16]: Added algorithms to compute floor and ceiling of sqrt of integers. [2014-07-11]: Moved NthRoot_Impl from Real-Impl to this entry. notify = rene.thiemann@uibk.ac.at [Sturm_Sequences] title = Sturm's Theorem author = Manuel Eberl <https://pruvisto.org> date = 2014-01-11 topic = Mathematics/Analysis abstract = Sturm's Theorem states that polynomial sequences with certain properties, so-called Sturm sequences, can be used to count the number of real roots of a real polynomial. This work contains a proof of Sturm's Theorem and code for constructing Sturm sequences efficiently. It also provides the “sturm” proof method, which can decide certain statements about the roots of real polynomials, such as “the polynomial P has exactly n roots in the interval I” or “P(x) > Q(x) for all x ∈ ℝ”. notify = manuel@pruvisto.org [Sturm_Tarski] title = The Sturm-Tarski Theorem author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/> date = 2014-09-19 topic = Mathematics/Analysis abstract = We have formalized the Sturm-Tarski theorem (also referred as the Tarski theorem), which generalizes Sturm's theorem. Sturm's theorem is usually used as a way to count distinct real roots, while the Sturm-Tarksi theorem forms the basis for Tarski's classic quantifier elimination for real closed field. notify = wl302@cam.ac.uk [Markov_Models] title = Markov Models author = Johannes Hölzl <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2012-01-03 topic = Mathematics/Probability theory, Computer science/Automata and formal languages abstract = This is a formalization of Markov models in Isabelle/HOL. It builds on Isabelle's probability theory. The available models are currently Discrete-Time Markov Chains and a extensions of them with rewards. As application of these models we formalize probabilistic model checking of pCTL formulas, analysis of IPv4 address allocation in ZeroConf and an analysis of the anonymity of the Crowds protocol. <a href="http://arxiv.org/abs/1212.3870">See here for the corresponding paper.</a> notify = hoelzl@in.tum.de +[MDP-Rewards] +title = Markov Decision Processes with Rewards +author = Maximilian Schäffeler <mailto:schaeffm@in.tum.de>, Mohammad Abdulaziz <mailto:mansour@in.tum.de> +topic = Mathematics/Probability theory +date = 2021-12-16 +notify = schaeffm@in.tum.de, mansour@in.tum.de +abstract = + We present a formalization of Markov Decision Processes with rewards. + In particular we first build on Hölzl's formalization of MDPs + (AFP entry: Markov_Models) and extend them with rewards. We proceed + with an analysis of the expected total discounted reward criterion for + infinite horizon MDPs. The central result is the construction of the + iteration rule for the Bellman operator. We prove the optimality + equations for this operator and show the existence of an optimal + stationary deterministic solution. The analysis can be used to obtain + dynamic programming algorithms such as value iteration and policy + iteration to solve MDPs with formal guarantees. Our formalization is + based on chapters 5 and 6 in Puterman's book "Markov + Decision Processes: Discrete Stochastic Dynamic Programming". + +[MDP-Algorithms] +title = Verified Algorithms for Solving Markov Decision Processes +author = Maximilian Schäffeler <mailto:schaeffm@in.tum.de>, Mohammad Abdulaziz <mailto:mansour@in.tum.de> +topic = Mathematics/Probability theory, Computer science/Algorithms +date = 2021-12-16 +notify = schaeffm@in.tum.de, mansour@in.tum.de +abstract = + We present a formalization of algorithms for solving Markov Decision + Processes (MDPs) with formal guarantees on the optimality of their + solutions. In particular we build on our analysis of the Bellman + operator for discounted infinite horizon MDPs. From the iterator rule + on the Bellman operator we directly derive executable value iteration + and policy iteration algorithms to iteratively solve finite MDPs. We + also prove correct optimized versions of value iteration that use + matrix splittings to improve the convergence rate. In particular, we + formally verify Gauss-Seidel value iteration and modified policy + iteration. The algorithms are evaluated on two standard examples from + the literature, namely, inventory management and gridworld. Our + formalization covers most of chapter 6 in Puterman's book + "Markov Decision Processes: Discrete Stochastic Dynamic + Programming". + [Probabilistic_System_Zoo] title = A Zoo of Probabilistic Systems author = Johannes Hölzl <http://in.tum.de/~hoelzl>, Andreas Lochbihler <http://www.andreas-lochbihler.de>, Dmitriy Traytel <https://traytel.bitbucket.io> date = 2015-05-27 topic = Computer science/Automata and formal languages abstract = Numerous models of probabilistic systems are studied in the literature. Coalgebra has been used to classify them into system types and compare their expressiveness. We formalize the resulting hierarchy of probabilistic system types by modeling the semantics of the different systems as codatatypes. This approach yields simple and concise proofs, as bisimilarity coincides with equality for codatatypes. This work is described in detail in the ITP 2015 publication by the authors. notify = traytel@in.tum.de [Density_Compiler] title = A Verified Compiler for Probability Density Functions author = Manuel Eberl <https://pruvisto.org>, Johannes Hölzl <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2014-10-09 topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling abstract = <a href="https://doi.org/10.1007/978-3-642-36742-7_35">Bhat et al. [TACAS 2013]</a> developed an inductive compiler that computes density functions for probability spaces described by programs in a probabilistic functional language. In this work, we implement such a compiler for a modified version of this language within the theorem prover Isabelle and give a formal proof of its soundness w.r.t. the semantics of the source and target language. Together with Isabelle's code generation for inductive predicates, this yields a fully verified, executable density compiler. The proof is done in two steps: First, an abstract compiler working with abstract functions modelled directly in the theorem prover's logic is defined and proved sound. Then, this compiler is refined to a concrete version that returns a target-language expression. An article with the same title and authors is published in the proceedings of ESOP 2015. A detailed presentation of this work can be found in the first author's master's thesis. notify = hoelzl@in.tum.de [CAVA_Automata] title = The CAVA Automata Library author = Peter Lammich <http://www21.in.tum.de/~lammich> date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We report on the graph and automata library that is used in the fully verified LTL model checker CAVA. As most components of CAVA use some type of graphs or automata, a common automata library simplifies assembly of the components and reduces redundancy. The CAVA Automata Library provides a hierarchy of graph and automata classes, together with some standard algorithms. Its object oriented design allows for sharing of algorithms, theorems, and implementations between its classes, and also simplifies extensions of the library. Moreover, it is integrated into the Automatic Refinement Framework, supporting automatic refinement of the abstract automata types to efficient data structures. Note that the CAVA Automata Library is work in progress. Currently, it is very specifically tailored towards the requirements of the CAVA model checker. Nevertheless, the formalization techniques presented here allow an extension of the library to a wider scope. Moreover, they are not limited to graph libraries, but apply to class hierarchies in general. The CAVA Automata Library is described in the paper: Peter Lammich, The CAVA Automata Library, Isabelle Workshop 2014. notify = lammich@in.tum.de [LTL] title = Linear Temporal Logic author = Salomon Sickert <https://www7.in.tum.de/~sickert> contributors = Benedikt Seidl <mailto:benedikt.seidl@tum.de> date = 2016-03-01 topic = Logic/General logic/Temporal logic, Computer science/Automata and formal languages abstract = This theory provides a formalisation of linear temporal logic (LTL) and unifies previous formalisations within the AFP. This entry establishes syntax and semantics for this logic and decouples it from existing entries, yielding a common environment for theories reasoning about LTL. Furthermore a parser written in SML and an executable simplifier are provided. extra-history = Change history: [2019-03-12]: Support for additional operators, implementation of common equivalence relations, definition of syntactic fragments of LTL and the minimal disjunctive normal form. notify = sickert@in.tum.de [LTL_to_GBA] title = Converting Linear-Time Temporal Logic to Generalized Büchi Automata author = Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>, Peter Lammich <http://www21.in.tum.de/~lammich> date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We formalize linear-time temporal logic (LTL) and the algorithm by Gerth et al. to convert LTL formulas to generalized Büchi automata. We also formalize some syntactic rewrite rules that can be applied to optimize the LTL formula before conversion. Moreover, we integrate the Stuttering Equivalence AFP-Entry by Stefan Merz, adapting the lemma that next-free LTL formula cannot distinguish between stuttering equivalent runs to our setting. We use the Isabelle Refinement and Collection framework, as well as the Autoref tool, to obtain a refined version of our algorithm, from which efficiently executable code can be extracted. notify = lammich@in.tum.de [Gabow_SCC] title = Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm author = Peter Lammich <http://www21.in.tum.de/~lammich> date = 2014-05-28 topic = Computer science/Algorithms/Graph, Mathematics/Graph theory abstract = We present an Isabelle/HOL formalization of Gabow's algorithm for finding the strongly connected components of a directed graph. Using data refinement techniques, we extract efficient code that performs comparable to a reference implementation in Java. Our style of formalization allows for re-using large parts of the proofs when defining variants of the algorithm. We demonstrate this by verifying an algorithm for the emptiness check of generalized Büchi automata, re-using most of the existing proofs. notify = lammich@in.tum.de [Promela] title = Promela Formalization author = René Neumann <mailto:rene.neumann@in.tum.de> date = 2014-05-28 topic = Computer science/System description languages abstract = We present an executable formalization of the language Promela, the description language for models of the model checker SPIN. This formalization is part of the work for a completely verified model checker (CAVA), but also serves as a useful (and executable!) description of the semantics of the language itself, something that is currently missing. The formalization uses three steps: It takes an abstract syntax tree generated from an SML parser, removes syntactic sugar and enriches it with type information. This further gets translated into a transition system, on which the semantic engine (read: successor function) operates. notify = [CAVA_LTL_Modelchecker] title = A Fully Verified Executable LTL Model Checker author = Javier Esparza <https://www7.in.tum.de/~esparza/>, Peter Lammich <http://www21.in.tum.de/~lammich>, René Neumann <mailto:rene.neumann@in.tum.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>, Jan-Georg Smaus <http://www.irit.fr/~Jan-Georg.Smaus> date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We present an LTL model checker whose code has been completely verified using the Isabelle theorem prover. The checker consists of over 4000 lines of ML code. The code is produced using the Isabelle Refinement Framework, which allows us to split its correctness proof into (1) the proof of an abstract version of the checker, consisting of a few hundred lines of ``formalized pseudocode'', and (2) a verified refinement step in which mathematical sets and other abstract structures are replaced by implementations of efficient structures like red-black trees and functional arrays. This leads to a checker that, while still slower than unverified checkers, can already be used as a trusted reference implementation against which advanced implementations can be tested. An early version of this model checker is described in the <a href="http://www21.in.tum.de/~nipkow/pubs/cav13.html">CAV 2013 paper</a> with the same title. notify = lammich@in.tum.de [Fermat3_4] title = Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of<ul><li>Fermat's Last Theorem for exponents 3 and 4 and</li><li>the parametrisation of Pythagorean Triples.</li></ul> notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Perfect-Number-Thm] title = Perfect Number Theorem author = Mark Ijbema <mailto:ijbema@fmf.nl> date = 2009-11-22 topic = Mathematics/Number theory abstract = These theories present the mechanised proof of the Perfect Number Theorem. notify = nipkow@in.tum.de [SumSquares] title = Sums of Two and Four Squares author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of the following results:<ul><li>any prime number of the form 4m+1 can be written as the sum of two squares;</li><li>any natural number can be written as the sum of four squares</li></ul> notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Lehmer] title = Lehmer's Theorem author = Simon Wimmer <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1927, Lehmer presented criterions for primality, based on the converse of Fermat's litte theorem. This work formalizes the second criterion from Lehmer's paper, a necessary and sufficient condition for primality. As a side product we formalize some properties of Euler's phi-function, the notion of the order of an element of a group, and the cyclicity of the multiplicative group of a finite field. notify = noschinl@gmail.com, simon.wimmer@tum.de [Pratt_Certificate] title = Pratt's Primality Certificates author = Simon Wimmer <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1975, Pratt introduced a proof system for certifying primes. He showed that a number p is prime iff a primality certificate for p exists. By showing a logarithmic upper bound on the length of the certificates in size of the prime number, he concluded that the decision problem for prime numbers is in NP. This work formalizes soundness and completeness of Pratt's proof system as well as an upper bound for the size of the certificate. notify = noschinl@gmail.com, simon.wimmer@tum.de [Monad_Memo_DP] title = Monadification, Memoization and Dynamic Programming author = Simon Wimmer <http://home.in.tum.de/~wimmers/>, Shuwei Hu <mailto:shuwei.hu@tum.de>, Tobias Nipkow <http://www21.in.tum.de/~nipkow/> topic = Computer science/Programming languages/Transformations, Computer science/Algorithms, Computer science/Functional programming date = 2018-05-22 notify = wimmers@in.tum.de abstract = We present a lightweight framework for the automatic verified (functional or imperative) memoization of recursive functions. Our tool can turn a pure Isabelle/HOL function definition into a monadified version in a state monad or the Imperative HOL heap monad, and prove a correspondence theorem. We provide a variety of memory implementations for the two types of monads. A number of simple techniques allow us to achieve bottom-up computation and space-efficient memoization. The framework’s utility is demonstrated on a number of representative dynamic programming problems. A detailed description of our work can be found in the accompanying paper [2]. [Probabilistic_Timed_Automata] title = Probabilistic Timed Automata author = Simon Wimmer <http://in.tum.de/~wimmers>, Johannes Hölzl <http://home.in.tum.de/~hoelzl> topic = Mathematics/Probability theory, Computer science/Automata and formal languages date = 2018-05-24 notify = wimmers@in.tum.de, hoelzl@in.tum.de abstract = We present a formalization of probabilistic timed automata (PTA) for which we try to follow the formula MDP + TA = PTA as far as possible: our work starts from our existing formalizations of Markov decision processes (MDP) and timed automata (TA) and combines them modularly. We prove the fundamental result for probabilistic timed automata: the region construction that is known from timed automata carries over to the probabilistic setting. In particular, this allows us to prove that minimum and maximum reachability probabilities can be computed via a reduction to MDP model checking, including the case where one wants to disregard unrealizable behavior. Further information can be found in our ITP paper [2]. [Hidden_Markov_Models] title = Hidden Markov Models author = Simon Wimmer <http://in.tum.de/~wimmers> topic = Mathematics/Probability theory, Computer science/Algorithms date = 2018-05-25 notify = wimmers@in.tum.de abstract = This entry contains a formalization of hidden Markov models [3] based on Johannes Hölzl's formalization of discrete time Markov chains [1]. The basic definitions are provided and the correctness of two main (dynamic programming) algorithms for hidden Markov models is proved: the forward algorithm for computing the likelihood of an observed sequence, and the Viterbi algorithm for decoding the most probable hidden state sequence. The Viterbi algorithm is made executable including memoization. Hidden markov models have various applications in natural language processing. For an introduction see Jurafsky and Martin [2]. [ArrowImpossibilityGS] title = Arrow and Gibbard-Satterthwaite author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2008-09-01 topic = Mathematics/Games and economics abstract = This article formalizes two proofs of Arrow's impossibility theorem due to Geanakoplos and derives the Gibbard-Satterthwaite theorem as a corollary. One formalization is based on utility functions, the other one on strict partial orders. An article about these proofs is found <a href="http://www21.in.tum.de/~nipkow/pubs/arrow.html">here</a>. notify = nipkow@in.tum.de [SenSocialChoice] title = Some classical results in Social Choice Theory author = Peter Gammie <http://peteg.org> date = 2008-11-09 topic = Mathematics/Games and economics abstract = Drawing on Sen's landmark work "Collective Choice and Social Welfare" (1970), this development proves Arrow's General Possibility Theorem, Sen's Liberal Paradox and May's Theorem in a general setting. The goal was to make precise the classical statements and proofs of these results, and to provide a foundation for more recent results such as the Gibbard-Satterthwaite and Duggan-Schwartz theorems. notify = nipkow@in.tum.de [Vickrey_Clarke_Groves] title = VCG - Combinatorial Vickrey-Clarke-Groves Auctions author = Marco B. Caminati <>, Manfred Kerber <http://www.cs.bham.ac.uk/~mmk>, Christoph Lange<mailto:math.semantic.web@gmail.com>, Colin Rowat<mailto:c.rowat@bham.ac.uk> date = 2015-04-30 topic = Mathematics/Games and economics abstract = A VCG auction (named after their inventors Vickrey, Clarke, and Groves) is a generalization of the single-good, second price Vickrey auction to the case of a combinatorial auction (multiple goods, from which any participant can bid on each possible combination). We formalize in this entry VCG auctions, including tie-breaking and prove that the functions for the allocation and the price determination are well-defined. Furthermore we show that the allocation function allocates goods only to participants, only goods in the auction are allocated, and no good is allocated twice. We also show that the price function is non-negative. These properties also hold for the automatically extracted Scala code. notify = mnfrd.krbr@gmail.com [Topology] title = Topology author = Stefan Friedrich <> date = 2004-04-26 topic = Mathematics/Topology abstract = This entry contains two theories. The first, <tt>Topology</tt>, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called <tt>LList_Topology</tt>. It develops the topology of lazy lists. notify = lcp@cl.cam.ac.uk [Knot_Theory] title = Knot Theory author = T.V.H. Prathamesh <mailto:prathamesh@imsc.res.in> date = 2016-01-20 topic = Mathematics/Topology abstract = This work contains a formalization of some topics in knot theory. The concepts that were formalized include definitions of tangles, links, framed links and link/tangle equivalence. The formalization is based on a formulation of links in terms of tangles. We further construct and prove the invariance of the Bracket polynomial. Bracket polynomial is an invariant of framed links closely linked to the Jones polynomial. This is perhaps the first attempt to formalize any aspect of knot theory in an interactive proof assistant. notify = prathamesh@imsc.res.in [Graph_Theory] title = Graph Theory author = Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2013-04-28 topic = Mathematics/Graph theory abstract = This development provides a formalization of directed graphs, supporting (labelled) multi-edges and infinite graphs. A polymorphic edge type allows edges to be treated as pairs of vertices, if multi-edges are not required. Formalized properties are i.a. walks (and related concepts), connectedness and subgraphs and basic properties of isomorphisms. This formalization is used to prove characterizations of Euler Trails, Shortest Paths and Kuratowski subgraphs. notify = noschinl@gmail.com [Planarity_Certificates] title = Planarity Certificates author = Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2015-11-11 topic = Mathematics/Graph theory abstract = This development provides a formalization of planarity based on combinatorial maps and proves that Kuratowski's theorem implies combinatorial planarity. Moreover, it contains verified implementations of programs checking certificates for planarity (i.e., a combinatorial map) or non-planarity (i.e., a Kuratowski subgraph). notify = noschinl@gmail.com [Max-Card-Matching] title = Maximum Cardinality Matching author = Christine Rizkallah <https://www.mpi-inf.mpg.de/~crizkall/> date = 2011-07-21 topic = Mathematics/Graph theory abstract = A matching in a graph G is a subset M of the edges of G such that no two share an endpoint. A matching has maximum cardinality if its cardinality is at least as large as that of any other matching. An odd-set cover OSC of a graph G is a labeling of the nodes of G with integers such that every edge of G is either incident to a node labeled 1 or connects two nodes labeled with the same number i ≥ 2. This article proves Edmonds theorem: Let M be a matching in a graph G and let OSC be an odd-set cover of G. For any i ≥ 0, let <var>n(i)</var> be the number of nodes labeled i. If |M| = n(1) + ∑i ≥ 2(n(i) div 2), then M is a maximum cardinality matching. notify = nipkow@in.tum.de [Girth_Chromatic] title = A Probabilistic Proof of the Girth-Chromatic Number Theorem author = Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2012-02-06 topic = Mathematics/Graph theory abstract = This works presents a formalization of the Girth-Chromatic number theorem in graph theory, stating that graphs with arbitrarily large girth and chromatic number exist. The proof uses the theory of Random Graphs to prove the existence with probabilistic arguments. notify = noschinl@gmail.com [Random_Graph_Subgraph_Threshold] title = Properties of Random Graphs -- Subgraph Containment author = Lars Hupel <mailto:hupel@in.tum.de> date = 2014-02-13 topic = Mathematics/Graph theory, Mathematics/Probability theory abstract = Random graphs are graphs with a fixed number of vertices, where each edge is present with a fixed probability. We are interested in the probability that a random graph contains a certain pattern, for example a cycle or a clique. A very high edge probability gives rise to perhaps too many edges (which degrades performance for many algorithms), whereas a low edge probability might result in a disconnected graph. We prove a theorem about a threshold probability such that a higher edge probability will asymptotically almost surely produce a random graph with the desired subgraph. notify = hupel@in.tum.de [Flyspeck-Tame] title = Flyspeck I: Tame Graphs author = Gertrud Bauer <>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2006-05-22 topic = Mathematics/Graph theory abstract = These theories present the verified enumeration of tame plane graphs as defined by Thomas C. Hales in his proof of the Kepler Conjecture in his book Dense Sphere Packings. A Blueprint for Formal Proofs. [CUP 2012]. The values of the constants in the definition of tameness are identical to those in the <a href="https://code.google.com/p/flyspeck/">Flyspeck project</a>. The <a href="http://www21.in.tum.de/~nipkow/pubs/Flyspeck/">IJCAR 2006 paper by Nipkow, Bauer and Schultz</a> refers to the original version of Hales' proof, the <a href="http://www21.in.tum.de/~nipkow/pubs/itp11.html">ITP 2011 paper by Nipkow</a> refers to the Blueprint version of the proof. extra-history = Change history: [2010-11-02]: modified theories to reflect the modified definition of tameness in Hales' revised proof. [2014-07-03]: modified constants in def of tameness and Archive according to the final state of the Flyspeck proof. notify = nipkow@in.tum.de [Well_Quasi_Orders] title = Well-Quasi-Orders author = Christian Sternagel <mailto:c.sternagel@gmail.com> date = 2012-04-13 topic = Mathematics/Combinatorics abstract = Based on Isabelle/HOL's type class for preorders, we introduce a type class for well-quasi-orders (wqo) which is characterized by the absence of "bad" sequences (our proofs are along the lines of the proof of Nash-Williams, from which we also borrow terminology). Our main results are instantiations for the product type, the list type, and a type of finite trees, which (almost) directly follow from our proofs of (1) Dickson's Lemma, (2) Higman's Lemma, and (3) Kruskal's Tree Theorem. More concretely: <ul> <li>If the sets A and B are wqo then their Cartesian product is wqo.</li> <li>If the set A is wqo then the set of finite lists over A is wqo.</li> <li>If the set A is wqo then the set of finite trees over A is wqo.</li> </ul> The research was funded by the Austrian Science Fund (FWF): J3202. extra-history = Change history: [2012-06-11]: Added Kruskal's Tree Theorem. [2012-12-19]: New variant of Kruskal's tree theorem for terms (as opposed to variadic terms, i.e., trees), plus finite version of the tree theorem as corollary. [2013-05-16]: Simplified construction of minimal bad sequences. [2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem, based on homogeneous sequences. [2016-01-03]: An alternative proof of Higman's lemma by open induction. [2017-06-08]: Proved (classical) equivalence to inductive definition of almost-full relations according to the ITP 2012 paper "Stop When You Are Almost-Full" by Vytiniotis, Coquand, and Wahlstedt. notify = c.sternagel@gmail.com [Marriage] title = Hall's Marriage Theorem author = Dongchen Jiang <mailto:dongchenjiang@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2010-12-17 topic = Mathematics/Combinatorics abstract = Two proofs of Hall's Marriage Theorem: one due to Halmos and Vaughan, one due to Rado. extra-history = Change history: [2011-09-09]: Added Rado's proof notify = nipkow@in.tum.de [Bondy] title = Bondy's Theorem author = Jeremy Avigad <http://www.andrew.cmu.edu/user/avigad/>, Stefan Hetzl <http://www.logic.at/people/hetzl/> date = 2012-10-27 topic = Mathematics/Combinatorics abstract = A proof of Bondy's theorem following B. Bollabas, Combinatorics, 1986, Cambridge University Press. notify = avigad@cmu.edu, hetzl@logic.at [Ramsey-Infinite] title = Ramsey's theorem, infinitary version author = Tom Ridge <> date = 2004-09-20 topic = Mathematics/Combinatorics abstract = This formalization of Ramsey's theorem (infinitary version) is taken from Boolos and Jeffrey, Computability and Logic, 3rd edition, Chapter 26. It differs slightly from the text by assuming a slightly stronger hypothesis. In particular, the induction hypothesis is stronger, holding for any infinite subset of the naturals. This avoids the rather peculiar mapping argument between kj and aikj on p.263, which is unnecessary and slightly mars this really beautiful result. notify = lp15@cam.ac.uk [Derangements] title = Derangements Formula author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> date = 2015-06-27 topic = Mathematics/Combinatorics abstract = The Derangements Formula describes the number of fixpoint-free permutations as a closed formula. This theorem is the 88th theorem in a list of the ``<a href="http://www.cs.ru.nl/~freek/100/">Top 100 Mathematical Theorems</a>''. notify = lukas.bulwahn@gmail.com [Euler_Partition] title = Euler's Partition Theorem author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> date = 2015-11-19 topic = Mathematics/Combinatorics abstract = Euler's Partition Theorem states that the number of partitions with only distinct parts is equal to the number of partitions with only odd parts. The combinatorial proof follows John Harrison's HOL Light formalization. This theorem is the 45th theorem of the Top 100 Theorems list. notify = lukas.bulwahn@gmail.com [Discrete_Summation] title = Discrete Summation author = Florian Haftmann <http://isabelle.in.tum.de/~haftmann> contributors = Amine Chaieb <> date = 2014-04-13 topic = Mathematics/Combinatorics abstract = These theories introduce basic concepts and proofs about discrete summation: shifts, formal summation, falling factorials and stirling numbers. As proof of concept, a simple summation conversion is provided. notify = florian.haftmann@informatik.tu-muenchen.de [Open_Induction] title = Open Induction author = Mizuhito Ogawa <>, Christian Sternagel <mailto:c.sternagel@gmail.com> date = 2012-11-02 topic = Mathematics/Combinatorics abstract = A proof of the open induction schema based on J.-C. Raoult, Proving open properties by induction, Information Processing Letters 29, 1988, pp.19-23. This research was supported by the Austrian Science Fund (FWF): J3202. notify = c.sternagel@gmail.com [Category] title = Category Theory to Yoneda's Lemma author = Greg O'Keefe <http://users.rsise.anu.edu.au/~okeefe/> date = 2005-04-21 topic = Mathematics/Category theory license = LGPL abstract = This development proves Yoneda's lemma and aims to be readable by humans. It only defines what is needed for the lemma: categories, functors and natural transformations. Limits, adjunctions and other important concepts are not included. extra-history = Change history: [2010-04-23]: The definition of the constant <tt>equinumerous</tt> was slightly too weak in the original submission and has been fixed in revision <a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/3498bb1e4c7ba468db8588eb7184c1849641f7d3">8c2b5b3c995f</a>. notify = lcp@cl.cam.ac.uk [Category2] title = Category Theory author = Alexander Katovsky <mailto:apk32@cam.ac.uk> date = 2010-06-20 topic = Mathematics/Category theory abstract = This article presents a development of Category Theory in Isabelle/HOL. A Category is defined using records and locales. Functors and Natural Transformations are also defined. The main result that has been formalized is that the Yoneda functor is a full and faithful embedding. We also formalize the completeness of many sorted monadic equational logic. Extensive use is made of the HOLZF theory in both cases. For an informal description see <a href="http://www.srcf.ucam.org/~apk32/Isabelle/Category/Cat.pdf">here [pdf]</a>. notify = alexander.katovsky@cantab.net [FunWithFunctions] title = Fun With Functions author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> date = 2008-08-26 topic = Mathematics/Misc abstract = This is a collection of cute puzzles of the form ``Show that if a function satisfies the following constraints, it must be ...'' Please add further examples to this collection! notify = nipkow@in.tum.de [FunWithTilings] title = Fun With Tilings author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2008-11-07 topic = Mathematics/Misc abstract = Tilings are defined inductively. It is shown that one form of mutilated chess board cannot be tiled with dominoes, while another one can be tiled with L-shaped tiles. Please add further fun examples of this kind! notify = nipkow@in.tum.de [Lazy-Lists-II] title = Lazy Lists II author = Stefan Friedrich <> date = 2004-04-26 topic = Computer science/Data structures abstract = This theory contains some useful extensions to the LList (lazy list) theory by <a href="http://www.cl.cam.ac.uk/~lp15/">Larry Paulson</a>, including finite, infinite, and positive llists over an alphabet, as well as the new constants take and drop and the prefix order of llists. Finally, the notions of safety and liveness in the sense of Alpern and Schneider (1985) are defined. notify = lcp@cl.cam.ac.uk [Ribbon_Proofs] title = Ribbon Proofs author = John Wickerson <> date = 2013-01-19 topic = Computer science/Programming languages/Logics abstract = This document concerns the theory of ribbon proofs: a diagrammatic proof system, based on separation logic, for verifying program correctness. We include the syntax, proof rules, and soundness results for two alternative formalisations of ribbon proofs. Compared to traditional proof outlines, ribbon proofs emphasise the structure of a proof, so are intelligible and pedagogical. Because they contain less redundancy than proof outlines, and allow each proof step to be checked locally, they may be more scalable. Where proof outlines are cumbersome to modify, ribbon proofs can be visually manoeuvred to yield proofs of variant programs. notify = [Koenigsberg_Friendship] title = The Königsberg Bridge Problem and the Friendship Theorem author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/> date = 2013-07-19 topic = Mathematics/Graph theory abstract = This development provides a formalization of undirected graphs and simple graphs, which are based on Benedikt Nordhoff and Peter Lammich's simple formalization of labelled directed graphs in the archive. Then, with our formalization of graphs, we show both necessary and sufficient conditions for Eulerian trails and circuits as well as the fact that the Königsberg Bridge Problem does not have a solution. In addition, we show the Friendship Theorem in simple graphs. notify = [Tree_Decomposition] title = Tree Decomposition author = Christoph Dittmann <http://logic.las.tu-berlin.de/Members/Dittmann/> notify = date = 2016-05-31 topic = Mathematics/Graph theory abstract = We formalize tree decompositions and tree width in Isabelle/HOL, proving that trees have treewidth 1. We also show that every edge of a tree decomposition is a separation of the underlying graph. As an application of this theorem we prove that complete graphs of size n have treewidth n-1. [Menger] title = Menger's Theorem author = Christoph Dittmann <mailto:isabelle@christoph-d.de> topic = Mathematics/Graph theory date = 2017-02-26 notify = isabelle@christoph-d.de abstract = We present a formalization of Menger's Theorem for directed and undirected graphs in Isabelle/HOL. This well-known result shows that if two non-adjacent distinct vertices u, v in a directed graph have no separator smaller than n, then there exist n internally vertex-disjoint paths from u to v. The version for undirected graphs follows immediately because undirected graphs are a special case of directed graphs. [IEEE_Floating_Point] title = A Formal Model of IEEE Floating Point Arithmetic author = Lei Yu <mailto:ly271@cam.ac.uk> contributors = Fabian Hellauer <mailto:hellauer@in.tum.de>, Fabian Immler <http://www21.in.tum.de/~immler> date = 2013-07-27 topic = Computer science/Data structures abstract = This development provides a formal model of IEEE-754 floating-point arithmetic. This formalization, including formal specification of the standard and proofs of important properties of floating-point arithmetic, forms the foundation for verifying programs with floating-point computation. There is also a code generation setup for floats so that we can execute programs using this formalization in functional programming languages. notify = lp15@cam.ac.uk, immler@in.tum.de extra-history = Change history: [2017-09-25]: Added conversions from and to software floating point numbers (by Fabian Hellauer and Fabian Immler). [2018-02-05]: 'Modernized' representation following the formalization in HOL4: former "float_format" and predicate "is_valid" is now encoded in a type "('e, 'f) float" where 'e and 'f encode the size of exponent and fraction. [Native_Word] title = Native Word author = Andreas Lochbihler <http://www.andreas-lochbihler.de> contributors = Peter Lammich <http://www21.in.tum.de/~lammich> date = 2013-09-17 topic = Computer science/Data structures abstract = This entry makes machine words and machine arithmetic available for code generation from Isabelle/HOL. It provides a common abstraction that hides the differences between the different target languages. The code generator maps these operations to the APIs of the target languages. Apart from that, we extend the available bit operations on types int and integer, and map them to the operations in the target languages. extra-history = Change history: [2013-11-06]: added conversion function between native words and characters (revision fd23d9a7fe3a) [2014-03-31]: added words of default size in the target language (by Peter Lammich) (revision 25caf5065833) [2014-10-06]: proper test setup with compilation and execution of tests in all target languages (revision 5d7a1c9ae047) [2017-09-02]: added 64-bit words (revision c89f86244e3c) [2018-07-15]: added cast operators for default-size words (revision fc1f1fb8dd30) notify = mail@andreas-lochbihler.de [XML] title = XML author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> date = 2014-10-03 topic = Computer science/Functional programming, Computer science/Data structures abstract = This entry provides an XML library for Isabelle/HOL. This includes parsing and pretty printing of XML trees as well as combinators for transforming XML trees into arbitrary user-defined data. The main contribution of this entry is an interface (fit for code generation) that allows for communication between verified programs formalized in Isabelle/HOL and the outside world via XML. This library was developed as part of the IsaFoR/CeTA project to which we refer for examples of its usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [HereditarilyFinite] title = The Hereditarily Finite Sets author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2013-11-17 topic = Logic/Set theory abstract = The theory of hereditarily finite sets is formalised, following the <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">development</a> of Swierczkowski. An HF set is a finite collection of other HF sets; they enjoy an induction principle and satisfy all the axioms of ZF set theory apart from the axiom of infinity, which is negated. All constructions that are possible in ZF set theory (Cartesian products, disjoint sums, natural numbers, functions) without using infinite sets are possible here. The definition of addition for the HF sets follows Kirby. This development forms the foundation for the Isabelle proof of Gödel's incompleteness theorems, which has been <a href="Incompleteness.html">formalised separately</a>. extra-history = Change history: [2015-02-23]: Added the theory "Finitary" defining the class of types that can be embedded in hf, including int, char, option, list, etc. notify = lp15@cam.ac.uk [Incompleteness] title = Gödel's Incompleteness Theorems author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2013-11-17 topic = Logic/Proof theory abstract = Gödel's two incompleteness theorems are formalised, following a careful <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">presentation</a> by Swierczkowski, in the theory of <a href="HereditarilyFinite.html">hereditarily finite sets</a>. This represents the first ever machine-assisted proof of the second incompleteness theorem. Compared with traditional formalisations using Peano arithmetic (see e.g. Boolos), coding is simpler, with no need to formalise the notion of multiplication (let alone that of a prime number) in the formalised calculus upon which the theorem is based. However, other technical problems had to be solved in order to complete the argument. notify = lp15@cam.ac.uk [Finite_Automata_HF] title = Finite Automata in Hereditarily Finite Set Theory author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2015-02-05 topic = Computer science/Automata and formal languages abstract = Finite Automata, both deterministic and non-deterministic, for regular languages. The Myhill-Nerode Theorem. Closure under intersection, concatenation, etc. Regular expressions define regular languages. Closure under reversal; the powerset construction mapping NFAs to DFAs. Left and right languages; minimal DFAs. Brzozowski's minimization algorithm. Uniqueness up to isomorphism of minimal DFAs. notify = lp15@cam.ac.uk [Decreasing-Diagrams] title = Decreasing Diagrams author = Harald Zankl <http://cl-informatik.uibk.ac.at/users/hzankl> license = LGPL date = 2013-11-01 topic = Logic/Rewriting abstract = This theory contains a formalization of decreasing diagrams showing that any locally decreasing abstract rewrite system is confluent. We consider the valley (van Oostrom, TCS 1994) and the conversion version (van Oostrom, RTA 2008) and closely follow the original proofs. As an application we prove Newman's lemma. notify = Harald.Zankl@uibk.ac.at [Decreasing-Diagrams-II] title = Decreasing Diagrams II author = Bertram Felgenhauer <mailto:bertram.felgenhauer@uibk.ac.at> license = LGPL date = 2015-08-20 topic = Logic/Rewriting abstract = This theory formalizes the commutation version of decreasing diagrams for Church-Rosser modulo. The proof follows Felgenhauer and van Oostrom (RTA 2013). The theory also provides important specializations, in particular van Oostrom’s conversion version (TCS 2008) of decreasing diagrams. notify = bertram.felgenhauer@uibk.ac.at [GoedelGod] title = Gödel's God in Isabelle/HOL author = Christoph Benzmüller <http://page.mi.fu-berlin.de/cbenzmueller/>, Bruno Woltzenlogel Paleo <http://www.logic.at/staff/bruno/> date = 2013-11-12 topic = Logic/Philosophical aspects abstract = Dana Scott's version of Gödel's proof of God's existence is formalized in quantified modal logic KB (QML KB). QML KB is modeled as a fragment of classical higher-order logic (HOL); thus, the formalization is essentially a formalization in HOL. notify = lp15@cam.ac.uk, c.benzmueller@fu-berlin.de [Types_Tableaus_and_Goedels_God] title = Types, Tableaus and Gödel’s God in Isabelle/HOL author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de> topic = Logic/Philosophical aspects date = 2017-05-01 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = A computer-formalisation of the essential parts of Fitting's textbook "Types, Tableaus and Gödel's God" in Isabelle/HOL is presented. In particular, Fitting's (and Anderson's) variant of the ontological argument is verified and confirmed. This variant avoids the modal collapse, which has been criticised as an undesirable side-effect of Kurt Gödel's (and Dana Scott's) versions of the ontological argument. Fitting's work is employing an intensional higher-order modal logic, which we shallowly embed here in classical higher-order logic. We then utilize the embedded logic for the formalisation of Fitting's argument. (See also the earlier AFP entry ``Gödel's God in Isabelle/HOL''.) [GewirthPGCProof] title = Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://christoph-benzmueller.de> topic = Logic/Philosophical aspects date = 2018-10-30 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = An ambitious ethical theory ---Alan Gewirth's "Principle of Generic Consistency"--- is encoded and analysed in Isabelle/HOL. Gewirth's theory has stirred much attention in philosophy and ethics and has been proposed as a potential means to bound the impact of artificial general intelligence. extra-history = Change history: [2019-04-09]: added proof for a stronger variant of the PGC and examplary inferences (revision 88182cb0a2f6) [Lowe_Ontological_Argument] title = Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de> topic = Logic/Philosophical aspects date = 2017-09-21 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = Computers may help us to understand --not just verify-- philosophical arguments. By utilizing modern proof assistants in an iterative interpretive process, we can reconstruct and assess an argument by fully formal means. Through the mechanization of a variant of St. Anselm's ontological argument by E. J. Lowe, which is a paradigmatic example of a natural-language argument with strong ties to metaphysics and religion, we offer an ideal showcase for our computer-assisted interpretive method. [AnselmGod] title = Anselm's God in Isabelle/HOL author = Ben Blumson <https://philpapers.org/profile/805> topic = Logic/Philosophical aspects date = 2017-09-06 notify = benblumson@gmail.com abstract = Paul Oppenheimer and Edward Zalta's formalisation of Anselm's ontological argument for the existence of God is automated by embedding a free logic for definite descriptions within Isabelle/HOL. [Tail_Recursive_Functions] title = A General Method for the Proof of Theorems on Tail-recursive Functions author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2013-12-01 topic = Computer science/Functional programming abstract = Tail-recursive function definitions are sometimes more straightforward than alternatives, but proving theorems on them may be roundabout because of the peculiar form of the resulting recursion induction rules. This paper describes a proof method that provides a general solution to this problem by means of suitable invariants over inductive sets, and illustrates the application of such method by examining two case studies. notify = pasquale.noce.lavoro@gmail.com [CryptoBasedCompositionalProperties] title = Compositional Properties of Crypto-Based Components author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au> date = 2014-01-11 topic = Computer science/Security abstract = This paper presents an Isabelle/HOL set of theories which allows the specification of crypto-based components and the verification of their composition properties wrt. cryptographic aspects. We introduce a formalisation of the security property of data secrecy, the corresponding definitions and proofs. Please note that here we import the Isabelle/HOL theory ListExtras.thy, presented in the AFP entry FocusStreamsCaseStudies-AFP. notify = maria.spichkova@rmit.edu.au [Featherweight_OCL] title = Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5 author = Achim D. Brucker <mailto:brucker@spamfence.net>, Frédéric Tuong <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <mailto:wolff@lri.fr> date = 2014-01-16 topic = Computer science/System description languages abstract = The Unified Modeling Language (UML) is one of the few modeling languages that is widely used in industry. While UML is mostly known as diagrammatic modeling language (e.g., visualizing class models), it is complemented by a textual language, called Object Constraint Language (OCL). The current version of OCL is based on a four-valued logic that turns UML into a formal language. Any type comprises the elements "invalid" and "null" which are propagated as strict and non-strict, respectively. Unfortunately, the former semi-formal semantics of this specification language, captured in the "Annex A" of the OCL standard, leads to different interpretations of corner cases. We formalize the core of OCL: denotational definitions, a logical calculus and operational rules that allow for the execution of OCL expressions by a mixture of term rewriting and code compilation. Our formalization reveals several inconsistencies and contradictions in the current version of the OCL standard. Overall, this document is intended to provide the basis for a machine-checked text "Annex A" of the OCL standard targeting at tool implementors. extra-history = Change history: [2015-10-13]: <a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/e68e1996d5d4926397c9244e786446e99ab17e63">afp-devel@ea3b38fc54d6</a> and <a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=12148">hol-testgen@12148</a> Update of Featherweight OCL including a change in the abstract. [2014-01-16]: <a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/6217cc5b29c560f24ecc64c81047778becb69f51">afp-devel@9091ce05cb20</a> and <a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=10241">hol-testgen@10241</a> New Entry: Featherweight OCL notify = brucker@spamfence.net, tuong@users.gforge.inria.fr, wolff@lri.fr [Relation_Algebra] title = Relation Algebra author = Alasdair Armstrong <>, Simon Foster <mailto:simon.foster@york.ac.uk>, Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>, Tjark Weber <http://user.it.uu.se/~tjawe125/> date = 2014-01-25 topic = Mathematics/Algebra abstract = Tarski's algebra of binary relations is formalised along the lines of the standard textbooks of Maddux and Schmidt and Ströhlein. This includes relation-algebraic concepts such as subidentities, vectors and a domain operation as well as various notions associated to functions. Relation algebras are also expanded by a reflexive transitive closure operation, and they are linked with Kleene algebras and models of binary relations and Boolean matrices. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [PSemigroupsConvolution] title = Partial Semigroups and Convolution Algebras author = Brijesh Dongol <mailto:brijesh.dongol@brunel.ac.uk>, Victor B. F. Gomes <mailto:victor.gomes@cl.cam.ac.uk>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Georg Struth <mailto:g.struth@sheffield.ac.uk> topic = Mathematics/Algebra date = 2017-06-13 notify = g.struth@sheffield.ac.uk, victor.gomes@cl.cam.ac.uk abstract = Partial Semigroups are relevant to the foundations of quantum mechanics and combinatorics as well as to interval and separation logics. Convolution algebras can be understood either as algebras of generalised binary modalities over ternary Kripke frames, in particular over partial semigroups, or as algebras of quantale-valued functions which are equipped with a convolution-style operation of multiplication that is parametrised by a ternary relation. Convolution algebras provide algebraic semantics for various substructural logics, including categorial, relevance and linear logics, for separation logic and for interval logics; they cover quantitative and qualitative applications. These mathematical components for partial semigroups and convolution algebras provide uniform foundations from which models of computation based on relations, program traces or pomsets, and verification components for separation or interval temporal logics can be built with little effort. [Secondary_Sylow] title = Secondary Sylow Theorems author = Jakob von Raumer <mailto:psxjv4@nottingham.ac.uk> date = 2014-01-28 topic = Mathematics/Algebra abstract = These theories extend the existing proof of the first Sylow theorem (written by Florian Kammueller and L. C. Paulson) by what are often called the second, third and fourth Sylow theorems. These theorems state propositions about the number of Sylow p-subgroups of a group and the fact that they are conjugate to each other. The proofs make use of an implementation of group actions and their properties. notify = psxjv4@nottingham.ac.uk [Jordan_Hoelder] title = The Jordan-Hölder Theorem author = Jakob von Raumer <mailto:psxjv4@nottingham.ac.uk> date = 2014-09-09 topic = Mathematics/Algebra abstract = This submission contains theories that lead to a formalization of the proof of the Jordan-Hölder theorem about composition series of finite groups. The theories formalize the notions of isomorphism classes of groups, simple groups, normal series, composition series, maximal normal subgroups. Furthermore, they provide proofs of the second isomorphism theorem for groups, the characterization theorem for maximal normal subgroups as well as many useful lemmas about normal subgroups and factor groups. The proof is inspired by course notes of Stuart Rankin. notify = psxjv4@nottingham.ac.uk [Cayley_Hamilton] title = The Cayley-Hamilton Theorem author = Stephan Adelsberger <http://nm.wu.ac.at/nm/sadelsbe>, Stefan Hetzl <http://www.logic.at/people/hetzl/>, Florian Pollak <mailto:florian.pollak@gmail.com> date = 2014-09-15 topic = Mathematics/Algebra abstract = This document contains a proof of the Cayley-Hamilton theorem based on the development of matrices in HOL/Multivariate Analysis. notify = stvienna@gmail.com [Probabilistic_Noninterference] title = Probabilistic Noninterference author = Andrei Popescu <https://www.andreipopescu.uk>, Johannes Hölzl <http://in.tum.de/~hoelzl> date = 2014-03-11 topic = Computer science/Security abstract = We formalize a probabilistic noninterference for a multi-threaded language with uniform scheduling, where probabilistic behaviour comes from both the scheduler and the individual threads. We define notions probabilistic noninterference in two variants: resumption-based and trace-based. For the resumption-based notions, we prove compositionality w.r.t. the language constructs and establish sound type-system-like syntactic criteria. This is a formalization of the mathematical development presented at CPP 2013 and CALCO 2013. It is the probabilistic variant of the Possibilistic Noninterference AFP entry. notify = hoelzl@in.tum.de [HyperCTL] title = A shallow embedding of HyperCTL* author = Markus N. Rabe <http://www.react.uni-saarland.de/people/rabe.html>, Peter Lammich <http://www21.in.tum.de/~lammich>, Andrei Popescu <https://www.andreipopescu.uk> date = 2014-04-16 topic = Computer science/Security, Logic/General logic/Temporal logic abstract = We formalize HyperCTL*, a temporal logic for expressing security properties. We first define a shallow embedding of HyperCTL*, within which we prove inductive and coinductive rules for the operators. Then we show that a HyperCTL* formula captures Goguen-Meseguer noninterference, a landmark information flow property. We also define a deep embedding and connect it to the shallow embedding by a denotational semantics, for which we prove sanity w.r.t. dependence on the free variables. Finally, we show that under some finiteness assumptions about the model, noninterference is given by a (finitary) syntactic formula. notify = uuomul@yahoo.com [Bounded_Deducibility_Security] title = Bounded-Deducibility Security author = Andrei Popescu <https://www.andreipopescu.uk>, Peter Lammich <http://www21.in.tum.de/~lammich>, Thomas Bauereiss <mailto:thomas@bauereiss.name> date = 2014-04-22 topic = Computer science/Security abstract = This is a formalization of bounded-deducibility security (BD security), a flexible notion of information-flow security applicable to arbitrary transition systems. It generalizes Sutherland's classic notion of nondeducibility by factoring in declassification bounds and trigger, whereas nondeducibility states that, in a system, information cannot flow between specified sources and sinks, BD security indicates upper bounds for the flow and triggers under which these upper bounds are no longer guaranteed. notify = uuomul@yahoo.com, lammich@in.tum.de, thomas@bauereiss.name extra-history = Change history: [2021-08-12]: Generalised BD Security from I/O automata to nondeterministic transition systems, with the former retained as an instance of the latter (renaming locale BD_Security to BD_Security_IO). Generalise unwinding conditions to allow making more than one transition at a time when constructing alternative traces. Add results about the expressivity of declassification triggers vs. bounds, due to Thomas Bauereiss (added as author). [Network_Security_Policy_Verification] title = Network Security Policy Verification author = Cornelius Diekmann <http://net.in.tum.de/~diekmann> date = 2014-07-04 topic = Computer science/Security abstract = We present a unified theory for verifying network security policies. A security policy is represented as directed graph. To check high-level security goals, security invariants over the policy are expressed. We cover monotonic security invariants, i.e. prohibiting more does not harm security. We provide the following contributions for the security invariant theory. <ul> <li>Secure auto-completion of scenario-specific knowledge, which eases usability.</li> <li>Security violations can be repaired by tightening the policy iff the security invariants hold for the deny-all policy.</li> <li>An algorithm to compute a security policy.</li> <li>A formalization of stateful connection semantics in network security mechanisms.</li> <li>An algorithm to compute a secure stateful implementation of a policy.</li> <li>An executable implementation of all the theory.</li> <li>Examples, ranging from an aircraft cabin data network to the analysis of a large real-world firewall.</li> <li>More examples: A fully automated translation of high-level security goals to both firewall and SDN configurations (see Examples/Distributed_WebApp.thy).</li> </ul> For a detailed description, see <ul> <li>C. Diekmann, A. Korsten, and G. Carle. <a href="http://www.net.in.tum.de/fileadmin/bibtex/publications/papers/diekmann2015mansdnnfv.pdf">Demonstrating topoS: Theorem-prover-based synthesis of secure network configurations.</a> In 2nd International Workshop on Management of SDN and NFV Systems, manSDN/NFV, Barcelona, Spain, November 2015.</li> <li>C. Diekmann, S.-A. Posselt, H. Niedermayer, H. Kinkelin, O. Hanka, and G. Carle. <a href="http://www.net.in.tum.de/pub/diekmann/forte14.pdf">Verifying Security Policies using Host Attributes.</a> In FORTE, 34th IFIP International Conference on Formal Techniques for Distributed Objects, Components and Systems, Berlin, Germany, June 2014.</li> <li>C. Diekmann, L. Hupel, and G. Carle. Directed Security Policies: <a href="http://rvg.web.cse.unsw.edu.au/eptcs/paper.cgi?ESSS2014.3">A Stateful Network Implementation.</a> In J. Pang and Y. Liu, editors, Engineering Safety and Security Systems, volume 150 of Electronic Proceedings in Theoretical Computer Science, pages 20-34, Singapore, May 2014. Open Publishing Association.</li> </ul> extra-history = Change history: [2015-04-14]: Added Distributed WebApp example and improved graphviz visualization (revision 4dde08ca2ab8) notify = diekmann@net.in.tum.de [Abstract_Completeness] title = Abstract Completeness author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> date = 2014-04-16 topic = Logic/Proof theory abstract = A formalization of an abstract property of possibly infinite derivation trees (modeled by a codatatype), representing the core of a proof (in Beth/Hintikka style) of the first-order logic completeness theorem, independent of the concrete syntax or inference rules. This work is described in detail in the IJCAR 2014 publication by the authors. The abstract proof can be instantiated for a wide range of Gentzen and tableau systems as well as various flavors of FOL---e.g., with or without predicates, equality, or sorts. Here, we give only a toy example instantiation with classical propositional logic. A more serious instance---many-sorted FOL with equality---is described elsewhere [Blanchette and Popescu, FroCoS 2013]. notify = traytel@in.tum.de [Pop_Refinement] title = Pop-Refinement author = Alessandro Coglio <http://www.kestrel.edu/~coglio> date = 2014-07-03 topic = Computer science/Programming languages/Misc abstract = Pop-refinement is an approach to stepwise refinement, carried out inside an interactive theorem prover by constructing a monotonically decreasing sequence of predicates over deeply embedded target programs. The sequence starts with a predicate that characterizes the possible implementations, and ends with a predicate that characterizes a unique program in explicit syntactic form. Pop-refinement enables more requirements (e.g. program-level and non-functional) to be captured in the initial specification and preserved through refinement. Security requirements expressed as hyperproperties (i.e. predicates over sets of traces) are always preserved by pop-refinement, unlike the popular notion of refinement as trace set inclusion. Two simple examples in Isabelle/HOL are presented, featuring program-level requirements, non-functional requirements, and hyperproperties. notify = coglio@kestrel.edu [VectorSpace] title = Vector Spaces author = Holden Lee <mailto:holdenl@princeton.edu> date = 2014-08-29 topic = Mathematics/Algebra abstract = This formalisation of basic linear algebra is based completely on locales, building off HOL-Algebra. It includes basic definitions: linear combinations, span, linear independence; linear transformations; interpretation of function spaces as vector spaces; the direct sum of vector spaces, sum of subspaces; the replacement theorem; existence of bases in finite-dimensional; vector spaces, definition of dimension; the rank-nullity theorem. Some concepts are actually defined and proved for modules as they also apply there. Infinite-dimensional vector spaces are supported, but dimension is only supported for finite-dimensional vector spaces. The proofs are standard; the proofs of the replacement theorem and rank-nullity theorem roughly follow the presentation in Linear Algebra by Friedberg, Insel, and Spence. The rank-nullity theorem generalises the existing development in the Archive of Formal Proof (originally using type classes, now using a mix of type classes and locales). notify = holdenl@princeton.edu [Special_Function_Bounds] title = Real-Valued Special Functions: Upper and Lower Bounds author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2014-08-29 topic = Mathematics/Analysis abstract = This development proves upper and lower bounds for several familiar real-valued functions. For sin, cos, exp and sqrt, it defines and verifies infinite families of upper and lower bounds, mostly based on Taylor series expansions. For arctan, ln and exp, it verifies a finite collection of upper and lower bounds, originally obtained from the functions' continued fraction expansions using the computer algebra system Maple. A common theme in these proofs is to take the difference between a function and its approximation, which should be zero at one point, and then consider the sign of the derivative. The immediate purpose of this development is to verify axioms used by MetiTarski, an automatic theorem prover for real-valued special functions. Crucial to MetiTarski's operation is the provision of upper and lower bounds for each function of interest. notify = lp15@cam.ac.uk [Landau_Symbols] title = Landau Symbols author = Manuel Eberl <https://pruvisto.org> date = 2015-07-14 topic = Mathematics/Analysis abstract = This entry provides Landau symbols to describe and reason about the asymptotic growth of functions for sufficiently large inputs. A number of simplification procedures are provided for additional convenience: cancelling of dominated terms in sums under a Landau symbol, cancelling of common factors in products, and a decision procedure for Landau expressions containing products of powers of functions like x, ln(x), ln(ln(x)) etc. notify = manuel@pruvisto.org [Error_Function] title = The Error Function author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis date = 2018-02-06 notify = manuel@pruvisto.org abstract = This entry provides the definitions and basic properties of the complex and real error function erf and the complementary error function erfc. Additionally, it gives their full asymptotic expansions. [Akra_Bazzi] title = The Akra-Bazzi theorem and the Master theorem author = Manuel Eberl <https://pruvisto.org> date = 2015-07-14 topic = Mathematics/Analysis abstract = This article contains a formalisation of the Akra-Bazzi method based on a proof by Leighton. It is a generalisation of the well-known Master Theorem for analysing the complexity of Divide & Conquer algorithms. We also include a generalised version of the Master theorem based on the Akra-Bazzi theorem, which is easier to apply than the Akra-Bazzi theorem itself. Some proof methods that facilitate applying the Master theorem are also included. For a more detailed explanation of the formalisation and the proof methods, see the accompanying paper (publication forthcoming). notify = manuel@pruvisto.org [Dirichlet_Series] title = Dirichlet Series author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2017-10-12 notify = manuel@pruvisto.org abstract = This entry is a formalisation of much of Chapters 2, 3, and 11 of Apostol's “Introduction to Analytic Number Theory”. This includes: <ul> <li>Definitions and basic properties for several number-theoretic functions (Euler's φ, Möbius μ, Liouville's λ, the divisor function σ, von Mangoldt's Λ)</li> <li>Executable code for most of these functions, the most efficient implementations using the factoring algorithm by Thiemann et al.</li> <li>Dirichlet products and formal Dirichlet series</li> <li>Analytic results connecting convergent formal Dirichlet series to complex functions</li> <li>Euler product expansions</li> <li>Asymptotic estimates of number-theoretic functions including the density of squarefree integers and the average number of divisors of a natural number</li> </ul> These results are useful as a basis for developing more number-theoretic results, such as the Prime Number Theorem. [Gauss_Sums] title = Gauss Sums and the Pólya–Vinogradov Inequality author = Rodrigo Raya <https://people.epfl.ch/rodrigo.raya>, Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2019-12-10 notify = manuel.eberl@tum.de abstract = This article provides a full formalisation of Chapter 8 of Apostol's <a href="https://www.springer.com/de/book/9780387901633">Introduction to Analytic Number Theory</a>. Subjects that are covered are: <ul> <li>periodic arithmetic functions and their finite Fourier series</li> <li>(generalised) Ramanujan sums</li> <li>Gauss sums and separable characters</li> <li>induced moduli and primitive characters</li> <li>the Pólya—Vinogradov inequality</li> </ul> [Zeta_Function] title = The Hurwitz and Riemann ζ Functions author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory, Mathematics/Analysis date = 2017-10-12 notify = manuel@pruvisto.org abstract = This entry builds upon the results about formal and analytic Dirichlet series to define the Hurwitz ζ function ζ(a,s) and, based on that, the Riemann ζ function ζ(s). This is done by first defining them for ℜ(z) > 1 and then successively extending the domain to the left using the Euler–MacLaurin formula. Apart from the most basic facts such as analyticity, the following results are provided: <ul> <li>the Stieltjes constants and the Laurent expansion of ζ(s) at s = 1</li> <li>the non-vanishing of ζ(s) for ℜ(z) ≥ 1</li> <li>the relationship between ζ(a,s) and Γ</li> <li>the special values at negative integers and positive even integers</li> <li>Hurwitz's formula and the reflection formula for ζ(s)</li> <li>the <a href="https://arxiv.org/abs/math/0405478"> Hadjicostas–Chapman formula</a></li> </ul> The entry also contains Euler's analytic proof of the infinitude of primes, based on the fact that ζ(s) has a pole at s = 1. [Linear_Recurrences] title = Linear Recurrences author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis date = 2017-10-12 notify = manuel@pruvisto.org abstract = Linear recurrences with constant coefficients are an interesting class of recurrence equations that can be solved explicitly. The most famous example are certainly the Fibonacci numbers with the equation f(n) = f(n-1) + f(n - 2) and the quite non-obvious closed form (φn - (-φ)-n) / √5 where φ is the golden ratio. In this work, I build on existing tools in Isabelle – such as formal power series and polynomial factorisation algorithms – to develop a theory of these recurrences and derive a fully executable solver for them that can be exported to programming languages like Haskell. [Van_der_Waerden] title = Van der Waerden's Theorem author = Katharina Kreuzer <https://www21.in.tum.de/team/kreuzer/>, Manuel Eberl <https://pruvisto.org/> topic = Mathematics/Combinatorics date = 2021-06-22 notify = kreuzerk@in.tum.de, manuel@pruvisto.org abstract = This article formalises the proof of Van der Waerden's Theorem from Ramsey theory. Van der Waerden's Theorem states that for integers $k$ and $l$ there exists a number $N$ which guarantees that if an integer interval of length at least $N$ is coloured with $k$ colours, there will always be an arithmetic progression of length $l$ of the same colour in said interval. The proof goes along the lines of \cite{Swan}. The smallest number $N_{k,l}$ fulfilling Van der Waerden's Theorem is then called the Van der Waerden Number. Finding the Van der Waerden Number is still an open problem for most values of $k$ and $l$. [Lambert_W] title = The Lambert W Function on the Reals author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis date = 2020-04-24 notify = manuel@pruvisto.org abstract = The Lambert W function is a multi-valued function defined as the inverse function of x ↦ x ex. Besides numerous applications in combinatorics, physics, and engineering, it also frequently occurs when solving equations containing both ex and x, or both x and log x. This article provides a definition of the two real-valued branches W0(x) and W-1(x) and proves various properties such as basic identities and inequalities, monotonicity, differentiability, asymptotic expansions, and the MacLaurin series of W0(x) at x = 0. [Cartan_FP] title = The Cartan Fixed Point Theorems author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> date = 2016-03-08 topic = Mathematics/Analysis abstract = The Cartan fixed point theorems concern the group of holomorphic automorphisms on a connected open set of Cn. Ciolli et al. have formalised the one-dimensional case of these theorems in HOL Light. This entry contains their proofs, ported to Isabelle/HOL. Thus it addresses the authors' remark that "it would be important to write a formal proof in a language that can be read by both humans and machines". notify = lp15@cam.ac.uk [Gauss_Jordan] title = Gauss-Jordan Algorithm and Its Applications author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa> topic = Computer science/Algorithms/Mathematical date = 2014-09-03 abstract = The Gauss-Jordan algorithm states that any matrix over a field can be transformed by means of elementary row operations to a matrix in reduced row echelon form. The formalization is based on the Rank Nullity Theorem entry of the AFP and on the HOL-Multivariate-Analysis session of Isabelle, where matrices are represented as functions over finite types. We have set up the code generator to make this representation executable. In order to improve the performance, a refinement to immutable arrays has been carried out. We have formalized some of the applications of the Gauss-Jordan algorithm. Thanks to this development, the following facts can be computed over matrices whose elements belong to a field: Ranks, Determinants, Inverses, Bases and dimensions and Solutions of systems of linear equations. Code can be exported to SML and Haskell. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Echelon_Form] title = Echelon Form author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa> topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-02-12 abstract = We formalize an algorithm to compute the Echelon Form of a matrix. We have proved its existence over Bézout domains and made it executable over Euclidean domains, such as the integer ring and the univariate polynomials over a field. This allows us to compute determinants, inverses and characteristic polynomials of matrices. The work is based on the HOL-Multivariate Analysis library, and on both the Gauss-Jordan and Cayley-Hamilton AFP entries. As a by-product, some algebraic structures have been implemented (principal ideal domains, Bézout domains...). The algorithm has been refined to immutable arrays and code can be generated to functional languages as well. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [QR_Decomposition] title = QR Decomposition author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa> topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-02-12 abstract = QR decomposition is an algorithm to decompose a real matrix A into the product of two other matrices Q and R, where Q is orthogonal and R is invertible and upper triangular. The algorithm is useful for the least squares problem; i.e., the computation of the best approximation of an unsolvable system of linear equations. As a side-product, the Gram-Schmidt process has also been formalized. A refinement using immutable arrays is presented as well. The development relies, among others, on the AFP entry "Implementing field extensions of the form Q[sqrt(b)]" by René Thiemann, which allows execution of the algorithm using symbolic computations. Verified code can be generated and executed using floats as well. extra-history = Change history: [2015-06-18]: The second part of the Fundamental Theorem of Linear Algebra has been generalized to more general inner product spaces. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Hermite] title = Hermite Normal Form author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa> topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2015-07-07 abstract = Hermite Normal Form is a canonical matrix analogue of Reduced Echelon Form, but involving matrices over more general rings. In this work we formalise an algorithm to compute the Hermite Normal Form of a matrix by means of elementary row operations, taking advantage of the Echelon Form AFP entry. We have proven the correctness of such an algorithm and refined it to immutable arrays. Furthermore, we have also formalised the uniqueness of the Hermite Normal Form of a matrix. Code can be exported and some examples of execution involving integer matrices and polynomial matrices are presented as well. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Imperative_Insertion_Sort] title = Imperative Insertion Sort author = Christian Sternagel <mailto:c.sternagel@gmail.com> date = 2014-09-25 topic = Computer science/Algorithms abstract = The insertion sort algorithm of Cormen et al. (Introduction to Algorithms) is expressed in Imperative HOL and proved to be correct and terminating. For this purpose we also provide a theory about imperative loop constructs with accompanying induction/invariant rules for proving partial and total correctness. Furthermore, the formalized algorithm is fit for code generation. notify = lp15@cam.ac.uk [Stream_Fusion_Code] title = Stream Fusion in HOL with Code Generation author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Alexandra Maximova <mailto:amaximov@student.ethz.ch> date = 2014-10-10 topic = Computer science/Functional programming abstract = Stream Fusion is a system for removing intermediate list data structures from functional programs, in particular Haskell. This entry adapts stream fusion to Isabelle/HOL and its code generator. We define stream types for finite and possibly infinite lists and stream versions for most of the fusible list functions in the theories List and Coinductive_List, and prove them correct with respect to the conversion functions between lists and streams. The Stream Fusion transformation itself is implemented as a simproc in the preprocessor of the code generator. [Brian Huffman's <a href="http://isa-afp.org/entries/Stream-Fusion.html">AFP entry</a> formalises stream fusion in HOLCF for the domain of lazy lists to prove the GHC compiler rewrite rules correct. In contrast, this work enables Isabelle's code generator to perform stream fusion itself. To that end, it covers both finite and coinductive lists from the HOL library and the Coinductive entry. The fusible list functions require specification and proof principles different from Huffman's.] notify = mail@andreas-lochbihler.de [Case_Labeling] title = Generating Cases from Labeled Subgoals author = Lars Noschinski <http://www21.in.tum.de/~noschinl/> date = 2015-07-21 topic = Tools, Computer science/Programming languages/Misc abstract = Isabelle/Isar provides named cases to structure proofs. This article contains an implementation of a proof method <tt>casify</tt>, which can be used to easily extend proof tools with support for named cases. Such a proof tool must produce labeled subgoals, which are then interpreted by <tt>casify</tt>. As examples, this work contains verification condition generators producing named cases for three languages: The Hoare language from <tt>HOL/Library</tt>, a monadic language for computations with failure (inspired by the AutoCorres tool), and a language of conditional expressions. These VCGs are demonstrated by a number of example programs. notify = noschinl@gmail.com [DPT-SAT-Solver] title = A Fast SAT Solver for Isabelle in Standard ML topic = Tools author = Armin Heller <> date = 2009-12-09 abstract = This contribution contains a fast SAT solver for Isabelle written in Standard ML. By loading the theory <tt>DPT_SAT_Solver</tt>, the SAT solver installs itself (under the name ``dptsat'') and certain Isabelle tools like Refute will start using it automatically. This is a port of the DPT (Decision Procedure Toolkit) SAT Solver written in OCaml. notify = jasmin.blanchette@gmail.com [Rep_Fin_Groups] title = Representations of Finite Groups topic = Mathematics/Algebra author = Jeremy Sylvestre <http://ualberta.ca/~jsylvest/> date = 2015-08-12 abstract = We provide a formal framework for the theory of representations of finite groups, as modules over the group ring. Along the way, we develop the general theory of groups (relying on the group_add class for the basics), modules, and vector spaces, to the extent required for theory of group representations. We then provide formal proofs of several important introductory theorems in the subject, including Maschke's theorem, Schur's lemma, and Frobenius reciprocity. We also prove that every irreducible representation is isomorphic to a submodule of the group ring, leading to the fact that for a finite group there are only finitely many isomorphism classes of irreducible representations. In all of this, no restriction is made on the characteristic of the ring or field of scalars until the definition of a group representation, and then the only restriction made is that the characteristic must not divide the order of the group. notify = jsylvest@ualberta.ca [Noninterference_Inductive_Unwinding] title = The Inductive Unwinding Theorem for CSP Noninterference Security topic = Computer science/Security author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2015-08-18 abstract = The necessary and sufficient condition for CSP noninterference security stated by the Ipurge Unwinding Theorem is expressed in terms of a pair of event lists varying over the set of process traces. This does not render it suitable for the subsequent application of rule induction in the case of a process defined inductively, since rule induction may rather be applied to a single variable ranging over an inductively defined set. Starting from the Ipurge Unwinding Theorem, this paper derives a necessary and sufficient condition for CSP noninterference security that involves a single event list varying over the set of process traces, and is thus suitable for rule induction; hence its name, Inductive Unwinding Theorem. Similarly to the Ipurge Unwinding Theorem, the new theorem only requires to consider individual accepted and refused events for each process trace, and applies to the general case of a possibly intransitive noninterference policy. Specific variants of this theorem are additionally proven for deterministic processes and trace set processes. notify = pasquale.noce.lavoro@gmail.com [Password_Authentication_Protocol] title = Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> topic = Computer science/Security date = 2017-01-03 notify = pasquale.noce.lavoro@gmail.com abstract = This paper constructs a formal model of a Diffie-Hellman password-based authentication protocol between a user and a smart card, and proves its security. The protocol provides for the dispatch of the user's password to the smart card on a secure messaging channel established by means of Password Authenticated Connection Establishment (PACE), where the mapping method being used is Chip Authentication Mapping. By applying and suitably extending Paulson's Inductive Method, this paper proves that the protocol establishes trustworthy secure messaging channels, preserves the secrecy of users' passwords, and provides an effective mutual authentication service. What is more, these security properties turn out to hold independently of the secrecy of the PACE authentication key. [Jordan_Normal_Form] title = Matrices, Jordan Normal Forms, and Spectral Radius Theory topic = Mathematics/Algebra author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> contributors = Alexander Bentkamp <mailto:bentkamp@gmail.com> date = 2015-08-21 abstract = Matrix interpretations are useful as measure functions in termination proving. In order to use these interpretations also for complexity analysis, the growth rate of matrix powers has to examined. Here, we formalized a central result of spectral radius theory, namely that the growth rate is polynomially bounded if and only if the spectral radius of a matrix is at most one. To formally prove this result we first studied the growth rates of matrices in Jordan normal form, and prove the result that every complex matrix has a Jordan normal form using a constructive prove via Schur decomposition. The whole development is based on a new abstract type for matrices, which is also executable by a suitable setup of the code generator. It completely subsumes our former AFP-entry on executable matrices, and its main advantage is its close connection to the HMA-representation which allowed us to easily adapt existing proofs on determinants. All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates. extra-history = Change history: [2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms [2018-04-17]: Integrated lemmas from deep-learning AFP-entry of Alexander Bentkamp notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [LTL_to_DRA] title = Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata topic = Computer science/Automata and formal languages author = Salomon Sickert <mailto:sickert@in.tum.de> date = 2015-09-04 abstract = Recently, Javier Esparza and Jan Kretinsky proposed a new method directly translating linear temporal logic (LTL) formulas to deterministic (generalized) Rabin automata. Compared to the existing approaches of constructing a non-deterministic Buechi-automaton in the first step and then applying a determinization procedure (e.g. some variant of Safra's construction) in a second step, this new approach preservers a relation between the formula and the states of the resulting automaton. While the old approach produced a monolithic structure, the new method is compositional. Furthermore, in some cases the resulting automata are much smaller than the automata generated by existing approaches. In order to ensure the correctness of the construction, this entry contains a complete formalisation and verification of the translation. Furthermore from this basis executable code is generated. extra-history = Change history: [2015-09-23]: Enable code export for the eager unfolding optimisation and reduce running time of the generated tool. Moreover, add support for the mlton SML compiler. [2016-03-24]: Make use of the LTL entry and include the simplifier. notify = sickert@in.tum.de [Timed_Automata] title = Timed Automata author = Simon Wimmer <http://in.tum.de/~wimmers> date = 2016-03-08 topic = Computer science/Automata and formal languages abstract = Timed automata are a widely used formalism for modeling real-time systems, which is employed in a class of successful model checkers such as UPPAAL [LPY97], HyTech [HHWt97] or Kronos [Yov97]. This work formalizes the theory for the subclass of diagonal-free timed automata, which is sufficient to model many interesting problems. We first define the basic concepts and semantics of diagonal-free timed automata. Based on this, we prove two types of decidability results for the language emptiness problem. The first is the classic result of Alur and Dill [AD90, AD94], which uses a finite partitioning of the state space into so-called `regions`. Our second result focuses on an approach based on `Difference Bound Matrices (DBMs)`, which is practically used by model checkers. We prove the correctness of the basic forward analysis operations on DBMs. One of these operations is the Floyd-Warshall algorithm for the all-pairs shortest paths problem. To obtain a finite search space, a widening operation has to be used for this kind of analysis. We use Patricia Bouyer's [Bou04] approach to prove that this widening operation is correct in the sense that DBM-based forward analysis in combination with the widening operation also decides language emptiness. The interesting property of this proof is that the first decidability result is reused to obtain the second one. notify = wimmers@in.tum.de [Parity_Game] title = Positional Determinacy of Parity Games author = Christoph Dittmann <http://logic.las.tu-berlin.de/Members/Dittmann/> date = 2015-11-02 topic = Mathematics/Games and economics, Mathematics/Graph theory abstract = We present a formalization of parity games (a two-player game on directed graphs) and a proof of their positional determinacy in Isabelle/HOL. This proof works for both finite and infinite games. notify = [Ergodic_Theory] title = Ergodic Theory author = Sebastien Gouezel <mailto:sebastien.gouezel@univ-rennes1.fr> contributors = Manuel Eberl <https://pruvisto.org> date = 2015-12-01 topic = Mathematics/Probability theory abstract = Ergodic theory is the branch of mathematics that studies the behaviour of measure preserving transformations, in finite or infinite measure. It interacts both with probability theory (mainly through measure theory) and with geometry as a lot of interesting examples are from geometric origin. We implement the first definitions and theorems of ergodic theory, including notably Poicaré recurrence theorem for finite measure preserving systems (together with the notion of conservativity in general), induced maps, Kac's theorem, Birkhoff theorem (arguably the most important theorem in ergodic theory), and variations around it such as conservativity of the corresponding skew product, or Atkinson lemma. notify = sebastien.gouezel@univ-rennes1.fr, hoelzl@in.tum.de [Latin_Square] title = Latin Square author = Alexander Bentkamp <mailto:bentkamp@gmail.com> date = 2015-12-02 topic = Mathematics/Combinatorics abstract = A Latin Square is a n x n table filled with integers from 1 to n where each number appears exactly once in each row and each column. A Latin Rectangle is a partially filled n x n table with r filled rows and n-r empty rows, such that each number appears at most once in each row and each column. The main result of this theory is that any Latin Rectangle can be completed to a Latin Square. notify = bentkamp@gmail.com [Deep_Learning] title = Expressiveness of Deep Learning author = Alexander Bentkamp <mailto:bentkamp@gmail.com> date = 2016-11-10 topic = Computer science/Machine learning, Mathematics/Analysis abstract = Deep learning has had a profound impact on computer science in recent years, with applications to search engines, image recognition and language processing, bioinformatics, and more. Recently, Cohen et al. provided theoretical evidence for the superiority of deep learning over shallow learning. This formalization of their work simplifies and generalizes the original proof, while working around the limitations of the Isabelle type system. To support the formalization, I developed reusable libraries of formalized mathematics, including results about the matrix rank, the Lebesgue measure, and multivariate polynomials, as well as a library for tensor analysis. notify = bentkamp@gmail.com [Inductive_Inference] title = Some classical results in inductive inference of recursive functions author = Frank J. Balbach <mailto:frank-balbach@gmx.de> topic = Logic/Computability, Computer science/Machine learning date = 2020-08-31 notify = frank-balbach@gmx.de abstract = This entry formalizes some classical concepts and results from inductive inference of recursive functions. In the basic setting a partial recursive function ("strategy") must identify ("learn") all functions from a set ("class") of recursive functions. To that end the strategy receives more and more values $f(0), f(1), f(2), \ldots$ of some function $f$ from the given class and in turn outputs descriptions of partial recursive functions, for example, Gödel numbers. The strategy is considered successful if the sequence of outputs ("hypotheses") converges to a description of $f$. A class of functions learnable in this sense is called "learnable in the limit". The set of all these classes is denoted by LIM. Other types of inference considered are finite learning (FIN), behaviorally correct learning in the limit (BC), and some variants of LIM with restrictions on the hypotheses: total learning (TOTAL), consistent learning (CONS), and class-preserving learning (CP). The main results formalized are the proper inclusions $\mathrm{FIN} \subset \mathrm{CP} \subset \mathrm{TOTAL} \subset \mathrm{CONS} \subset \mathrm{LIM} \subset \mathrm{BC} \subset 2^{\mathcal{R}}$, where $\mathcal{R}$ is the set of all total recursive functions. Further results show that for all these inference types except CONS, strategies can be assumed to be total recursive functions; that all inference types but CP are closed under the subset relation between classes; and that no inference type is closed under the union of classes. The above is based on a formalization of recursive functions heavily inspired by the <a href="https://www.isa-afp.org/entries/Universal_Turing_Machine.html">Universal Turing Machine</a> entry by Xu et al., but different in that it models partial functions with codomain nat option. The formalization contains a construction of a universal partial recursive function, without resorting to Turing machines, introduces decidability and recursive enumerability, and proves some standard results: existence of a Kleene normal form, the s-m-n theorem, Rice's theorem, and assorted fixed-point theorems (recursion theorems) by Kleene, Rogers, and Smullyan. [Applicative_Lifting] title = Applicative Lifting author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Joshua Schneider <> date = 2015-12-22 topic = Computer science/Functional programming abstract = Applicative functors augment computations with effects by lifting function application to types which model the effects. As the structure of the computation cannot depend on the effects, applicative expressions can be analysed statically. This allows us to lift universally quantified equations to the effectful types, as observed by Hinze. Thus, equational reasoning over effectful computations can be reduced to pure types. This entry provides a package for registering applicative functors and two proof methods for lifting of equations over applicative functors. The first method normalises applicative expressions according to the laws of applicative functors. This way, equations whose two sides contain the same list of variables can be lifted to every applicative functor. To lift larger classes of equations, the second method exploits a number of additional properties (e.g., commutativity of effects) provided the properties have been declared for the concrete applicative functor at hand upon registration. We declare several types from the Isabelle library as applicative functors and illustrate the use of the methods with two examples: the lifting of the arithmetic type class hierarchy to streams and the verification of a relabelling function on binary trees. We also formalise and verify the normalisation algorithm used by the first proof method. extra-history = Change history: [2016-03-03]: added formalisation of lifting with combinators [2016-06-10]: implemented automatic derivation of lifted combinator reductions; support arbitrary lifted relations using relators; improved compatibility with locale interpretation (revision ec336f354f37) notify = mail@andreas-lochbihler.de [Stern_Brocot] title = The Stern-Brocot Tree author = Peter Gammie <http://peteg.org>, Andreas Lochbihler <http://www.andreas-lochbihler.de> date = 2015-12-22 topic = Mathematics/Number theory abstract = The Stern-Brocot tree contains all rational numbers exactly once and in their lowest terms. We formalise the Stern-Brocot tree as a coinductive tree using recursive and iterative specifications, which we have proven equivalent, and show that it indeed contains all the numbers as stated. Following Hinze, we prove that the Stern-Brocot tree can be linearised looplessly into Stern's diatonic sequence (also known as Dijkstra's fusc function) and that it is a permutation of the Bird tree. The reasoning stays at an abstract level by appealing to the uniqueness of solutions of guarded recursive equations and lifting algebraic laws point-wise to trees and streams using applicative functors. notify = mail@andreas-lochbihler.de [Algebraic_Numbers] title = Algebraic Numbers in Isabelle/HOL topic = Mathematics/Algebra author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at> contributors = Manuel Eberl <https://pruvisto.org> date = 2015-12-22 abstract = Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version. To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain. extra-history = Change history: [2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization [2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp, sebastiaan.joosten@uibk.ac.at [Polynomial_Interpolation] title = Polynomial Interpolation topic = Mathematics/Algebra author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> date = 2016-01-29 abstract = We formalized three algorithms for polynomial interpolation over arbitrary fields: Lagrange's explicit expression, the recursive algorithm of Neville and Aitken, and the Newton interpolation in combination with an efficient implementation of divided differences. Variants of these algorithms for integer polynomials are also available, where sometimes the interpolation can fail; e.g., there is no linear integer polynomial p such that p(0) = 0 and p(2) = 1. Moreover, for the Newton interpolation for integer polynomials, we proved that all intermediate results that are computed during the algorithm must be integers. This admits an early failure detection in the implementation. Finally, we proved the uniqueness of polynomial interpolation. The development also contains improved code equations to speed up the division of integers in target languages. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Polynomial_Factorization] title = Polynomial Factorization topic = Mathematics/Algebra author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> date = 2016-01-29 abstract = Based on existing libraries for polynomial interpolation and matrices, we formalized several factorization algorithms for polynomials, including Kronecker's algorithm for integer polynomials, Yun's square-free factorization algorithm for field polynomials, and Berlekamp's algorithm for polynomials over finite fields. By combining the last one with Hensel's lifting, we derive an efficient factorization algorithm for the integer polynomials, which is then lifted for rational polynomials by mechanizing Gauss' lemma. Finally, we assembled a combined factorization algorithm for rational polynomials, which combines all the mentioned algorithms and additionally uses the explicit formula for roots of quadratic polynomials and a rational root test. As side products, we developed division algorithms for polynomials over integral domains, as well as primality-testing and prime-factorization algorithms for integers. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Cubic_Quartic_Equations] title = Solving Cubic and Quartic Equations author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Mathematics/Analysis date = 2021-09-03 notify = rene.thiemann@uibk.ac.at abstract = We formalize Cardano's formula to solve a cubic equation $$ax^3 + bx^2 + cx + d = 0,$$ as well as Ferrari's formula to solve a quartic equation. We further turn both formulas into executable algorithms based on the algebraic number implementation in the AFP. To this end we also slightly extended this library, namely by making the minimal polynomial of an algebraic number executable, and by defining and implementing $n$-th roots of complex numbers. [Perron_Frobenius] title = Perron-Frobenius Theorem for Spectral Radius Analysis author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Ondřej Kunčar <http://www21.in.tum.de/~kuncar/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> notify = rene.thiemann@uibk.ac.at date = 2016-05-20 topic = Mathematics/Algebra abstract = The spectral radius of a matrix A is the maximum norm of all eigenvalues of A. In previous work we already formalized that for a complex matrix A, the values in An grow polynomially in n if and only if the spectral radius is at most one. One problem with the above characterization is the determination of all complex eigenvalues. In case A contains only non-negative real values, a simplification is possible with the help of the Perron–Frobenius theorem, which tells us that it suffices to consider only the real eigenvalues of A, i.e., applying Sturm's method can decide the polynomial growth of An. We formalize the Perron–Frobenius theorem based on a proof via Brouwer's fixpoint theorem, which is available in the HOL multivariate analysis (HMA) library. Since the results on the spectral radius is based on matrices in the Jordan normal form (JNF) library, we further develop a connection which allows us to easily transfer theorems between HMA and JNF. With this connection we derive the combined result: if A is a non-negative real matrix, and no real eigenvalue of A is strictly larger than one, then An is polynomially bounded in n. extra-history = Change history: [2017-10-18]: added Perron-Frobenius theorem for irreducible matrices with generalization (revision bda1f1ce8a1c) [2018-05-17]: prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size (revision ffdb3794e5d5) [Stochastic_Matrices] title = Stochastic Matrices and the Perron-Frobenius Theorem author = René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann> topic = Mathematics/Algebra, Computer science/Automata and formal languages date = 2017-11-22 notify = rene.thiemann@uibk.ac.at abstract = Stochastic matrices are a convenient way to model discrete-time and finite state Markov chains. The Perron–Frobenius theorem tells us something about the existence and uniqueness of non-negative eigenvectors of a stochastic matrix. In this entry, we formalize stochastic matrices, link the formalization to the existing AFP-entry on Markov chains, and apply the Perron–Frobenius theorem to prove that stationary distributions always exist, and they are unique if the stochastic matrix is irreducible. [Formal_SSA] title = Verified Construction of Static Single Assignment Form author = Sebastian Ullrich <mailto:sebasti@nullri.ch>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88> date = 2016-02-05 topic = Computer science/Algorithms, Computer science/Programming languages/Transformations abstract = We define a functional variant of the static single assignment (SSA) form construction algorithm described by <a href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun et al.</a>, which combines simplicity and efficiency. The definition is based on a general, abstract control flow graph representation using Isabelle locales. We prove that the algorithm's output is semantically equivalent to the input according to a small-step semantics, and that it is in minimal SSA form for the common special case of reducible inputs. We then show the satisfiability of the locale assumptions by giving instantiations for a simple While language. Furthermore, we use a generic instantiation based on typedefs in order to extract OCaml code and replace the unverified SSA construction algorithm of the <a href="https://doi.org/10.1145/2579080">CompCertSSA project</a> with it. A more detailed description of the verified SSA construction can be found in the paper <a href="https://doi.org/10.1145/2892208.2892211">Verified Construction of Static Single Assignment Form</a>, CC 2016. notify = denis.lohner@kit.edu [Minimal_SSA] title = Minimal Static Single Assignment Form author = Max Wagner <mailto:max@trollbu.de>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88> topic = Computer science/Programming languages/Transformations date = 2017-01-17 notify = denis.lohner@kit.edu abstract = This formalization is an extension to <a href="https://www.isa-afp.org/entries/Formal_SSA.html">"Verified Construction of Static Single Assignment Form"</a>. In their work, the authors have shown that <a href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun et al.'s static single assignment (SSA) construction algorithm</a> produces minimal SSA form for input programs with a reducible control flow graph (CFG). However Braun et al. also proposed an extension to their algorithm that they claim produces minimal SSA form even for irreducible CFGs. In this formalization we support that claim by giving a mechanized proof. As the extension of Braun et al.'s algorithm aims for removing so-called redundant strongly connected components of phi functions, we show that this suffices to guarantee minimality according to <a href="https://doi.org/10.1145/115372.115320">Cytron et al.</a>. [PropResPI] title = Propositional Resolution and Prime Implicates Generation author = Nicolas Peltier <http://membres-lig.imag.fr/peltier/> notify = Nicolas.Peltier@imag.fr date = 2016-03-11 topic = Logic/General logic/Mechanization of proofs abstract = We provide formal proofs in Isabelle-HOL (using mostly structured Isar proofs) of the soundness and completeness of the Resolution rule in propositional logic. The completeness proofs take into account the usual redundancy elimination rules (tautology elimination and subsumption), and several refinements of the Resolution rule are considered: ordered resolution (with selection functions), positive and negative resolution, semantic resolution and unit resolution (the latter refinement is complete only for clause sets that are Horn- renamable). We also define a concrete procedure for computing saturated sets and establish its soundness and completeness. The clause sets are not assumed to be finite, so that the results can be applied to formulas obtained by grounding sets of first-order clauses (however, a total ordering among atoms is assumed to be given). Next, we show that the unrestricted Resolution rule is deductive- complete, in the sense that it is able to generate all (prime) implicates of any set of propositional clauses (i.e., all entailment- minimal, non-valid, clausal consequences of the considered set). The generation of prime implicates is an important problem, with many applications in artificial intelligence and verification (for abductive reasoning, knowledge compilation, diagnosis, debugging etc.). We also show that implicates can be computed in an incremental way, by fixing an ordering among all the atoms in the considered sets and resolving upon these atoms one by one in the considered order (with no backtracking). This feature is critical for the efficient computation of prime implicates. Building on these results, we provide a procedure for computing such implicates and establish its soundness and completeness. [SuperCalc] title = A Variant of the Superposition Calculus author = Nicolas Peltier <http://membres-lig.imag.fr/peltier/> notify = Nicolas.Peltier@imag.fr date = 2016-09-06 topic = Logic/Proof theory abstract = We provide a formalization of a variant of the superposition calculus, together with formal proofs of soundness and refutational completeness (w.r.t. the usual redundancy criteria based on clause ordering). This version of the calculus uses all the standard restrictions of the superposition rules, together with the following refinement, inspired by the basic superposition calculus: each clause is associated with a set of terms which are assumed to be in normal form -- thus any application of the replacement rule on these terms is blocked. The set is initially empty and terms may be added or removed at each inference step. The set of terms that are assumed to be in normal form includes any term introduced by previous unifiers as well as any term occurring in the parent clauses at a position that is smaller (according to some given ordering on positions) than a previously replaced term. The standard superposition calculus corresponds to the case where the set of irreducible terms is always empty. [Nominal2] title = Nominal 2 author = Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/>, Stefan Berghofer <http://www.in.tum.de/~berghofe>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/users/cek/> date = 2013-02-21 topic = Tools abstract = Dealing with binders, renaming of bound variables, capture-avoiding substitution, etc., is very often a major problem in formal proofs, especially in proofs by structural and rule induction. Nominal Isabelle is designed to make such proofs easy to formalise: it provides an infrastructure for declaring nominal datatypes (that is alpha-equivalence classes) and for defining functions over them by structural recursion. It also provides induction principles that have Barendregt’s variable convention already built in. This entry can be used as a more advanced replacement for HOL/Nominal in the Isabelle distribution. notify = christian.urban@kcl.ac.uk [First_Welfare_Theorem] title = Microeconomics and the First Welfare Theorem author = Julian Parsert <mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/> topic = Mathematics/Games and economics license = LGPL date = 2017-09-01 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Economic activity has always been a fundamental part of society. Due to modern day politics, economic theory has gained even more influence on our lives. Thus we want models and theories to be as precise as possible. This can be achieved using certification with the help of formal proof technology. Hence we will use Isabelle/HOL to construct two economic models, that of the the pure exchange economy and a version of the Arrow-Debreu Model. We will prove that the First Theorem of Welfare Economics holds within both. The theorem is the mathematical formulation of Adam Smith's famous invisible hand and states that a group of self-interested and rational actors will eventually achieve an efficient allocation of goods and services. extra-history = Change history: [2018-06-17]: Added some lemmas and a theory file, also introduced Microeconomics folder. [Noninterference_Sequential_Composition] title = Conservation of CSP Noninterference Security under Sequential Composition author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> date = 2016-04-26 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract = In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the former operation is a process that initially behaves like the first operand, and then like the second operand once the execution of the first one has terminated successfully, as long as it does. This paper formalizes Hoare's definition of sequential composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation, provided that successful termination cannot be affected by confidential events and cannot occur as an alternative to other events in the traces of the first operand. Both of these assumptions are shown, by means of counterexamples, to be necessary for the theorem to hold. notify = pasquale.noce.lavoro@gmail.com [Noninterference_Concurrent_Composition] title = Conservation of CSP Noninterference Security under Concurrent Composition author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> notify = pasquale.noce.lavoro@gmail.com date = 2016-06-13 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract = In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the latter operation is a process in which any event not shared by both operands can occur whenever the operand that admits the event can engage in it, whereas any event shared by both operands can occur just in case both can engage in it. This paper formalizes Hoare's definition of concurrent composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation. This result, along with the previous analogous one concerning sequential composition, enables the construction of more and more complex processes enforcing noninterference security by composing, sequentially or concurrently, simpler secure processes, whose security can in turn be proven using either the definition of security, or unwinding theorems. [ROBDD] title = Algorithms for Reduced Ordered Binary Decision Diagrams author = Julius Michaelis <http://liftm.de>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck//>, Peter Lammich <http://www21.in.tum.de/~lammich>, Lars Hupel <https://www21.in.tum.de/~hupel/> date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Data structures abstract = We present a verified and executable implementation of ROBDDs in Isabelle/HOL. Our implementation relates pointer-based computation in the Heap monad to operations on an abstract definition of boolean functions. Internally, we implemented the if-then-else combinator in a recursive fashion, following the Shannon decomposition of the argument functions. The implementation mixes and adapts known techniques and is built with efficiency in mind. notify = bdd@liftm.de, haslbecm@in.tum.de [No_FTL_observers] title = No Faster-Than-Light Observers author = Mike Stannett <mailto:m.stannett@sheffield.ac.uk>, István Németi <http://www.renyi.hu/~nemeti/> date = 2016-04-28 topic = Mathematics/Physics abstract = We provide a formal proof within First Order Relativity Theory that no observer can travel faster than the speed of light. Originally reported in Stannett & Németi (2014) "Using Isabelle/HOL to verify first-order relativity theory", Journal of Automated Reasoning 52(4), pp. 361-378. notify = m.stannett@sheffield.ac.uk [Schutz_Spacetime] title = Schutz' Independent Axioms for Minkowski Spacetime author = Richard Schmoetten <mailto:s1311325@sms.ed.ac.uk>, Jake Palmer <mailto:jake.palmer@ed.ac.uk>, Jacques Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html> topic = Mathematics/Physics, Mathematics/Geometry date = 2021-07-27 notify = s1311325@sms.ed.ac.uk abstract = This is a formalisation of Schutz' system of axioms for Minkowski spacetime published under the name "Independent axioms for Minkowski space-time" in 1997, as well as most of the results in the third chapter ("Temporal Order on a Path") of the above monograph. Many results are proven here that cannot be found in Schutz, either preceding the theorem they are needed for, or within their own thematic section. [Real_Power] title = Real Exponents as the Limits of Sequences of Rational Exponents author = Jacques D. Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html> topic = Mathematics/Analysis date = 2021-11-08 notify = jdf@ed.ac.uk abstract = In this formalisation, we construct real exponents as the limits of sequences of rational exponents. In particular, if $a \ge 1$ and $x \in \mathbb{R}$, we choose an increasing rational sequence $r_n$ such that $\lim_{n\to\infty} {r_n} = x$. Then the sequence $a^{r_n}$ is increasing and if $r$ is any rational number such that $r > x$, $a^{r_n}$ is bounded above by $a^r$. By the convergence criterion for monotone sequences, $a^{r_n}$ converges. We define $a^ x = \lim_{n\to\infty} a^{r_n}$ and show that it has the expected properties (for $a \ge 0$). This particular construction of real exponents is needed instead of the usual one using the natural logarithm and exponential functions (which already exists in Isabelle) to support our mechanical derivation of Euler's exponential series as an ``infinite polynomial". Aside from helping us avoid circular reasoning, this is, as far as we are aware, the first time real exponents are mechanised in this way within a proof assistant. [Groebner_Bases] title = Gröbner Bases Theory author = Fabian Immler <http://www21.in.tum.de/~immler>, Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/> date = 2016-05-02 topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical abstract = This formalization is concerned with the theory of Gröbner bases in (commutative) multivariate polynomial rings over fields, originally developed by Buchberger in his 1965 PhD thesis. Apart from the statement and proof of the main theorem of the theory, the formalization also implements Buchberger's algorithm for actually computing Gröbner bases as a tail-recursive function, thus allowing to effectively decide ideal membership in finitely generated polynomial ideals. Furthermore, all functions can be executed on a concrete representation of multivariate polynomials as association lists. extra-history = Change history: [2019-04-18]: Specialized Gröbner bases to less abstract representation of polynomials, where power-products are represented as polynomial mappings. notify = alexander.maletzky@risc.jku.at [Nullstellensatz] title = Hilbert's Nullstellensatz author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/> topic = Mathematics/Algebra, Mathematics/Geometry date = 2019-06-16 notify = alexander.maletzky@risc-software.at abstract = This entry formalizes Hilbert's Nullstellensatz, an important theorem in algebraic geometry that can be viewed as the generalization of the Fundamental Theorem of Algebra to multivariate polynomials: If a set of (multivariate) polynomials over an algebraically closed field has no common zero, then the ideal it generates is the entire polynomial ring. The formalization proves several equivalent versions of this celebrated theorem: the weak Nullstellensatz, the strong Nullstellensatz (connecting algebraic varieties and radical ideals), and the field-theoretic Nullstellensatz. The formalization follows Chapter 4.1. of <a href="https://link.springer.com/book/10.1007/978-0-387-35651-8">Ideals, Varieties, and Algorithms</a> by Cox, Little and O'Shea. [Bell_Numbers_Spivey] title = Spivey's Generalized Recurrence for Bell Numbers author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> date = 2016-05-04 topic = Mathematics/Combinatorics abstract = This entry defines the Bell numbers as the cardinality of set partitions for a carrier set of given size, and derives Spivey's generalized recurrence relation for Bell numbers following his elegant and intuitive combinatorial proof. As the set construction for the combinatorial proof requires construction of three intermediate structures, the main difficulty of the formalization is handling the overall combinatorial argument in a structured way. The introduced proof structure allows us to compose the combinatorial argument from its subparts, and supports to keep track how the detailed proof steps are related to the overall argument. To obtain this structure, this entry uses set monad notation for the set construction's definition, introduces suitable predicates and rules, and follows a repeating structure in its Isar proof. notify = lukas.bulwahn@gmail.com [Randomised_Social_Choice] title = Randomised Social Choice Theory author = Manuel Eberl <mailto:manuel@pruvisto.org> date = 2016-05-05 topic = Mathematics/Games and economics abstract = This work contains a formalisation of basic Randomised Social Choice, including Stochastic Dominance and Social Decision Schemes (SDSs) along with some of their most important properties (Anonymity, Neutrality, ex-post- and SD-Efficiency, SD-Strategy-Proofness) and two particular SDSs – Random Dictatorship and Random Serial Dictatorship (with proofs of the properties that they satisfy). Many important properties of these concepts are also proven – such as the two equivalent characterisations of Stochastic Dominance and the fact that SD-efficiency of a lottery only depends on the support. The entry also provides convenient commands to define Preference Profiles, prove their well-formedness, and automatically derive restrictions that sufficiently nice SDSs need to satisfy on the defined profiles. Currently, the formalisation focuses on weak preferences and Stochastic Dominance, but it should be easy to extend it to other domains – such as strict preferences – or other lottery extensions – such as Bilinear Dominance or Pairwise Comparison. notify = manuel@pruvisto.org [SDS_Impossibility] title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness author = Manuel Eberl <mailto:manuel@pruvisto.org> date = 2016-05-04 topic = Mathematics/Games and economics abstract = This formalisation contains the proof that there is no anonymous and neutral Social Decision Scheme for at least four voters and alternatives that fulfils both SD-Efficiency and SD-Strategy- Proofness. The proof is a fully structured and quasi-human-redable one. It was derived from the (unstructured) SMT proof of the case for exactly four voters and alternatives by Brandl et al. Their proof relies on an unverified translation of the original problem to SMT, and the proof that lifts the argument for exactly four voters and alternatives to the general case is also not machine-checked. In this Isabelle proof, on the other hand, all of these steps are fully proven and machine-checked. This is particularly important seeing as a previously published informal proof of a weaker statement contained a mistake in precisely this lifting step. notify = manuel@pruvisto.org [Median_Of_Medians_Selection] title = The Median-of-Medians Selection Algorithm author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Algorithms date = 2017-12-21 notify = manuel@pruvisto.org abstract = This entry provides an executable functional implementation of the Median-of-Medians algorithm for selecting the k-th smallest element of an unsorted list deterministically in linear time. The size bounds for the recursive call that lead to the linear upper bound on the run-time of the algorithm are also proven. [Mason_Stothers] title = The Mason–Stothers Theorem author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Algebra date = 2017-12-21 notify = manuel@pruvisto.org abstract = This article provides a formalisation of Snyder’s simple and elegant proof of the Mason–Stothers theorem, which is the polynomial analogue of the famous abc Conjecture for integers. Remarkably, Snyder found this very elegant proof when he was still a high-school student. In short, the statement of the theorem is that three non-zero coprime polynomials A, B, C over a field which sum to 0 and do not all have vanishing derivatives fulfil max{deg(A), deg(B), deg(C)} < deg(rad(ABC)) where the rad(P) denotes the radical of P, i. e. the product of all unique irreducible factors of P. This theorem also implies a kind of polynomial analogue of Fermat’s Last Theorem for polynomials: except for trivial cases, An + Bn + Cn = 0 implies n ≤ 2 for coprime polynomials A, B, C over a field. [FLP] title = A Constructive Proof for FLP author = Benjamin Bisping <mailto:benjamin.bisping@campus.tu-berlin.de>, Paul-David Brodmann <mailto:p.brodmann@tu-berlin.de>, Tim Jungnickel <mailto:tim.jungnickel@tu-berlin.de>, Christina Rickmann <mailto:c.rickmann@tu-berlin.de>, Henning Seidler <mailto:henning.seidler@mailbox.tu-berlin.de>, Anke Stüber <mailto:anke.stueber@campus.tu-berlin.de>, Arno Wilhelm-Weidner <mailto:arno.wilhelm-weidner@tu-berlin.de>, Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Uwe Nestmann <https://www.mtv.tu-berlin.de/nestmann/> date = 2016-05-18 topic = Computer science/Concurrency abstract = The impossibility of distributed consensus with one faulty process is a result with important consequences for real world distributed systems e.g., commits in replicated databases. Since proofs are not immune to faults and even plausible proofs with a profound formalism can conclude wrong results, we validate the fundamental result named FLP after Fischer, Lynch and Paterson. We present a formalization of distributed systems and the aforementioned consensus problem. Our proof is based on Hagen Völzer's paper "A constructive proof for FLP". In addition to the enhanced confidence in the validity of Völzer's proof, we contribute the missing gaps to show the correctness in Isabelle/HOL. We clarify the proof details and even prove fairness of the infinite execution that contradicts consensus. Our Isabelle formalization can also be reused for further proofs of properties of distributed systems. notify = henning.seidler@mailbox.tu-berlin.de [IMAP-CRDT] title = The IMAP CmRDT author = Tim Jungnickel <mailto:tim.jungnickel@tu-berlin.de>, Lennart Oldenburg <>, Matthias Loibl <> topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2017-11-09 notify = tim.jungnickel@tu-berlin.de abstract = We provide our Isabelle/HOL formalization of a Conflict-free Replicated Datatype for Internet Message Access Protocol commands. We show that Strong Eventual Consistency (SEC) is guaranteed by proving the commutativity of concurrent operations. We base our formalization on the recently proposed "framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes" (AFP.CRDT) from Gomes et al. Hence, we provide an additional example of how the recently proposed framework can be used to design and prove CRDTs. [Incredible_Proof_Machine] title = The meta theory of the Incredible Proof Machine author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88> date = 2016-05-20 topic = Logic/Proof theory abstract = The <a href="http://incredible.pm">Incredible Proof Machine</a> is an interactive visual theorem prover which represents proofs as port graphs. We model this proof representation in Isabelle, and prove that it is just as powerful as natural deduction. notify = mail@joachim-breitner.de [Word_Lib] title = Finite Machine Word Library author = Joel Beeren<>, Matthew Fernandez<>, Xin Gao<>, Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/>, Rafal Kolanski<>, Japheth Lim<>, Corey Lewis<>, Daniel Matichuk<>, Thomas Sewell<> notify = kleing@unsw.edu.au date = 2016-06-09 topic = Computer science/Data structures abstract = This entry contains an extension to the Isabelle library for fixed-width machine words. In particular, the entry adds quickcheck setup for words, printing as hexadecimals, additional operations, reasoning about alignment, signed words, enumerations of words, normalisation of word numerals, and an extensive library of properties about generic fixed-width words, as well as an instantiation of many of these to the commonly used 32 and 64-bit bases. [Catalan_Numbers] title = Catalan Numbers author = Manuel Eberl <https://pruvisto.org> notify = manuel@pruvisto.org date = 2016-06-21 topic = Mathematics/Combinatorics abstract = In this work, we define the Catalan numbers Cn and prove several equivalent definitions (including some closed-form formulae). We also show one of their applications (counting the number of binary trees of size n), prove the asymptotic growth approximation Cn ∼ 4n / (√π · n1.5), and provide reasonably efficient executable code to compute them. The derivation of the closed-form formulae uses algebraic manipulations of the ordinary generating function of the Catalan numbers, and the asymptotic approximation is then done using generalised binomial coefficients and the Gamma function. Thanks to these highly non-elementary mathematical tools, the proofs are very short and simple. [Fisher_Yates] title = Fisher–Yates shuffle author = Manuel Eberl <https://pruvisto.org> notify = manuel@pruvisto.org date = 2016-09-30 topic = Computer science/Algorithms abstract = This work defines and proves the correctness of the Fisher–Yates algorithm for shuffling – i.e. producing a random permutation – of a list. The algorithm proceeds by traversing the list and in each step swapping the current element with a random element from the remaining list. [Bertrands_Postulate] title = Bertrand's postulate author = Julian Biendarra<>, Manuel Eberl <https://pruvisto.org> contributors = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Number theory date = 2017-01-17 notify = manuel@pruvisto.org abstract = Bertrand's postulate is an early result on the distribution of prime numbers: For every positive integer n, there exists a prime number that lies strictly between n and 2n. The proof is ported from John Harrison's formalisation in HOL Light. It proceeds by first showing that the property is true for all n greater than or equal to 600 and then showing that it also holds for all n below 600 by case distinction. [Rewriting_Z] title = The Z Property author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel <mailto:c.sternagel@gmail.com> notify = bertram.felgenhauer@uibk.ac.at, julian.nagele@uibk.ac.at, c.sternagel@gmail.com date = 2016-06-30 topic = Logic/Rewriting abstract = We formalize the Z property introduced by Dehornoy and van Oostrom. First we show that for any abstract rewrite system, Z implies confluence. Then we give two examples of proofs using Z: confluence of lambda-calculus with respect to beta-reduction and confluence of combinatory logic. [Resolution_FOL] title = The Resolution Calculus for First-Order Logic author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/> notify = andschl@dtu.dk date = 2016-06-30 topic = Logic/General logic/Mechanization of proofs abstract = This theory is a formalization of the resolution calculus for first-order logic. It is proven sound and complete. The soundness proof uses the substitution lemma, which shows a correspondence between substitutions and updates to an environment. The completeness proof uses semantic trees, i.e. trees whose paths are partial Herbrand interpretations. It employs Herbrand's theorem in a formulation which states that an unsatisfiable set of clauses has a finite closed semantic tree. It also uses the lifting lemma which lifts resolution derivation steps from the ground world up to the first-order world. The theory is presented in a paper in the Journal of Automated Reasoning [Sch18] which extends a paper presented at the International Conference on Interactive Theorem Proving [Sch16]. An earlier version was presented in an MSc thesis [Sch15]. The formalization mostly follows textbooks by Ben-Ari [BA12], Chang and Lee [CL73], and Leitsch [Lei97]. The theory is part of the IsaFoL project [IsaFoL]. <a name="Sch18"></a>[Sch18] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". Journal of Automated Reasoning, 2018. <a name="Sch16"></a>[Sch16] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016. <a name="Sch15"></a>[Sch15] Anders Schlichtkrull. <a href="https://people.compute.dtu.dk/andschl/Thesis.pdf"> "Formalization of Resolution Calculus in Isabelle"</a>. <a href="https://people.compute.dtu.dk/andschl/Thesis.pdf">https://people.compute.dtu.dk/andschl/Thesis.pdf</a>. MSc thesis. Technical University of Denmark, 2015. <a name="BA12"></a>[BA12] Mordechai Ben-Ari. Mathematical Logic for Computer Science. 3rd. Springer, 2012. <a name="CL73"></a>[CL73] Chin-Liang Chang and Richard Char-Tung Lee. Symbolic Logic and Mechanical Theorem Proving. 1st. Academic Press, Inc., 1973. <a name="Lei97"></a>[Lei97] Alexander Leitsch. The Resolution Calculus. Texts in theoretical computer science. Springer, 1997. <a name="IsaFoL"></a>[IsaFoL] IsaFoL authors. <a href="https://bitbucket.org/jasmin_blanchette/isafol"> IsaFoL: Isabelle Formalization of Logic</a>. <a href="https://bitbucket.org/jasmin_blanchette/isafol">https://bitbucket.org/jasmin_blanchette/isafol</a>. extra-history = Change history: [2018-01-24]: added several new versions of the soundness and completeness theorems as described in the paper [Sch18]. [2018-03-20]: added a concrete instance of the unification and completeness theorems using the First-Order Terms AFP-entry from IsaFoR as described in the papers [Sch16] and [Sch18]. [Surprise_Paradox] title = Surprise Paradox author = Joachim Breitner <http://pp.ipd.kit.edu/~breitner> notify = mail@joachim-breitner.de date = 2016-07-17 topic = Logic/Proof theory abstract = In 1964, Fitch showed that the paradox of the surprise hanging can be resolved by showing that the judge’s verdict is inconsistent. His formalization builds on Gödel’s coding of provability. In this theory, we reproduce his proof in Isabelle, building on Paulson’s formalisation of Gödel’s incompleteness theorems. [Ptolemys_Theorem] title = Ptolemy's Theorem author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> notify = lukas.bulwahn@gmail.com date = 2016-08-07 topic = Mathematics/Geometry abstract = This entry provides an analytic proof to Ptolemy's Theorem using polar form transformation and trigonometric identities. In this formalization, we use ideas from John Harrison's HOL Light formalization and the proof sketch on the Wikipedia entry of Ptolemy's Theorem. This theorem is the 95th theorem of the Top 100 Theorems list. [Falling_Factorial_Sum] title = The Falling Factorial of a Sum author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> topic = Mathematics/Combinatorics date = 2017-12-22 notify = lukas.bulwahn@gmail.com abstract = This entry shows that the falling factorial of a sum can be computed with an expression using binomial coefficients and the falling factorial of its summands. The entry provides three different proofs: a combinatorial proof, an induction proof and an algebraic proof using the Vandermonde identity. The three formalizations try to follow their informal presentations from a Mathematics Stack Exchange page as close as possible. The induction and algebraic formalization end up to be very close to their informal presentation, whereas the combinatorial proof first requires the introduction of list interleavings, and significant more detail than its informal presentation. [InfPathElimination] title = Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths author = Romain Aissat<>, Frederic Voisin<>, Burkhart Wolff <mailto:wolff@lri.fr> notify = wolff@lri.fr date = 2016-08-18 topic = Computer science/Programming languages/Static analysis abstract = TRACER is a tool for verifying safety properties of sequential C programs. TRACER attempts at building a finite symbolic execution graph which over-approximates the set of all concrete reachable states and the set of feasible paths. We present an abstract framework for TRACER and similar CEGAR-like systems. The framework provides 1) a graph- transformation based method for reducing the feasible paths in control-flow graphs, 2) a model for symbolic execution, subsumption, predicate abstraction and invariant generation. In this framework we formally prove two key properties: correct construction of the symbolic states and preservation of feasible paths. The framework focuses on core operations, leaving to concrete prototypes to “fit in” heuristics for combining them. The accompanying paper (published in ITP 2016) can be found at https://www.lri.fr/∼wolff/papers/conf/2016-itp-InfPathsNSE.pdf. [Stirling_Formula] title = Stirling's formula author = Manuel Eberl <https://pruvisto.org> notify = manuel@pruvisto.org date = 2016-09-01 topic = Mathematics/Analysis abstract = This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by <a href="http://www.maths.lancs.ac.uk/~jameson/stirlgamma.pdf">Graham Jameson</a>. This is then extended to the full asymptotic expansion $$\log\Gamma(z) = \big(z - \tfrac{1}{2}\big)\log z - z + \tfrac{1}{2}\log(2\pi) + \sum_{k=1}^{n-1} \frac{B_{k+1}}{k(k+1)} z^{-k}\\ {} - \frac{1}{n} \int_0^\infty B_n([t])(t + z)^{-n}\,\text{d}t$$ uniformly for all complex $z\neq 0$ in the cone $\text{arg}(z)\leq \alpha$ for any $\alpha\in(0,\pi)$, with which the above asymptotic relation for Γ is also extended to complex arguments. [Lp] title = Lp spaces author = Sebastien Gouezel <http://www.math.sciences.univ-nantes.fr/~gouezel/> notify = sebastien.gouezel@univ-rennes1.fr date = 2016-10-05 topic = Mathematics/Analysis abstract = Lp is the space of functions whose p-th power is integrable. It is one of the most fundamental Banach spaces that is used in analysis and probability. We develop a framework for function spaces, and then implement the Lp spaces in this framework using the existing integration theory in Isabelle/HOL. Our development contains most fundamental properties of Lp spaces, notably the Hölder and Minkowski inequalities, completeness of Lp, duality, stability under almost sure convergence, multiplication of functions in Lp and Lq, stability under conditional expectation. [Berlekamp_Zassenhaus] title = The Factorization Algorithm of Berlekamp and Zassenhaus author = Jose Divasón <http://www.unirioja.es/cu/jodivaso>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at> notify = rene.thiemann@uibk.ac.at date = 2016-10-14 topic = Mathematics/Algebra abstract = We formalize the Berlekamp-Zassenhaus algorithm for factoring square-free integer polynomials in Isabelle/HOL. We further adapt an existing formalization of Yun’s square-free factorization algorithm to integer polynomials, and thus provide an efficient and certified factorization algorithm for arbitrary univariate polynomials. The algorithm first performs a factorization in the prime field GF(p) and then performs computations in the integer ring modulo p^k, where both p and k are determined at runtime. Since a natural modeling of these structures via dependent types is not possible in Isabelle/HOL, we formalize the whole algorithm using Isabelle’s recent addition of local type definitions. Through experiments we verify that our algorithm factors polynomials of degree 100 within seconds. [Allen_Calculus] title = Allen's Interval Calculus author = Fadoua Ghourabi <> notify = fadouaghourabi@gmail.com date = 2016-09-29 topic = Logic/General logic/Temporal logic, Mathematics/Order abstract = Allen’s interval calculus is a qualitative temporal representation of time events. Allen introduced 13 binary relations that describe all the possible arrangements between two events, i.e. intervals with non-zero finite length. The compositions are pertinent to reasoning about knowledge of time. In particular, a consistency problem of relation constraints is commonly solved with a guideline from these compositions. We formalize the relations together with an axiomatic system. We proof the validity of the 169 compositions of these relations. We also define nests as the sets of intervals that share a meeting point. We prove that nests give the ordering properties of points without introducing a new datatype for points. [1] J.F. Allen. Maintaining Knowledge about Temporal Intervals. In Commun. ACM, volume 26, pages 832–843, 1983. [2] J. F. Allen and P. J. Hayes. A Common-sense Theory of Time. In Proceedings of the 9th International Joint Conference on Artificial Intelligence (IJCAI’85), pages 528–531, 1985. [Source_Coding_Theorem] title = Source Coding Theorem author = Quentin Hibon <mailto:qh225@cl.cam.ac.uk>, Lawrence C. Paulson <mailto:lp15@cam.ac.uk> notify = qh225@cl.cam.ac.uk date = 2016-10-19 topic = Mathematics/Probability theory abstract = This document contains a proof of the necessary condition on the code rate of a source code, namely that this code rate is bounded by the entropy of the source. This represents one half of Shannon's source coding theorem, which is itself an equivalence. [Buffons_Needle] title = Buffon's Needle Problem author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Probability theory, Mathematics/Geometry date = 2017-06-06 notify = manuel@pruvisto.org abstract = In the 18th century, Georges-Louis Leclerc, Comte de Buffon posed and later solved the following problem, which is often called the first problem ever solved in geometric probability: Given a floor divided into vertical strips of the same width, what is the probability that a needle thrown onto the floor randomly will cross two strips? This entry formally defines the problem in the case where the needle's position is chosen uniformly at random in a single strip around the origin (which is equivalent to larger arrangements due to symmetry). It then provides proofs of the simple solution in the case where the needle's length is no greater than the width of the strips and the more complicated solution in the opposite case. [SPARCv8] title = A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor author = Zhe Hou <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Yang Liu <mailto:yangliu@ntu.edu.sg> notify = zhe.hou@ntu.edu.sg, sanan@ntu.edu.sg date = 2016-10-19 topic = Computer science/Security, Computer science/Hardware abstract = We formalise the SPARCv8 instruction set architecture (ISA) which is used in processors such as LEON3. Our formalisation can be specialised to any SPARCv8 CPU, here we use LEON3 as a running example. Our model covers the operational semantics for all the instructions in the integer unit of the SPARCv8 architecture and it supports Isabelle code export, which effectively turns the Isabelle model into a SPARCv8 CPU simulator. We prove the language-based non-interference property for the LEON3 processor. Our model is based on deterministic monad, which is a modified version of the non-deterministic monad from NICTA/l4v. [Separata] title = Separata: Isabelle tactics for Separation Algebra author = Zhe Hou <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Rajeev Gore <mailto:rajeev.gore@anu.edu.au>, Ranald Clouston <mailto:ranald.clouston@cs.au.dk> notify = zhe.hou@ntu.edu.sg date = 2016-11-16 topic = Computer science/Programming languages/Logics, Tools abstract = We bring the labelled sequent calculus $LS_{PASL}$ for propositional abstract separation logic to Isabelle. The tactics given here are directly applied on an extension of the Separation Algebra in the AFP. In addition to the cancellative separation algebra, we further consider some useful properties in the heap model of separation logic, such as indivisible unit, disjointness, and cross-split. The tactics are essentially a proof search procedure for the calculus $LS_{PASL}$. We wrap the tactics in an Isabelle method called separata, and give a few examples of separation logic formulae which are provable by separata. [LOFT] title = LOFT — Verified Migration of Linux Firewalls to SDN author = Julius Michaelis <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~diekmann> notify = isabelleopenflow@liftm.de date = 2016-10-21 topic = Computer science/Networks abstract = We present LOFT — Linux firewall OpenFlow Translator, a system that transforms the main routing table and FORWARD chain of iptables of a Linux-based firewall into a set of static OpenFlow rules. Our implementation is verified against a model of a simplified Linux-based router and we can directly show how much of the original functionality is preserved. [Stable_Matching] title = Stable Matching author = Peter Gammie <http://peteg.org> notify = peteg42@gmail.com date = 2016-10-24 topic = Mathematics/Games and economics abstract = We mechanize proofs of several results from the matching with contracts literature, which generalize those of the classical two-sided matching scenarios that go by the name of stable marriage. Our focus is on game theoretic issues. Along the way we develop executable algorithms for computing optimal stable matches. [Modal_Logics_for_NTS] title = Modal Logics for Nominal Transition Systems author = Tjark Weber <mailto:tjark.weber@it.uu.se>, Lars-Henrik Eriksson <mailto:lhe@it.uu.se>, Joachim Parrow <mailto:joachim.parrow@it.uu.se>, Johannes Borgström <mailto:johannes.borgstrom@it.uu.se>, Ramunas Gutkovas <mailto:ramunas.gutkovas@it.uu.se> notify = tjark.weber@it.uu.se date = 2016-10-25 topic = Computer science/Concurrency/Process calculi, Logic/General logic/Modal logic abstract = We formalize a uniform semantic substrate for a wide variety of process calculi where states and action labels can be from arbitrary nominal sets. A Hennessy-Milner logic for these systems is defined, and proved adequate for bisimulation equivalence. A main novelty is the construction of an infinitary nominal data type to model formulas with (finitely supported) infinite conjunctions and actions that may contain binding names. The logic is generalized to treat different bisimulation variants such as early, late and open in a systematic way. extra-history = Change history: [2017-01-29]: Formalization of weak bisimilarity added (revision c87cc2057d9c) [Abs_Int_ITP2012] title = Abstract Interpretation of Annotated Commands author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> notify = nipkow@in.tum.de date = 2016-11-23 topic = Computer science/Programming languages/Static analysis abstract = This is the Isabelle formalization of the material decribed in the eponymous <a href="https://doi.org/10.1007/978-3-642-32347-8_9">ITP 2012 paper</a>. It develops a generic abstract interpreter for a while-language, including widening and narrowing. The collecting semantics and the abstract interpreter operate on annotated commands: the program is represented as a syntax tree with the semantic information directly embedded, without auxiliary labels. The aim of the formalization is simplicity, not efficiency or precision. This is motivated by the inclusion of the material in a theorem prover based course on semantics. A similar (but more polished) development is covered in the book <a href="https://doi.org/10.1007/978-3-319-10542-0">Concrete Semantics</a>. [Complx] title = COMPLX: A Verification Framework for Concurrent Imperative Programs author = Sidney Amani<>, June Andronick<>, Maksym Bortin<>, Corey Lewis<>, Christine Rizkallah<>, Joseph Tuong<> notify = sidney.amani@data61.csiro.au, corey.lewis@data61.csiro.au date = 2016-11-29 topic = Computer science/Programming languages/Logics, Computer science/Programming languages/Language definitions abstract = We propose a concurrency reasoning framework for imperative programs, based on the Owicki-Gries (OG) foundational shared-variable concurrency method. Our framework combines the approaches of Hoare-Parallel, a formalisation of OG in Isabelle/HOL for a simple while-language, and Simpl, a generic imperative language embedded in Isabelle/HOL, allowing formal reasoning on C programs. We define the Complx language, extending the syntax and semantics of Simpl with support for parallel composition and synchronisation. We additionally define an OG logic, which we prove sound w.r.t. the semantics, and a verification condition generator, both supporting involved low-level imperative constructs such as function calls and abrupt termination. We illustrate our framework on an example that features exceptions, guards and function calls. We aim to then target concurrent operating systems, such as the interruptible eChronos embedded operating system for which we already have a model-level OG proof using Hoare-Parallel. extra-history = Change history: [2017-01-13]: Improve VCG for nested parallels and sequential sections (revision 30739dbc3dcb) [Paraconsistency] title = Paraconsistency author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/> topic = Logic/General logic/Paraconsistent logics date = 2016-12-07 notify = andschl@dtu.dk, jovi@dtu.dk abstract = Paraconsistency is about handling inconsistency in a coherent way. In classical and intuitionistic logic everything follows from an inconsistent theory. A paraconsistent logic avoids the explosion. Quite a few applications in computer science and engineering are discussed in the Intelligent Systems Reference Library Volume 110: Towards Paraconsistent Engineering (Springer 2016). We formalize a paraconsistent many-valued logic that we motivated and described in a special issue on logical approaches to paraconsistency (Journal of Applied Non-Classical Logics 2005). We limit ourselves to the propositional fragment of the higher-order logic. The logic is based on so-called key equalities and has a countably infinite number of truth values. We prove theorems in the logic using the definition of validity. We verify truth tables and also counterexamples for non-theorems. We prove meta-theorems about the logic and finally we investigate a case study. [Proof_Strategy_Language] title = Proof Strategy Language author = Yutaka Nagashima<> topic = Tools date = 2016-12-20 notify = Yutaka.Nagashima@data61.csiro.au abstract = Isabelle includes various automatic tools for finding proofs under certain conditions. However, for each conjecture, knowing which automation to use, and how to tweak its parameters, is currently labour intensive. We have developed a language, PSL, designed to capture high level proof strategies. PSL offloads the construction of human-readable fast-to-replay proof scripts to automatic search, making use of search-time information about each conjecture. Our preliminary evaluations show that PSL reduces the labour cost of interactive theorem proving. This submission contains the implementation of PSL and an example theory file, Example.thy, showing how to write poof strategies in PSL. [Concurrent_Ref_Alg] title = Concurrent Refinement Algebra and Rely Quotients author = Julian Fell <mailto:julian.fell@uq.net.au>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Andrius Velykis <http://andrius.velykis.lt> topic = Computer science/Concurrency date = 2016-12-30 notify = Ian.Hayes@itee.uq.edu.au abstract = The concurrent refinement algebra developed here is designed to provide a foundation for rely/guarantee reasoning about concurrent programs. The algebra builds on a complete lattice of commands by providing sequential composition, parallel composition and a novel weak conjunction operator. The weak conjunction operator coincides with the lattice supremum providing its arguments are non-aborting, but aborts if either of its arguments do. Weak conjunction provides an abstract version of a guarantee condition as a guarantee process. We distinguish between models that distribute sequential composition over non-deterministic choice from the left (referred to as being conjunctive in the refinement calculus literature) and those that don't. Least and greatest fixed points of monotone functions are provided to allow recursion and iteration operators to be added to the language. Additional iteration laws are available for conjunctive models. The rely quotient of processes c and i is the process that, if executed in parallel with i implements c. It represents an abstract version of a rely condition generalised to a process. [FOL_Harrison] title = First-Order Logic According to Harrison author = Alexander Birch Jensen <https://people.compute.dtu.dk/aleje/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/> topic = Logic/General logic/Mechanization of proofs date = 2017-01-01 notify = aleje@dtu.dk, andschl@dtu.dk, jovi@dtu.dk abstract = We present a certified declarative first-order prover with equality based on John Harrison's Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009. ML code reflection is used such that the entire prover can be executed within Isabelle as a very simple interactive proof assistant. As examples we consider Pelletier's problems 1-46. Reference: Programming and Verifying a Declarative First-Order Prover in Isabelle/HOL. Alexander Birch Jensen, John Bruntse Larsen, Anders Schlichtkrull & Jørgen Villadsen. AI Communications 31:281-299 2018. <a href="https://content.iospress.com/articles/ai-communications/aic764"> https://content.iospress.com/articles/ai-communications/aic764</a> See also: Students' Proof Assistant (SPA). <a href=https://github.com/logic-tools/spa> https://github.com/logic-tools/spa</a> extra-history = Change history: [2018-07-21]: Proof of Pelletier's problem 34 (Andrews's Challenge) thanks to Asta Halkjær From. [Bernoulli] title = Bernoulli Numbers author = Lukas Bulwahn<mailto:lukas.bulwahn@gmail.com>, Manuel Eberl <https://pruvisto.org> topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-24 notify = manuel@pruvisto.org abstract = Bernoulli numbers were first discovered in the closed-form expansion of the sum 1m + 2m + … + nm for a fixed m and appear in many other places. This entry provides three different definitions for them: a recursive one, an explicit one, and one through their exponential generating function. In addition, we prove some basic facts, e.g. their relation to sums of powers of integers and that all odd Bernoulli numbers except the first are zero, and some advanced facts like their relationship to the Riemann zeta function on positive even integers. We also prove the correctness of the Akiyama–Tanigawa algorithm for computing Bernoulli numbers with reasonable efficiency, and we define the periodic Bernoulli polynomials (which appear e.g. in the Euler–MacLaurin summation formula and the expansion of the log-Gamma function) and prove their basic properties. [Stone_Relation_Algebras] title = Stone Relation Algebras author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Mathematics/Algebra date = 2017-02-07 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone relation algebras, which generalise relation algebras by replacing the underlying Boolean algebra structure with a Stone algebra. We show that finite matrices over extended real numbers form an instance. As a consequence, relation-algebraic concepts and methods can be used for reasoning about weighted graphs. We also develop a fixpoint calculus and apply it to compare different definitions of reflexive-transitive closures in semirings. extra-history = Change history: [2017-07-05]: generalised extended reals to linear orders (revision b8e703159177) [Stone_Kleene_Relation_Algebras] title = Stone-Kleene Relation Algebras author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Mathematics/Algebra date = 2017-07-06 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone-Kleene relation algebras, which expand Stone relation algebras with a Kleene star operation to describe reachability in weighted graphs. Many properties of the Kleene star arise as a special case of a more general theory of iteration based on Conway semirings extended by simulation axioms. This includes several theorems representing complex program transformations. We formally prove the correctness of Conway's automata-based construction of the Kleene star of a matrix. We prove numerous results useful for reasoning about weighted graphs. [Abstract_Soundness] title = Abstract Soundness author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2017-02-10 notify = jasmin.blanchette@gmail.com abstract = A formalized coinductive account of the abstract development of Brotherston, Gorogiannis, and Petersen [APLAS 2012], in a slightly more general form since we work with arbitrary infinite proofs, which may be acyclic. This work is described in detail in an article by the authors, published in 2017 in the Journal of Automated Reasoning. The abstract proof can be instantiated for various formalisms, including first-order logic with inductive predicates. [Differential_Dynamic_Logic] title = Differential Dynamic Logic author = Brandon Bohrer <mailto:bbohrer@cs.cmu.edu> topic = Logic/General logic/Modal logic, Computer science/Programming languages/Logics date = 2017-02-13 notify = bbohrer@cs.cmu.edu abstract = We formalize differential dynamic logic, a logic for proving properties of hybrid systems. The proof calculus in this formalization is based on the uniform substitution principle. We show it is sound with respect to our denotational semantics, which provides increased confidence in the correctness of the KeYmaera X theorem prover based on this calculus. As an application, we include a proof term checker embedded in Isabelle/HOL with several example proofs. Published in: Brandon Bohrer, Vincent Rahli, Ivana Vukotic, Marcus Völp, André Platzer: Formally verified differential dynamic logic. CPP 2017. [Syntax_Independent_Logic] title = Syntax-Independent Logic Infrastructure author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We formalize a notion of logic whose terms and formulas are kept abstract. In particular, logical connectives, substitution, free variables, and provability are not defined, but characterized by their general properties as locale assumptions. Based on this abstract characterization, we develop further reusable reasoning infrastructure. For example, we define parallel substitution (along with proving its characterizing theorems) from single-point substitution. Similarly, we develop a natural deduction style proof system starting from the abstract Hilbert-style one. These one-time efforts benefit different concrete logics satisfying our locales' assumptions. We instantiate the syntax-independent logic infrastructure to Robinson arithmetic (also known as Q) in the AFP entry <a href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a> and to hereditarily finite set theory in the AFP entries <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a> and <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>, which are part of our formalization of Gödel's Incompleteness Theorems described in our CADE-27 paper <a href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A Formally Verified Abstract Account of Gödel's Incompleteness Theorems</a>. [Goedel_Incompleteness] title = An Abstract Formalization of Gödel's Incompleteness Theorems author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We present an abstract formalization of Gödel's incompleteness theorems. We analyze sufficient conditions for the theorems' applicability to a partially specified logic. Our abstract perspective enables a comparison between alternative approaches from the literature. These include Rosser's variation of the first theorem, Jeroslow's variation of the second theorem, and the Swierczkowski–Paulson semantics-based approach. This AFP entry is the main entry point to the results described in our CADE-27 paper <a href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A Formally Verified Abstract Account of Gödel's Incompleteness Theorems</a>. As part of our abstract formalization's validation, we instantiate our locales twice in the separate AFP entries <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a> and <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>. [Goedel_HFSet_Semantic] title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part I author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We validate an abstract formulation of Gödel's First and Second Incompleteness Theorems from a <a href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate AFP entry</a> by instantiating them to the case of finite sound extensions of the Hereditarily Finite (HF) Set theory, i.e., FOL theories extending the HF Set theory with a finite set of axioms that are sound in the standard model. The concrete results had been previously formalised in an <a href="https://www.isa-afp.org/entries/Incompleteness.html">AFP entry by Larry Paulson</a>; our instantiation reuses the infrastructure developed in that entry. [Goedel_HFSet_Semanticless] title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part II author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We validate an abstract formulation of Gödel's Second Incompleteness Theorem from a <a href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate AFP entry</a> by instantiating it to the case of finite consistent extensions of the Hereditarily Finite (HF) Set theory, i.e., consistent FOL theories extending the HF Set theory with a finite set of axioms. The instantiation draws heavily on infrastructure previously developed by Larry Paulson in his <a href="https://www.isa-afp.org/entries/Incompleteness.html">direct formalisation of the concrete result</a>. It strengthens Paulson's formalization of Gödel's Second from that entry by not assuming soundness, and in fact not relying on any notion of model or semantic interpretation. The strengthening was obtained by first replacing some of Paulson’s semantic arguments with proofs within his HF calculus, and then plugging in some of Paulson's (modified) lemmas to instantiate our soundness-free Gödel's Second locale. [Robinson_Arithmetic] title = Robinson Arithmetic author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We instantiate our syntax-independent logic infrastructure developed in <a href="https://www.isa-afp.org/entries/Syntax_Independent_Logic.html">a separate AFP entry</a> to the FOL theory of Robinson arithmetic (also known as Q). The latter was formalised using Nominal Isabelle by adapting <a href="https://www.isa-afp.org/entries/Incompleteness.html">Larry Paulson’s formalization of the Hereditarily Finite Set theory</a>. [Elliptic_Curves_Group_Law] title = The Group Law for Elliptic Curves author = Stefan Berghofer <http://www.in.tum.de/~berghofe> topic = Computer science/Security/Cryptography date = 2017-02-28 notify = berghofe@in.tum.de abstract = We prove the group law for elliptic curves in Weierstrass form over fields of characteristic greater than 2. In addition to affine coordinates, we also formalize projective coordinates, which allow for more efficient computations. By specializing the abstract formalization to prime fields, we can apply the curve operations to parameters used in standard security protocols. [Example-Submission] title = Example Submission author = Gerwin Klein <http://www.cse.unsw.edu.au/~kleing/> topic = Mathematics/Analysis, Mathematics/Number theory date = 2004-02-25 notify = kleing@cse.unsw.edu.au abstract = This is an example submission to the Archive of Formal Proofs. It shows submission requirements and explains the structure of a simple typical submission. Note that you can use HTML tags and LaTeX formulae like $\sum_{n=1}^\infty \frac{1}{n^2} = \frac{\pi^2}{6}$ in the abstract. Display formulae like $$ \int_0^1 x^{-x}\,\text{d}x = \sum_{n=1}^\infty n^{-n}$$ are also possible. Please read the <a href="../submitting.html">submission guidelines</a> before using this. extra-no-index = no-index: true [CRDT] title = A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes author = Victor B. F. Gomes <mailto:vb358@cam.ac.uk>, Martin Kleppmann<mailto:martin.kleppmann@cl.cam.ac.uk>, Dominic P. Mulligan<mailto:dominic.p.mulligan@googlemail.com>, Alastair R. Beresford<mailto:arb33@cam.ac.uk> topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2017-07-07 notify = vb358@cam.ac.uk, dominic.p.mulligan@googlemail.com abstract = In this work, we focus on the correctness of Conflict-free Replicated Data Types (CRDTs), a class of algorithm that provides strong eventual consistency guarantees for replicated data. We develop a modular and reusable framework for verifying the correctness of CRDT algorithms. We avoid correctness issues that have dogged previous mechanised proofs in this area by including a network model in our formalisation, and proving that our theorems hold in all possible network behaviours. Our axiomatic network model is a standard abstraction that accurately reflects the behaviour of real-world computer networks. Moreover, we identify an abstract convergence theorem, a property of order relations, which provides a formal definition of strong eventual consistency. We then obtain the first machine-checked correctness theorems for three concrete CRDTs: the Replicated Growable Array, the Observed-Remove Set, and an Increment-Decrement Counter. [HOLCF-Prelude] title = HOLCF-Prelude author = Joachim Breitner<mailto:joachim@cis.upenn.edu>, Brian Huffman<>, Neil Mitchell<>, Christian Sternagel<mailto:c.sternagel@gmail.com> topic = Computer science/Functional programming date = 2017-07-15 notify = c.sternagel@gmail.com, joachim@cis.upenn.edu, hupel@in.tum.de abstract = The Isabelle/HOLCF-Prelude is a formalization of a large part of Haskell's standard prelude in Isabelle/HOLCF. We use it to prove the correctness of the Eratosthenes' Sieve, in its self-referential implementation commonly used to showcase Haskell's laziness; prove correctness of GHC's "fold/build" rule and related rewrite rules; and certify a number of hints suggested by HLint. [Decl_Sem_Fun_PL] title = Declarative Semantics for Functional Languages author = Jeremy Siek <http://homes.soic.indiana.edu/jsiek/> topic = Computer science/Programming languages date = 2017-07-21 notify = jsiek@indiana.edu abstract = We present a semantics for an applied call-by-value lambda-calculus that is compositional, extensional, and elementary. We present four different views of the semantics: 1) as a relational (big-step) semantics that is not operational but instead declarative, 2) as a denotational semantics that does not use domain theory, 3) as a non-deterministic interpreter, and 4) as a variant of the intersection type systems of the Torino group. We prove that the semantics is correct by showing that it is sound and complete with respect to operational semantics on programs and that is sound with respect to contextual equivalence. We have not yet investigated whether it is fully abstract. We demonstrate that this approach to semantics is useful with three case studies. First, we use the semantics to prove correctness of a compiler optimization that inlines function application. Second, we adapt the semantics to the polymorphic lambda-calculus extended with general recursion and prove semantic type soundness. Third, we adapt the semantics to the call-by-value lambda-calculus with mutable references. The paper that accompanies these Isabelle theories is <a href="https://arxiv.org/abs/1707.03762">available on arXiv</a>. [DynamicArchitectures] title = Dynamic Architectures author = Diego Marmsoler <http://marmsoler.com> topic = Computer science/System description languages date = 2017-07-28 notify = diego.marmsoler@tum.de abstract = The architecture of a system describes the system's overall organization into components and connections between those components. With the emergence of mobile computing, dynamic architectures have become increasingly important. In such architectures, components may appear or disappear, and connections may change over time. In the following we mechanize a theory of dynamic architectures and verify the soundness of a corresponding calculus. Therefore, we first formalize the notion of configuration traces as a model for dynamic architectures. Then, the behavior of single components is formalized in terms of behavior traces and an operator is introduced and studied to extract the behavior of a single component out of a given configuration trace. Then, behavior trace assertions are introduced as a temporal specification technique to specify behavior of components. Reasoning about component behavior in a dynamic context is formalized in terms of a calculus for dynamic architectures. Finally, the soundness of the calculus is verified by introducing an alternative interpretation for behavior trace assertions over configuration traces and proving the rules of the calculus. Since projection may lead to finite as well as infinite behavior traces, they are formalized in terms of coinductive lists. Thus, our theory is based on Lochbihler's formalization of coinductive lists. The theory may be applied to verify properties for dynamic architectures. extra-history = Change history: [2018-06-07]: adding logical operators to specify configuration traces (revision 09178f08f050) [Stewart_Apollonius] title = Stewart's Theorem and Apollonius' Theorem author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com> topic = Mathematics/Geometry date = 2017-07-31 notify = lukas.bulwahn@gmail.com abstract = This entry formalizes the two geometric theorems, Stewart's and Apollonius' theorem. Stewart's Theorem relates the length of a triangle's cevian to the lengths of the triangle's two sides. Apollonius' Theorem is a specialisation of Stewart's theorem, restricting the cevian to be the median. The proof applies the law of cosines, some basic geometric facts about triangles and then simply transforms the terms algebraically to yield the conjectured relation. The formalization in Isabelle can closely follow the informal proofs described in the Wikipedia articles of those two theorems. [LambdaMu] title = The LambdaMu-calculus author = Cristina Matache <mailto:cris.matache@gmail.com>, Victor B. F. Gomes <mailto:victorborgesfg@gmail.com>, Dominic P. Mulligan <mailto:dominic.p.mulligan@googlemail.com> topic = Computer science/Programming languages/Lambda calculi, Logic/General logic/Lambda calculus date = 2017-08-16 notify = victorborgesfg@gmail.com, dominic.p.mulligan@googlemail.com abstract = The propositions-as-types correspondence is ordinarily presented as linking the metatheory of typed λ-calculi and the proof theory of intuitionistic logic. Griffin observed that this correspondence could be extended to classical logic through the use of control operators. This observation set off a flurry of further research, leading to the development of Parigots λμ-calculus. In this work, we formalise λμ- calculus in Isabelle/HOL and prove several metatheoretical properties such as type preservation and progress. [Orbit_Stabiliser] title = Orbit-Stabiliser Theorem with Application to Rotational Symmetries author = Jonas Rädle <mailto:jonas.raedle@tum.de> topic = Mathematics/Algebra date = 2017-08-20 notify = jonas.raedle@tum.de abstract = The Orbit-Stabiliser theorem is a basic result in the algebra of groups that factors the order of a group into the sizes of its orbits and stabilisers. We formalize the notion of a group action and the related concepts of orbits and stabilisers. This allows us to prove the orbit-stabiliser theorem. In the second part of this work, we formalize the tetrahedral group and use the orbit-stabiliser theorem to prove that there are twelve (orientation-preserving) rotations of the tetrahedron. [PLM] title = Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL author = Daniel Kirchner <mailto:daniel@ekpyron.org> topic = Logic/Philosophical aspects date = 2017-09-17 notify = daniel@ekpyron.org abstract = We present an embedding of the second-order fragment of the Theory of Abstract Objects as described in Edward Zalta's upcoming work <a href="https://mally.stanford.edu/principia.pdf">Principia Logico-Metaphysica (PLM)</a> in the automated reasoning framework Isabelle/HOL. The Theory of Abstract Objects is a metaphysical theory that reifies property patterns, as they for example occur in the abstract reasoning of mathematics, as abstract objects and provides an axiomatic framework that allows to reason about these objects. It thereby serves as a fundamental metaphysical theory that can be used to axiomatize and describe a wide range of philosophical objects, such as Platonic forms or Leibniz' concepts, and has the ambition to function as a foundational theory of mathematics. The target theory of our embedding as described in chapters 7-9 of PLM employs a modal relational type theory as logical foundation for which a representation in functional type theory is <a href="https://mally.stanford.edu/Papers/rtt.pdf">known to be challenging</a>. Nevertheless we arrive at a functioning representation of the theory in the functional logic of Isabelle/HOL based on a semantical representation of an Aczel-model of the theory. Based on this representation we construct an implementation of the deductive system of PLM which allows to automatically and interactively find and verify theorems of PLM. Our work thereby supports the concept of shallow semantical embeddings of logical systems in HOL as a universal tool for logical reasoning <a href="http://www.mi.fu-berlin.de/inf/groups/ag-ki/publications/Universal-Reasoning/1703_09620_pd.pdf">as promoted by Christoph Benzmüller</a>. The most notable result of the presented work is the discovery of a previously unknown paradox in the formulation of the Theory of Abstract Objects. The embedding of the theory in Isabelle/HOL played a vital part in this discovery. Furthermore it was possible to immediately offer several options to modify the theory to guarantee its consistency. Thereby our work could provide a significant contribution to the development of a proper grounding for object theory. [KD_Tree] title = Multidimensional Binary Search Trees author = Martin Rau<> topic = Computer science/Data structures date = 2019-05-30 notify = martin.rau@tum.de, mrtnrau@googlemail.com abstract = This entry provides a formalization of multidimensional binary trees, also known as k-d trees. It includes a balanced build algorithm as well as the nearest neighbor algorithm and the range search algorithm. It is based on the papers <a href="https://dl.acm.org/citation.cfm?doid=361002.361007">Multidimensional binary search trees used for associative searching</a> and <a href="https://dl.acm.org/citation.cfm?doid=355744.355745"> An Algorithm for Finding Best Matches in Logarithmic Expected Time</a>. extra-history = Change history: [2020-15-04]: Change representation of k-dimensional points from 'list' to HOL-Analysis.Finite_Cartesian_Product 'vec'. Update proofs to incorporate HOL-Analysis 'dist' and 'cbox' primitives. [Closest_Pair_Points] title = Closest Pair of Points Algorithms author = Martin Rau <mailto:martin.rau@tum.de>, Tobias Nipkow <http://www.in.tum.de/~nipkow> topic = Computer science/Algorithms/Geometry date = 2020-01-13 notify = martin.rau@tum.de, nipkow@in.tum.de abstract = This entry provides two related verified divide-and-conquer algorithms solving the fundamental Closest Pair of Points problem in Computational Geometry. Functional correctness and the optimal running time of O(n log n) are proved. Executable code is generated which is empirically competitive with handwritten reference implementations. extra-history = Change history: [2020-14-04]: Incorporate Time_Monad of the AFP entry Root_Balanced_Tree. [Approximation_Algorithms] title = Verified Approximation Algorithms author = Robin Eßmann <mailto:robin.essmann@tum.de>, Tobias Nipkow <http://www.in.tum.de/~nipkow/>, Simon Robillard <https://simon-robillard.net/>, Ujkan Sulejmani<> topic = Computer science/Algorithms/Approximation date = 2020-01-16 notify = nipkow@in.tum.de abstract = We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, set cover, independent set, center selection, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. A detailed description of our work (excluding center selection) has been published in the proceedings of <a href="https://doi.org/10.1007/978-3-030-51054-1_17">IJCAR 2020</a>. extra-history = Change history: [2021-02-08]: added theory Approx_SC_Hoare (Set Cover) by Robin Eßmann [2021-06-29]: added theory Center_Selection by Ujkan Sulejmani [Diophantine_Eqns_Lin_Hom] title = Homogeneous Linear Diophantine Equations author = Florian Messner <mailto:florian.g.messner@uibk.ac.at>, Julian Parsert <mailto:julian.parsert@gmail.com>, Jonas Schöpf <mailto:jonas.schoepf@uibk.ac.at>, Christian Sternagel <mailto:c.sternagel@gmail.com> topic = Computer science/Algorithms/Mathematical, Mathematics/Number theory, Tools license = LGPL date = 2017-10-14 notify = c.sternagel@gmail.com, julian.parsert@gmail.com abstract = We formalize the theory of homogeneous linear diophantine equations, focusing on two main results: (1) an abstract characterization of minimal complete sets of solutions, and (2) an algorithm computing them. Both, the characterization and the algorithm are based on previous work by Huet. Our starting point is a simple but inefficient variant of Huet's lexicographic algorithm incorporating improved bounds due to Clausen and Fortenbacher. We proceed by proving its soundness and completeness. Finally, we employ code equations to obtain a reasonably efficient implementation. Thus, we provide a formally verified solver for homogeneous linear diophantine equations. [Winding_Number_Eval] title = Evaluate Winding Numbers through Cauchy Indices author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = In complex analysis, the winding number measures the number of times a path (counterclockwise) winds around a point, while the Cauchy index can approximate how the path winds. This entry provides a formalisation of the Cauchy index, which is then shown to be related to the winding number. In addition, this entry also offers a tactic that enables users to evaluate the winding number by calculating Cauchy indices. [Count_Complex_Roots] title = Count the Number of Complex Roots author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = Based on evaluating Cauchy indices through remainder sequences, this entry provides an effective procedure to count the number of complex roots (with multiplicity) of a polynomial within various shapes (e.g., rectangle, circle and half-plane). Potential applications of this entry include certified complex root isolation (of a polynomial) and testing the Routh-Hurwitz stability criterion (i.e., to check whether all the roots of some characteristic polynomial have negative real parts). extra-history = Change history: [2021-10-26]: resolved the roots-on-the-border problem in the rectangular case (revision 82a159e398cf). [Buchi_Complementation] title = Büchi Complementation author = Julian Brunner <http://www21.in.tum.de/~brunnerj/> topic = Computer science/Automata and formal languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a verified implementation of rank-based Büchi Complementation. The verification is done in three steps: <ol> <li>Definition of odd rankings and proof that an automaton rejects a word iff there exists an odd ranking for it.</li> <li>Definition of the complement automaton and proof that it accepts exactly those words for which there is an odd ranking.</li> <li>Verified implementation of the complement automaton using the Isabelle Collections Framework.</li> </ol> [Transition_Systems_and_Automata] title = Transition Systems and Automata author = Julian Brunner <http://www21.in.tum.de/~brunnerj/> topic = Computer science/Automata and formal languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a very abstract theory of transition systems that can be instantiated to express various types of automata. A transition system is typically instantiated by providing a set of initial states, a predicate for enabled transitions, and a transition execution function. From this, it defines the concepts of finite and infinite paths as well as the set of reachable states, among other things. Many useful theorems, from basic path manipulation rules to coinduction and run construction rules, are proven in this abstract transition system context. The library comes with instantiations for DFAs, NFAs, and Büchi automata. [Kuratowski_Closure_Complement] title = The Kuratowski Closure-Complement Theorem author = Peter Gammie <http://peteg.org>, Gianpaolo Gioiosa<> topic = Mathematics/Topology date = 2017-10-26 notify = peteg42@gmail.com abstract = We discuss a topological curiosity discovered by Kuratowski (1922): the fact that the number of distinct operators on a topological space generated by compositions of closure and complement never exceeds 14, and is exactly 14 in the case of R. In addition, we prove a theorem due to Chagrov (1982) that classifies topological spaces according to the number of such operators they support. [Hybrid_Multi_Lane_Spatial_Logic] title = Hybrid Multi-Lane Spatial Logic author = Sven Linker <mailto:s.linker@liverpool.ac.uk> topic = Logic/General logic/Modal logic date = 2017-11-06 notify = s.linker@liverpool.ac.uk abstract = We present a semantic embedding of a spatio-temporal multi-modal logic, specifically defined to reason about motorway traffic, into Isabelle/HOL. The semantic model is an abstraction of a motorway, emphasising local spatial properties, and parameterised by the types of sensors deployed in the vehicles. We use the logic to define controller constraints to ensure safety, i.e., the absence of collisions on the motorway. After proving safety with a restrictive definition of sensors, we relax these assumptions and show how to amend the controller constraints to still guarantee safety. [Dirichlet_L] title = Dirichlet L-Functions and Dirichlet's Theorem author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory, Mathematics/Algebra date = 2017-12-21 notify = manuel@pruvisto.org abstract = This article provides a formalisation of Dirichlet characters and Dirichlet L-functions including proofs of their basic properties – most notably their analyticity, their areas of convergence, and their non-vanishing for ℜ(s) ≥ 1. All of this is built in a very high-level style using Dirichlet series. The proof of the non-vanishing follows a very short and elegant proof by Newman, which we attempt to reproduce faithfully in a similar level of abstraction in Isabelle. This also leads to a relatively short proof of Dirichlet’s Theorem, which states that, if h and n are coprime, there are infinitely many primes p with p ≡ h (mod n). [Symmetric_Polynomials] title = Symmetric Polynomials author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Algebra date = 2018-09-25 notify = manuel@pruvisto.org abstract = A symmetric polynomial is a polynomial in variables X1,…,Xn that does not discriminate between its variables, i. e. it is invariant under any permutation of them. These polynomials are important in the study of the relationship between the coefficients of a univariate polynomial and its roots in its algebraic closure. This article provides a definition of symmetric polynomials and the elementary symmetric polynomials e1,…,en and proofs of their basic properties, including three notable ones: <ul> <li> Vieta's formula, which gives an explicit expression for the k-th coefficient of a univariate monic polynomial in terms of its roots x1,…,xn, namely ck = (-1)n-k en-k(x1,…,xn).</li> <li>Second, the Fundamental Theorem of Symmetric Polynomials, which states that any symmetric polynomial is itself a uniquely determined polynomial combination of the elementary symmetric polynomials.</li> <li>Third, as a corollary of the previous two, that given a polynomial over some ring R, any symmetric polynomial combination of its roots is also in R even when the roots are not. </ul> Both the symmetry property itself and the witness for the Fundamental Theorem are executable. [Taylor_Models] title = Taylor Models author = Christoph Traut<>, Fabian Immler <http://www21.in.tum.de/~immler> topic = Computer science/Algorithms/Mathematical, Computer science/Data structures, Mathematics/Analysis, Mathematics/Algebra date = 2018-01-08 notify = immler@in.tum.de abstract = We present a formally verified implementation of multivariate Taylor models. Taylor models are a form of rigorous polynomial approximation, consisting of an approximation polynomial based on Taylor expansions, combined with a rigorous bound on the approximation error. Taylor models were introduced as a tool to mitigate the dependency problem of interval arithmetic. Our implementation automatically computes Taylor models for the class of elementary functions, expressed by composition of arithmetic operations and basic functions like exp, sin, or square root. [Green] title = An Isabelle/HOL formalisation of Green's Theorem author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Analysis date = 2018-01-11 notify = mohammad.abdulaziz8@gmail.com, lp15@cam.ac.uk abstract = We formalise a statement of Green’s theorem—the first formalisation to our knowledge—in Isabelle/HOL. The theorem statement that we formalise is enough for most applications, especially in physics and engineering. Our formalisation is made possible by a novel proof that avoids the ubiquitous line integral cancellation argument. This eliminates the need to formalise orientations and region boundaries explicitly with respect to the outwards-pointing normal vector. Instead we appeal to a homological argument about equivalences between paths. [AI_Planning_Languages_Semantics] title = AI Planning Languages Semantics author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Peter Lammich <http://www21.in.tum.de/~lammich> topic = Computer science/Artificial intelligence date = 2020-10-29 notify = mohammad.abdulaziz8@gmail.com abstract = This is an Isabelle/HOL formalisation of the semantics of the multi-valued planning tasks language that is used by the planning system Fast-Downward, the STRIPS fragment of the Planning Domain Definition Language (PDDL), and the STRIPS soundness meta-theory developed by Vladimir Lifschitz. It also contains formally verified checkers for checking the well-formedness of problems specified in either language as well the correctness of potential solutions. The formalisation in this entry was described in an earlier publication. [Verified_SAT_Based_AI_Planning] title = Verified SAT-Based AI Planning author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Friedrich Kurz <> topic = Computer science/Artificial intelligence date = 2020-10-29 notify = mohammad.abdulaziz8@gmail.com abstract = We present an executable formally verified SAT encoding of classical AI planning that is based on the encodings by Kautz and Selman and the one by Rintanen et al. The encoding was experimentally tested and shown to be usable for reasonably sized standard AI planning benchmarks. We also use it as a reference to test a state-of-the-art SAT-based planner, showing that it sometimes falsely claims that problems have no solutions of certain lengths. The formalisation in this submission was described in an independent publication. [Gromov_Hyperbolicity] title = Gromov Hyperbolicity author = Sebastien Gouezel<> topic = Mathematics/Geometry date = 2018-01-16 notify = sebastien.gouezel@univ-rennes1.fr abstract = A geodesic metric space is Gromov hyperbolic if all its geodesic triangles are thin, i.e., every side is contained in a fixed thickening of the two other sides. While this definition looks innocuous, it has proved extremely important and versatile in modern geometry since its introduction by Gromov. We formalize the basic classical properties of Gromov hyperbolic spaces, notably the Morse lemma asserting that quasigeodesics are close to geodesics, the invariance of hyperbolicity under quasi-isometries, we define and study the Gromov boundary and its associated distance, and prove that a quasi-isometry between Gromov hyperbolic spaces extends to a homeomorphism of the boundaries. We also prove a less classical theorem, by Bonk and Schramm, asserting that a Gromov hyperbolic space embeds isometrically in a geodesic Gromov-hyperbolic space. As the original proof uses a transfinite sequence of Cauchy completions, this is an interesting formalization exercise. Along the way, we introduce basic material on isometries, quasi-isometries, Lipschitz maps, geodesic spaces, the Hausdorff distance, the Cauchy completion of a metric space, and the exponential on extended real numbers. [Ordered_Resolution_Prover] title = Formalization of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io>, Uwe Waldmann <mailto:uwe@mpi-inf.mpg.de> topic = Logic/General logic/Mechanization of proofs date = 2018-01-18 notify = andschl@dtu.dk, j.c.blanchette@vu.nl abstract = This Isabelle/HOL formalization covers Sections 2 to 4 of Bachmair and Ganzinger's "Resolution Theorem Proving" chapter in the Handbook of Automated Reasoning. This includes soundness and completeness of unordered and ordered variants of ground resolution with and without literal selection, the standard redundancy criterion, a general framework for refutational theorem proving, and soundness and completeness of an abstract first-order prover. [Chandy_Lamport] title = A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm author = Ben Fiedler <mailto:ben.fiedler@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Algorithms/Distributed date = 2020-07-21 notify = ben.fiedler@inf.ethz.ch, traytel@inf.ethz.ch abstract = We provide a suitable distributed system model and implementation of the Chandy--Lamport distributed snapshot algorithm [ACM Transactions on Computer Systems, 3, 63-75, 1985]. Our main result is a formal termination and correctness proof of the Chandy--Lamport algorithm and its use in stable property detection. [BNF_Operations] title = Operations on Bounded Natural Functors author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Tools date = 2017-12-19 notify = jasmin.blanchette@gmail.com,uuomul@yahoo.com,traytel@inf.ethz.ch abstract = This entry formalizes the closure property of bounded natural functors (BNFs) under seven operations. These operations and the corresponding proofs constitute the core of Isabelle's (co)datatype package. To be close to the implemented tactics, the proofs are deliberately formulated as detailed apply scripts. The (co)datatypes together with (co)induction principles and (co)recursors are byproducts of the fixpoint operations LFP and GFP. Composition of BNFs is subdivided into four simpler operations: Compose, Kill, Lift, and Permute. The N2M operation provides mutual (co)induction principles and (co)recursors for nested (co)datatypes. [LLL_Basis_Reduction] title = A verified LLL algorithm author = Ralph Bottesch <>, Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada<> topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra date = 2018-02-02 notify = ralph.bottesch@uibk.ac.at, jose.divason@unirioja.es, maximilian.haslbeck@uibk.ac.at, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp abstract = The Lenstra-Lenstra-Lovász basis reduction algorithm, also known as LLL algorithm, is an algorithm to find a basis with short, nearly orthogonal vectors of an integer lattice. Thereby, it can also be seen as an approximation to solve the shortest vector problem (SVP), which is an NP-hard problem, where the approximation quality solely depends on the dimension of the lattice, but not the lattice itself. The algorithm also possesses many applications in diverse fields of computer science, from cryptanalysis to number theory, but it is specially well-known since it was used to implement the first polynomial-time algorithm to factor polynomials. In this work we present the first mechanized soundness proof of the LLL algorithm to compute short vectors in lattices. The formalization follows a textbook by von zur Gathen and Gerhard. extra-history = Change history: [2018-04-16]: Integrated formal complexity bounds (Haslbeck, Thiemann) [2018-05-25]: Integrated much faster LLL implementation based on integer arithmetic (Bottesch, Haslbeck, Thiemann) [LLL_Factorization] title = A verified factorization algorithm for integer polynomials with polynomial complexity author = Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada <mailto:ayamada@trs.cm.is.nagoya-u.ac.jp> topic = Mathematics/Algebra date = 2018-02-06 notify = jose.divason@unirioja.es, s.j.c.joosten@utwente.nl, rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp abstract = Short vectors in lattices and factors of integer polynomials are related. Each factor of an integer polynomial belongs to a certain lattice. When factoring polynomials, the condition that we are looking for an irreducible polynomial means that we must look for a small element in a lattice, which can be done by a basis reduction algorithm. In this development we formalize this connection and thereby one main application of the LLL basis reduction algorithm: an algorithm to factor square-free integer polynomials which runs in polynomial time. The work is based on our previous Berlekamp–Zassenhaus development, where the exponential reconstruction phase has been replaced by the polynomial-time basis reduction algorithm. Thanks to this formalization we found a serious flaw in a textbook. [Treaps] title = Treaps author = Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://www.in.tum.de/~eberlm>, Tobias Nipkow <https://www.in.tum.de/~nipkow> topic = Computer science/Data structures date = 2018-02-06 notify = manuel@pruvisto.org abstract = A Treap is a binary tree whose nodes contain pairs consisting of some payload and an associated priority. It must have the search-tree property w.r.t. the payloads and the heap property w.r.t. the priorities. Treaps are an interesting data structure that is related to binary search trees (BSTs) in the following way: if one forgets all the priorities of a treap, the resulting BST is exactly the same as if one had inserted the elements into an empty BST in order of ascending priority. This means that a treap behaves like a BST where we can pretend the elements were inserted in a different order from the one in which they were actually inserted. In particular, by choosing these priorities at random upon insertion of an element, we can pretend that we inserted the elements in random order, so that the shape of the resulting tree is that of a random BST no matter in what order we insert the elements. This is the main result of this formalisation. [Skip_Lists] title = Skip Lists author = Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://pruvisto.org/> topic = Computer science/Data structures date = 2020-01-09 notify = max.haslbeck@gmx.de abstract = Skip lists are sorted linked lists enhanced with shortcuts and are an alternative to binary search trees. A skip lists consists of multiple levels of sorted linked lists where a list on level n is a subsequence of the list on level n − 1. In the ideal case, elements are skipped in such a way that a lookup in a skip lists takes O(log n) time. In a randomised skip list the skipped elements are choosen randomly. This entry contains formalized proofs of the textbook results about the expected height and the expected length of a search path in a randomised skip list. [Mersenne_Primes] title = Mersenne primes and the Lucas–Lehmer test author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2020-01-17 notify = manuel@pruvisto.org abstract = This article provides formal proofs of basic properties of Mersenne numbers, i. e. numbers of the form 2n - 1, and especially of Mersenne primes. In particular, an efficient, verified, and executable version of the Lucas–Lehmer test is developed. This test decides primality for Mersenne numbers in time polynomial in n. [Hoare_Time] title = Hoare Logics for Time Bounds author = Maximilian P. L. Haslbeck <http://www.in.tum.de/~haslbema>, Tobias Nipkow <https://www.in.tum.de/~nipkow> topic = Computer science/Programming languages/Logics date = 2018-02-26 notify = haslbema@in.tum.de abstract = We study three different Hoare logics for reasoning about time bounds of imperative programs and formalize them in Isabelle/HOL: a classical Hoare like logic due to Nielson, a logic with potentials due to Carbonneaux et al. and a separation logic following work by Atkey, Chaguérand and Pottier. These logics are formally shown to be sound and complete. Verification condition generators are developed and are shown sound and complete too. We also consider variants of the systems where we abstract from multiplicative constants in the running time bounds, thus supporting a big-O style of reasoning. Finally we compare the expressive power of the three systems. [Architectural_Design_Patterns] title = A Theory of Architectural Design Patterns author = Diego Marmsoler <http://marmsoler.com> topic = Computer science/System description languages date = 2018-03-01 notify = diego.marmsoler@tum.de abstract = The following document formalizes and verifies several architectural design patterns. Each pattern specification is formalized in terms of a locale where the locale assumptions correspond to the assumptions which a pattern poses on an architecture. Thus, pattern specifications may build on top of each other by interpreting the corresponding locale. A pattern is verified using the framework provided by the AFP entry Dynamic Architectures. Currently, the document consists of formalizations of 4 different patterns: the singleton, the publisher subscriber, the blackboard pattern, and the blockchain pattern. Thereby, the publisher component of the publisher subscriber pattern is modeled as an instance of the singleton pattern and the blackboard pattern is modeled as an instance of the publisher subscriber pattern. In general, this entry provides the first steps towards an overall theory of architectural design patterns. extra-history = Change history: [2018-05-25]: changing the major assumption for blockchain architectures from alternative minings to relative mining frequencies (revision 5043c5c71685) [2019-04-08]: adapting the terminology: honest instead of trusted, dishonest instead of untrusted (revision 7af3431a22ae) [Weight_Balanced_Trees] title = Weight-Balanced Trees author = Tobias Nipkow <https://www.in.tum.de/~nipkow>, Stefan Dirix<> topic = Computer science/Data structures date = 2018-03-13 notify = nipkow@in.tum.de abstract = This theory provides a verified implementation of weight-balanced trees following the work of <a href="https://doi.org/10.1017/S0956796811000104">Hirai and Yamamoto</a> who proved that all parameters in a certain range are valid, i.e. guarantee that insertion and deletion preserve weight-balance. Instead of a general theorem we provide parameterized proofs of preservation of the invariant that work for many (all?) valid parameters. [Fishburn_Impossibility] title = The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency author = Felix Brandt <http://dss.in.tum.de/staff/brandt.html>, Manuel Eberl <https://pruvisto.org>, Christian Saile <http://dss.in.tum.de/staff/christian-saile.html>, Christian Stricker <http://dss.in.tum.de/staff/christian-stricker.html> topic = Mathematics/Games and economics date = 2018-03-22 notify = manuel@pruvisto.org abstract = This formalisation contains the proof that there is no anonymous Social Choice Function for at least three agents and alternatives that fulfils both Pareto-Efficiency and Fishburn-Strategyproofness. It was derived from a proof of <a href="http://dss.in.tum.de/files/brandt-research/stratset.pdf">Brandt et al.</a>, which relies on an unverified translation of a fixed finite instance of the original problem to SAT. This Isabelle proof contains a machine-checked version of both the statement for exactly three agents and alternatives and the lifting to the general case. [BNF_CC] title = Bounded Natural Functors with Covariance and Contravariance author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch> topic = Computer science/Functional programming, Tools date = 2018-04-24 notify = mail@andreas-lochbihler.de, joshua.schneider@inf.ethz.ch abstract = Bounded natural functors (BNFs) provide a modular framework for the construction of (co)datatypes in higher-order logic. Their functorial operations, the mapper and relator, are restricted to a subset of the parameters, namely those where recursion can take place. For certain applications, such as free theorems, data refinement, quotients, and generalised rewriting, it is desirable that these operations do not ignore the other parameters. In this article, we formalise the generalisation BNFCC that extends the mapper and relator to covariant and contravariant parameters. We show that <ol> <li> BNFCCs are closed under functor composition and least and greatest fixpoints,</li> <li> subtypes inherit the BNFCC structure under conditions that generalise those for the BNF case, and</li> <li> BNFCCs preserve quotients under mild conditions.</li> </ol> These proofs are carried out for abstract BNFCCs similar to the AFP entry BNF Operations. In addition, we apply the BNFCC theory to several concrete functors. [Modular_Assembly_Kit_Security] title = An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties author = Oliver Bračevac <mailto:bracevac@st.informatik.tu-darmstadt.de>, Richard Gay <mailto:gay@mais.informatik.tu-darmstadt.de>, Sylvia Grewe <mailto:grewe@st.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Henning Sudbrock <mailto:sudbrock@mais.informatik.tu-darmstadt.de>, Markus Tasch <mailto:tasch@mais.informatik.tu-darmstadt.de> topic = Computer science/Security date = 2018-05-07 notify = tasch@mais.informatik.tu-darmstadt.de abstract = The "Modular Assembly Kit for Security Properties" (MAKS) is a framework for both the definition and verification of possibilistic information-flow security properties at the specification-level. MAKS supports the uniform representation of a wide range of possibilistic information-flow properties and provides support for the verification of such properties via unwinding results and compositionality results. We provide a formalization of this framework in Isabelle/HOL. [AxiomaticCategoryTheory] title = Axiom Systems for Category Theory in Free Logic author = Christoph Benzmüller <http://christoph-benzmueller.de>, Dana Scott <http://www.cs.cmu.edu/~scott/> topic = Mathematics/Category theory date = 2018-05-23 notify = c.benzmueller@gmail.com abstract = This document provides a concise overview on the core results of our previous work on the exploration of axioms systems for category theory. Extending the previous studies (http://arxiv.org/abs/1609.01493) we include one further axiomatic theory in our experiments. This additional theory has been suggested by Mac Lane in 1948. We show that the axioms proposed by Mac Lane are equivalent to the ones we studied before, which includes an axioms set suggested by Scott in the 1970s and another axioms set proposed by Freyd and Scedrov in 1990, which we slightly modified to remedy a minor technical issue. [OpSets] title = OpSets: Sequential Specifications for Replicated Datatypes author = Martin Kleppmann <mailto:mk428@cl.cam.ac.uk>, Victor B. F. Gomes <mailto:vb358@cl.cam.ac.uk>, Dominic P. Mulligan <mailto:Dominic.Mulligan@arm.com>, Alastair R. Beresford <mailto:arb33@cl.cam.ac.uk> topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2018-05-10 notify = vb358@cam.ac.uk abstract = We introduce OpSets, an executable framework for specifying and reasoning about the semantics of replicated datatypes that provide eventual consistency in a distributed system, and for mechanically verifying algorithms that implement these datatypes. Our approach is simple but expressive, allowing us to succinctly specify a variety of abstract datatypes, including maps, sets, lists, text, graphs, trees, and registers. Our datatypes are also composable, enabling the construction of complex data structures. To demonstrate the utility of OpSets for analysing replication algorithms, we highlight an important correctness property for collaborative text editing that has traditionally been overlooked; algorithms that do not satisfy this property can exhibit awkward interleaving of text. We use OpSets to specify this correctness property and prove that although one existing replication algorithm satisfies this property, several other published algorithms do not. [Irrationality_J_Hancl] title = Irrational Rapidly Convergent Series author = Angeliki Koutsoukou-Argyraki <http://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <http://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Number theory, Mathematics/Analysis date = 2018-05-23 notify = ak2110@cam.ac.uk, wl302@cam.ac.uk abstract = We formalize with Isabelle/HOL a proof of a theorem by J. Hancl asserting the irrationality of the sum of a series consisting of rational numbers, built up by sequences that fulfill certain properties. Even though the criterion is a number theoretic result, the proof makes use only of analytical arguments. We also formalize a corollary of the theorem for a specific series fulfilling the assumptions of the theorem. [Optimal_BST] title = Optimal Binary Search Trees author = Tobias Nipkow <https://www.in.tum.de/~nipkow>, Dániel Somogyi <> topic = Computer science/Algorithms, Computer science/Data structures date = 2018-05-27 notify = nipkow@in.tum.de abstract = This article formalizes recursive algorithms for the construction of optimal binary search trees given fixed access frequencies. We follow Knuth (1971), Yao (1980) and Mehlhorn (1984). The algorithms are memoized with the help of the AFP article <a href="Monad_Memo_DP.html">Monadification, Memoization and Dynamic Programming</a>, thus yielding dynamic programming algorithms. [Projective_Geometry] title = Projective Geometry author = Anthony Bordg <https://sites.google.com/site/anthonybordg/> topic = Mathematics/Geometry date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the basics of projective geometry. In particular, we give a proof of the so-called Hessenberg's theorem in projective plane geometry. We also provide a proof of the so-called Desargues's theorem based on an axiomatization of (higher) projective space geometry using the notion of rank of a matroid. This last approach allows to handle incidence relations in an homogeneous way dealing only with points and without the need of talking explicitly about lines, planes or any higher entity. [Localization_Ring] title = The Localization of a Commutative Ring author = Anthony Bordg <https://sites.google.com/site/anthonybordg/> topic = Mathematics/Algebra date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the localization of a commutative ring R with respect to a multiplicative subset (i.e. a submonoid of R seen as a multiplicative monoid). This localization is itself a commutative ring and we build the natural homomorphism of rings from R to its localization. [Minsky_Machines] title = Minsky Machines author = Bertram Felgenhauer<> topic = Logic/Computability date = 2018-08-14 notify = int-e@gmx.de abstract = We formalize undecidablity results for Minsky machines. To this end, we also formalize recursive inseparability. We start by proving that Minsky machines can compute arbitrary primitive recursive and recursive functions. We then show that there is a deterministic Minsky machine with one argument and two final states such that the set of inputs that are accepted in one state is recursively inseparable from the set of inputs that are accepted in the other state. As a corollary, the set of Minsky configurations that reach the first state but not the second recursively inseparable from the set of Minsky configurations that reach the second state but not the first. In particular both these sets are undecidable. We do not prove that recursive functions can simulate Minsky machines. [Neumann_Morgenstern_Utility] title = Von-Neumann-Morgenstern Utility Theorem author = Julian Parsert<mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/> topic = Mathematics/Games and economics license = LGPL date = 2018-07-04 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Utility functions form an essential part of game theory and economics. In order to guarantee the existence of utility functions most of the time sufficient properties are assumed in an axiomatic manner. One famous and very common set of such assumptions is that of expected utility theory. Here, the rationality, continuity, and independence of preferences is assumed. The von-Neumann-Morgenstern Utility theorem shows that these assumptions are necessary and sufficient for an expected utility function to exists. This theorem was proven by Neumann and Morgenstern in ``Theory of Games and Economic Behavior'' which is regarded as one of the most influential works in game theory. The formalization includes formal definitions of the underlying concepts including continuity and independence of preferences. [Simplex] title = An Incremental Simplex Algorithm with Unsatisfiable Core Generation author = Filip Marić <mailto:filip@matf.bg.ac.rs>, Mirko Spasić <mailto:mirko@matf.bg.ac.rs>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/> topic = Computer science/Algorithms/Optimization date = 2018-08-24 notify = rene.thiemann@uibk.ac.at abstract = We present an Isabelle/HOL formalization and total correctness proof for the incremental version of the Simplex algorithm which is used in most state-of-the-art SMT solvers. It supports extraction of satisfying assignments, extraction of minimal unsatisfiable cores, incremental assertion of constraints and backtracking. The formalization relies on stepwise program refinement, starting from a simple specification, going through a number of refinement steps, and ending up in a fully executable functional implementation. Symmetries present in the algorithm are handled with special care. [Budan_Fourier] title = The Budan-Fourier Theorem and Counting Real Roots with Multiplicity author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Analysis date = 2018-09-02 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = This entry is mainly about counting and approximating real roots (of a polynomial) with multiplicity. We have first formalised the Budan-Fourier theorem: given a polynomial with real coefficients, we can calculate sign variations on Fourier sequences to over-approximate the number of real roots (counting multiplicity) within an interval. When all roots are known to be real, the over-approximation becomes tight: we can utilise this theorem to count real roots exactly. It is also worth noting that Descartes' rule of sign is a direct consequence of the Budan-Fourier theorem, and has been included in this entry. In addition, we have extended previous formalised Sturm's theorem to count real roots with multiplicity, while the original Sturm's theorem only counts distinct real roots. Compared to the Budan-Fourier theorem, our extended Sturm's theorem always counts roots exactly but may suffer from greater computational cost. [Quaternions] title = Quaternions author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-05 notify = lp15@cam.ac.uk abstract = This theory is inspired by the HOL Light development of quaternions, but follows its own route. Quaternions are developed coinductively, as in the existing formalisation of the complex numbers. Quaternions are quickly shown to belong to the type classes of real normed division algebras and real inner product spaces. And therefore they inherit a great body of facts involving algebraic laws, limits, continuity, etc., which must be proved explicitly in the HOL Light version. The development concludes with the geometric interpretation of the product of imaginary quaternions. [Octonions] title = Octonions author = Angeliki Koutsoukou-Argyraki <http://www.cl.cam.ac.uk/~ak2110/> topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-14 notify = ak2110@cam.ac.uk abstract = We develop the basic theory of Octonions, including various identities and properties of the octonions and of the octonionic product, a description of 7D isometries and representations of orthogonal transformations. To this end we first develop the theory of the vector cross product in 7 dimensions. The development of the theory of Octonions is inspired by that of the theory of Quaternions by Lawrence Paulson. However, we do not work within the type class real_algebra_1 because the octonionic product is not associative. [Aggregation_Algebras] title = Aggregation Algebras author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Mathematics/Algebra date = 2018-09-15 notify = walter.guttmann@canterbury.ac.nz abstract = We develop algebras for aggregation and minimisation for weight matrices and for edge weights in graphs. We verify the correctness of Prim's and Kruskal's minimum spanning tree algorithms based on these algebras. We also show numerous instances of these algebras based on linearly ordered commutative semigroups. extra-history = Change history: [2020-12-09]: moved Hoare logic to HOL-Hoare, moved spanning trees to Relational_Minimum_Spanning_Trees (revision dbb9bfaf4283) [Prime_Number_Theorem] title = The Prime Number Theorem author = Manuel Eberl <https://pruvisto.org>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Number theory date = 2018-09-19 notify = manuel@pruvisto.org abstract = This article provides a short proof of the Prime Number Theorem in several equivalent forms, most notably π(x) ~ x/ln x where π(x) is the number of primes no larger than x. It also defines other basic number-theoretic functions related to primes like Chebyshev's functions ϑ and ψ and the “n-th prime number” function pn. We also show various bounds and relationship between these functions are shown. Lastly, we derive Mertens' First and Second Theorem, i. e. ∑p≤x ln p/p = ln x + O(1) and ∑p≤x 1/p = ln ln x + M + O(1/ln x). We also give explicit bounds for the remainder terms. The proof of the Prime Number Theorem builds on a library of Dirichlet series and analytic combinatorics. We essentially follow the presentation by Newman. The core part of the proof is a Tauberian theorem for Dirichlet series, which is proven using complex analysis and then used to strengthen Mertens' First Theorem to ∑p≤x ln p/p = ln x + c + o(1). A variant of this proof has been formalised before by Harrison in HOL Light, and formalisations of Selberg's elementary proof exist both by Avigad et al. in Isabelle and by Carneiro in Metamath. The advantage of the analytic proof is that, while it requires more powerful mathematical tools, it is considerably shorter and clearer. This article attempts to provide a short and clear formalisation of all components of that proof using the full range of mathematical machinery available in Isabelle, staying as close as possible to Newman's simple paper proof. [Signature_Groebner] title = Signature-Based Gröbner Basis Algorithms author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/> topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical date = 2018-09-20 notify = alexander.maletzky@risc.jku.at abstract = This article formalizes signature-based algorithms for computing Gröbner bases. Such algorithms are, in general, superior to other algorithms in terms of efficiency, and have not been formalized in any proof assistant so far. The present development is both generic, in the sense that most known variants of signature-based algorithms are covered by it, and effectively executable on concrete input thanks to Isabelle's code generator. Sample computations of benchmark problems show that the verified implementation of signature-based algorithms indeed outperforms the existing implementation of Buchberger's algorithm in Isabelle/HOL. Besides total correctness of the algorithms, the article also proves that under certain conditions they a-priori detect and avoid all useless zero-reductions, and always return 'minimal' (in some sense) Gröbner bases if an input parameter is chosen in the right way.The formalization follows the recent survey article by Eder and Faugère. [Factored_Transition_System_Bounding] title = Upper Bounding Diameters of State Spaces of Factored Transition Systems author = Friedrich Kurz <>, Mohammad Abdulaziz <http://home.in.tum.de/~mansour/> topic = Computer science/Automata and formal languages, Mathematics/Graph theory date = 2018-10-12 notify = friedrich.kurz@tum.de, mohammad.abdulaziz@in.tum.de abstract = A completeness threshold is required to guarantee the completeness of planning as satisfiability, and bounded model checking of safety properties. One valid completeness threshold is the diameter of the underlying transition system. The diameter is the maximum element in the set of lengths of all shortest paths between pairs of states. The diameter is not calculated exactly in our setting, where the transition system is succinctly described using a (propositionally) factored representation. Rather, an upper bound on the diameter is calculated compositionally, by bounding the diameters of small abstract subsystems, and then composing those. We port a HOL4 formalisation of a compositional algorithm for computing a relatively tight upper bound on the system diameter. This compositional algorithm exploits acyclicity in the state space to achieve compositionality, and it was introduced by Abdulaziz et. al. The formalisation that we port is described as a part of another paper by Abdulaziz et. al. As a part of this porting we developed a libray about transition systems, which shall be of use in future related mechanisation efforts. [Smooth_Manifolds] title = Smooth Manifolds author = Fabian Immler <http://home.in.tum.de/~immler/>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/> topic = Mathematics/Analysis, Mathematics/Topology date = 2018-10-22 notify = immler@in.tum.de, bzhan@ios.ac.cn abstract = We formalize the definition and basic properties of smooth manifolds in Isabelle/HOL. Concepts covered include partition of unity, tangent and cotangent spaces, and the fundamental theorem of path integrals. We also examine some concrete manifolds such as spheres and projective spaces. The formalization makes extensive use of the analysis and linear algebra libraries in Isabelle/HOL, in particular its “types-to-sets” mechanism. [Matroids] title = Matroids author = Jonas Keinholz<> topic = Mathematics/Combinatorics date = 2018-11-16 notify = manuel@pruvisto.org abstract = This article defines the combinatorial structures known as Independence Systems and Matroids and provides basic concepts and theorems related to them. These structures play an important role in combinatorial optimisation, e. g. greedy algorithms such as Kruskal's algorithm. The development is based on Oxley's <a href="http://www.math.lsu.edu/~oxley/survey4.pdf">`What is a Matroid?'</a>. [Graph_Saturation] title = Graph Saturation author = Sebastiaan J. C. Joosten<> topic = Logic/Rewriting, Mathematics/Graph theory date = 2018-11-23 notify = sjcjoosten@gmail.com abstract = This is an Isabelle/HOL formalisation of graph saturation, closely following a <a href="https://doi.org/10.1016/j.jlamp.2018.06.005">paper by the author</a> on graph saturation. Nine out of ten lemmas of the original paper are proven in this formalisation. The formalisation additionally includes two theorems that show the main premise of the paper: that consistency and entailment are decided through graph saturation. This formalisation does not give executable code, and it did not implement any of the optimisations suggested in the paper. [Functional_Ordered_Resolution_Prover] title = A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Logic/General logic/Mechanization of proofs date = 2018-11-23 notify = andschl@dtu.dk,j.c.blanchette@vu.nl,traytel@inf.ethz.ch abstract = This Isabelle/HOL formalization refines the abstract ordered resolution prover presented in Section 4.3 of Bachmair and Ganzinger's "Resolution Theorem Proving" chapter in the Handbook of Automated Reasoning. The result is a functional implementation of a first-order prover. [Auto2_HOL] title = Auto2 Prover author = Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/> topic = Tools date = 2018-11-20 notify = bzhan@ios.ac.cn abstract = Auto2 is a saturation-based heuristic prover for higher-order logic, implemented as a tactic in Isabelle. This entry contains the instantiation of auto2 for Isabelle/HOL, along with two basic examples: solutions to some of the Pelletier’s problems, and elementary number theory of primes. [Order_Lattice_Props] title = Properties of Orderings and Lattices author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/> topic = Mathematics/Order date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These components add further fundamental order and lattice-theoretic concepts and properties to Isabelle's libraries. They follow by and large the introductory sections of the Compendium of Continuous Lattices, covering directed and filtered sets, down-closed and up-closed sets, ideals and filters, Galois connections, closure and co-closure operators. Some emphasis is on duality and morphisms between structures, as in the Compendium. To this end, three ad-hoc approaches to duality are compared. [Quantales] title = Quantales author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/> topic = Mathematics/Algebra date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise basic properties of quantales, together with some important models, constructions, and concepts, including quantic nuclei and conuclei. [Transformer_Semantics] title = Transformer Semantics author = Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/> topic = Mathematics/Algebra, Computer science/Semantics date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise predicate transformer semantics for programs, yet currently only for partial correctness and in the absence of faults. A first part for isotone (or monotone), Sup-preserving and Inf-preserving transformers follows Back and von Wright's approach, with additional emphasis on the quantalic structure of algebras of transformers. The second part develops Sup-preserving and Inf-preserving predicate transformers from the powerset monad, via its Kleisli category and Eilenberg-Moore algebras, with emphasis on adjunctions and dualities, as well as isomorphisms between relations, state transformers and predicate transformers. [Concurrent_Revisions] title = Formalization of Concurrent Revisions author = Roy Overbeek <mailto:Roy.Overbeek@cwi.nl> topic = Computer science/Concurrency date = 2018-12-25 notify = Roy.Overbeek@cwi.nl abstract = Concurrent revisions is a concurrency control model developed by Microsoft Research. It has many interesting properties that distinguish it from other well-known models such as transactional memory. One of these properties is determinacy: programs written within the model always produce the same outcome, independent of scheduling activity. The concurrent revisions model has an operational semantics, with an informal proof of determinacy. This document contains an Isabelle/HOL formalization of this semantics and the proof of determinacy. [Core_DOM] title = A Formal Model of the Document Object Model author = Achim D. Brucker <https://www.brucker.ch/>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2018-12-26 notify = adbrucker@0x5f.org abstract = In this AFP entry, we formalize the core of the Document Object Model (DOM). At its core, the DOM defines a tree-like data structure for representing documents in general and HTML documents in particular. It is the heart of any modern web browser. Formalizing the key concepts of the DOM is a prerequisite for the formal reasoning over client-side JavaScript programs and for the analysis of security concepts in modern web browsers. We present a formalization of the core DOM, with focus on the node-tree and the operations defined on node-trees, in Isabelle/HOL. We use the formalization to verify the functional correctness of the most important functions defined in the DOM standard. Moreover, our formalization is 1) extensible, i.e., can be extended without the need of re-proving already proven properties and 2) executable, i.e., we can generate executable code from our specification. [Core_SC_DOM] title = The Safely Composable DOM author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we formalize the core of the Safely Composable Document Object Model (SC DOM). The SC DOM improve the standard DOM (as formalized in the AFP entry "Core DOM") by strengthening the tree boundaries set by shadow roots: in the SC DOM, the shadow root is a sub-class of the document class (instead of a base class). This modifications also results in changes to some API methods (e.g., getOwnerDocument) to return the nearest shadow root rather than the document root. As a result, many API methods that, when called on a node inside a shadow tree, would previously ``break out'' and return or modify nodes that are possibly outside the shadow tree, now stay within its boundaries. This change in behavior makes programs that operate on shadow trees more predictable for the developer and allows them to make more assumptions about other code accessing the DOM. [Shadow_SC_DOM] title = A Formal Model of the Safely Composable Document Object Model with Shadow Roots author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we extend our formalization of the safely composable DOM with Shadow Roots. This is a proposal for Shadow Roots with stricter safety guarantess than the standard compliant formalization (see "Shadow DOM"). Shadow Roots are a recent proposal of the web community to support a component-based development approach for client-side web applications. Shadow roots are a significant extension to the DOM standard and, as web standards are condemned to be backward compatible, such extensions often result in complex specification that may contain unwanted subtleties that can be detected by a formalization. Our Isabelle/HOL formalization is, in the sense of object-orientation, an extension of our formalization of the core DOM and enjoys the same basic properties, i.e., it is extensible, i.e., can be extended without the need of re-proving already proven properties and executable, i.e., we can generate executable code from our specification. We exploit the executability to show that our formalization complies to the official standard of the W3C, respectively, the WHATWG. [SC_DOM_Components] title = A Formalization of Safely Composable Web Components author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = While the (safely composable) DOM with shadow trees provide the technical basis for defining web components, it does neither defines the concept of web components nor specifies the safety properties that web components should guarantee. Consequently, the standard also does not discuss how or even if the methods for modifying the DOM respect component boundaries. In AFP entry, we present a formally verified model of safely composable web components and define safety properties which ensure that different web components can only interact with each other using well-defined interfaces. Moreover, our verification of the application programming interface (API) of the DOM revealed numerous invariants that implementations of the DOM API need to preserve to ensure the integrity of components. In comparison to the strict standard compliance formalization of Web Components in the AFP entry "DOM_Components", the notion of components in this entry (based on "SC_DOM" and "Shadow_SC_DOM") provides much stronger safety guarantees. [Store_Buffer_Reduction] title = A Reduction Theorem for Store Buffers author = Ernie Cohen <mailto:ecohen@amazon.com>, Norbert Schirmer <mailto:norbert.schirmer@web.de> topic = Computer science/Concurrency date = 2019-01-07 notify = norbert.schirmer@web.de abstract = When verifying a concurrent program, it is usual to assume that memory is sequentially consistent. However, most modern multiprocessors depend on store buffering for efficiency, and provide native sequential consistency only at a substantial performance penalty. To regain sequential consistency, a programmer has to follow an appropriate programming discipline. However, naïve disciplines, such as protecting all shared accesses with locks, are not flexible enough for building high-performance multiprocessor software. We present a new discipline for concurrent programming under TSO (total store order, with store buffer forwarding). It does not depend on concurrency primitives, such as locks. Instead, threads use ghost operations to acquire and release ownership of memory addresses. A thread can write to an address only if no other thread owns it, and can read from an address only if it owns it or it is shared and the thread has flushed its store buffer since it last wrote to an address it did not own. This discipline covers both coarse-grained concurrency (where data is protected by locks) as well as fine-grained concurrency (where atomic operations race to memory). We formalize this discipline in Isabelle/HOL, and prove that if every execution of a program in a system without store buffers follows the discipline, then every execution of the program with store buffers is sequentially consistent. Thus, we can show sequential consistency under TSO by ordinary assertional reasoning about the program, without having to consider store buffers at all. [IMP2] title = IMP2 – Simple Program Verification in Isabelle/HOL author = Peter Lammich <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers> topic = Computer science/Programming languages/Logics, Computer science/Algorithms date = 2019-01-15 notify = lammich@in.tum.de abstract = IMP2 is a simple imperative language together with Isabelle tooling to create a program verification environment in Isabelle/HOL. The tools include a C-like syntax, a verification condition generator, and Isabelle commands for the specification of programs. The framework is modular, i.e., it allows easy reuse of already proved programs within larger programs. This entry comes with a quickstart guide and a large collection of examples, spanning basic algorithms with simple proofs to more advanced algorithms and proof techniques like data refinement. Some highlights from the examples are: <ul> <li>Bisection Square Root, </li> <li>Extended Euclid, </li> <li>Exponentiation by Squaring, </li> <li>Binary Search, </li> <li>Insertion Sort, </li> <li>Quicksort, </li> <li>Depth First Search. </li> </ul> The abstract syntax and semantics are very simple and well-documented. They are suitable to be used in a course, as extension to the IMP language which comes with the Isabelle distribution. While this entry is limited to a simple imperative language, the ideas could be extended to more sophisticated languages. [Farkas] title = Farkas' Lemma and Motzkin's Transposition Theorem author = Ralph Bottesch <http://cl-informatik.uibk.ac.at/users/bottesch/>, Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/> topic = Mathematics/Algebra date = 2019-01-17 notify = rene.thiemann@uibk.ac.at abstract = We formalize a proof of Motzkin's transposition theorem and Farkas' lemma in Isabelle/HOL. Our proof is based on the formalization of the simplex algorithm which, given a set of linear constraints, either returns a satisfying assignment to the problem or detects unsatisfiability. By reusing facts about the simplex algorithm we show that a set of linear constraints is unsatisfiable if and only if there is a linear combination of the constraints which evaluates to a trivially unsatisfiable inequality. [Auto2_Imperative_HOL] title = Verifying Imperative Programs using Auto2 author = Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/> topic = Computer science/Algorithms, Computer science/Data structures date = 2018-12-21 notify = bzhan@ios.ac.cn abstract = This entry contains the application of auto2 to verifying functional and imperative programs. Algorithms and data structures that are verified include linked lists, binary search trees, red-black trees, interval trees, priority queue, quicksort, union-find, Dijkstra's algorithm, and a sweep-line algorithm for detecting rectangle intersection. The imperative verification is based on Imperative HOL and its separation logic framework. A major goal of this work is to set up automation in order to reduce the length of proof that the user needs to provide, both for verifying functional programs and for working with separation logic. [UTP] title = Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming author = Simon Foster <https://www-users.cs.york.ac.uk/~simonf/>, Frank Zeyda<>, Yakoub Nemouchi <mailto:yakoub.nemouchi@york.ac.uk>, Pedro Ribeiro<>, Burkhart Wolff<mailto:wolff@lri.fr> topic = Computer science/Programming languages/Logics date = 2019-02-01 notify = simon.foster@york.ac.uk abstract = Isabelle/UTP is a mechanised theory engineering toolkit based on Hoare and He’s Unifying Theories of Programming (UTP). UTP enables the creation of denotational, algebraic, and operational semantics for different programming languages using an alphabetised relational calculus. We provide a semantic embedding of the alphabetised relational calculus in Isabelle/HOL, including new type definitions, relational constructors, automated proof tactics, and accompanying algebraic laws. Isabelle/UTP can be used to both capture laws of programming for different languages, and put these fundamental theorems to work in the creation of associated verification tools, using calculi like Hoare logics. This document describes the relational core of the UTP in Isabelle/HOL. [HOL-CSP] title = HOL-CSP Version 2.0 author = Safouan Taha <mailto:safouan.taha@lri.fr>, Lina Ye <mailto:lina.ye@lri.fr>, Burkhart Wolff<mailto:wolff@lri.fr> topic = Computer science/Concurrency/Process calculi, Computer science/Semantics date = 2019-04-26 notify = wolff@lri.fr abstract = This is a complete formalization of the work of Hoare and Roscoe on the denotational semantics of the Failure/Divergence Model of CSP. It follows essentially the presentation of CSP in Roscoe’s Book ”Theory and Practice of Concurrency” [8] and the semantic details in a joint Paper of Roscoe and Brooks ”An improved failures model for communicating processes". The present work is based on a prior formalization attempt, called HOL-CSP 1.0, done in 1997 by H. Tej and B. Wolff with the Isabelle proof technology available at that time. This work revealed minor, but omnipresent foundational errors in key concepts like the process invariant. The present version HOL-CSP profits from substantially improved libraries (notably HOLCF), improved automated proof techniques, and structured proof techniques in Isar and is substantially shorter but more complete. [Probabilistic_Prime_Tests] title = Probabilistic Primality Testing author = Daniel Stüwe<>, Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2019-02-11 notify = manuel@pruvisto.org abstract = The most efficient known primality tests are probabilistic in the sense that they use randomness and may, with some probability, mistakenly classify a composite number as prime – but never a prime number as composite. Examples of this are the Miller–Rabin test, the Solovay–Strassen test, and (in most cases) Fermat's test. This entry defines these three tests and proves their correctness. It also develops some of the number-theoretic foundations, such as Carmichael numbers and the Jacobi symbol with an efficient executable algorithm to compute it. [Kruskal] title = Kruskal's Algorithm for Minimum Spanning Forest author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Peter Lammich <http://www21.in.tum.de/~lammich>, Julian Biendarra<> topic = Computer science/Algorithms/Graph date = 2019-02-14 notify = haslbema@in.tum.de, lammich@in.tum.de abstract = This Isabelle/HOL formalization defines a greedy algorithm for finding a minimum weight basis on a weighted matroid and proves its correctness. This algorithm is an abstract version of Kruskal's algorithm. We interpret the abstract algorithm for the cycle matroid (i.e. forests in a graph) and refine it to imperative executable code using an efficient union-find data structure. Our formalization can be instantiated for different graph representations. We provide instantiations for undirected graphs and symmetric directed graphs. [List_Inversions] title = The Inversions of a List author = Manuel Eberl <https://pruvisto.org> topic = Computer science/Algorithms date = 2019-02-01 notify = manuel@pruvisto.org abstract = This entry defines the set of inversions of a list, i.e. the pairs of indices that violate sortedness. It also proves the correctness of the well-known O(n log n) divide-and-conquer algorithm to compute the number of inversions. [Prime_Distribution_Elementary] title = Elementary Facts About the Distribution of Primes author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2019-02-21 notify = manuel@pruvisto.org abstract = This entry is a formalisation of Chapter 4 (and parts of Chapter 3) of Apostol's <a href="https://www.springer.com/de/book/9780387901633">Introduction to Analytic Number Theory</a>. The main topics that are addressed are properties of the distribution of prime numbers that can be shown in an elementary way (i. e. without the Prime Number Theorem), the various equivalent forms of the PNT (which imply each other in elementary ways), and consequences that follow from the PNT in elementary ways. The latter include, most notably, asymptotic bounds for the number of distinct prime factors of n, the divisor function d(n), Euler's totient function φ(n), and lcm(1,…,n). [Safe_OCL] title = Safe OCL author = Denis Nikiforov <> topic = Computer science/Programming languages/Language definitions license = LGPL date = 2019-03-09 notify = denis.nikif@gmail.com abstract = The theory is a formalization of the <a href="https://www.omg.org/spec/OCL/">OCL</a> type system, its abstract syntax and expression typing rules. The theory does not define a concrete syntax and a semantics. In contrast to <a href="https://www.isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a>, it is based on a deep embedding approach. The type system is defined from scratch, it is not based on the Isabelle HOL type system. The Safe OCL distincts nullable and non-nullable types. Also the theory gives a formal definition of <a href="http://ceur-ws.org/Vol-1512/paper07.pdf">safe navigation operations</a>. The Safe OCL typing rules are much stricter than rules given in the OCL specification. It allows one to catch more errors on a type checking phase. The type theory presented is four-layered: classes, basic types, generic types, errorable types. We introduce the following new types: non-nullable types (T[1]), nullable types (T[?]), OclSuper. OclSuper is a supertype of all other types (basic types, collections, tuples). This type allows us to define a total supremum function, so types form an upper semilattice. It allows us to define rich expression typing rules in an elegant manner. The Preliminaries Chapter of the theory defines a number of helper lemmas for transitive closures and tuples. It defines also a generic object model independent from OCL. It allows one to use the theory as a reference for formalization of analogous languages. [QHLProver] title = Quantum Hoare Logic author = Junyi Liu<>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>, Shuling Wang<>, Shenggang Ying<>, Tao Liu<>, Yangjia Li<>, Mingsheng Ying<>, Naijun Zhan<> topic = Computer science/Programming languages/Logics, Computer science/Semantics date = 2019-03-24 notify = bzhan@ios.ac.cn abstract = We formalize quantum Hoare logic as given in [1]. In particular, we specify the syntax and denotational semantics of a simple model of quantum programs. Then, we write down the rules of quantum Hoare logic for partial correctness, and show the soundness and completeness of the resulting proof system. As an application, we verify the correctness of Grover’s algorithm. [Transcendence_Series_Hancl_Rucki] title = The Transcendence of Certain Infinite Series author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Analysis, Mathematics/Number theory date = 2019-03-27 notify = wl302@cam.ac.uk, ak2110@cam.ac.uk abstract = We formalize the proofs of two transcendence criteria by J. Hančl and P. Rucki that assert the transcendence of the sums of certain infinite series built up by sequences that fulfil certain properties. Both proofs make use of Roth's celebrated theorem on diophantine approximations to algebraic numbers from 1955 which we implement as an assumption without having formalised its proof. [Binding_Syntax_Theory] title = A General Theory of Syntax with Bindings author = Lorenzo Gheri <mailto:lor.gheri@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk> topic = Computer science/Programming languages/Lambda calculi, Computer science/Functional programming, Logic/General logic/Mechanization of proofs date = 2019-04-06 notify = a.popescu@mdx.ac.uk, lor.gheri@gmail.com abstract = We formalize a theory of syntax with bindings that has been developed and refined over the last decade to support several large formalization efforts. Terms are defined for an arbitrary number of constructors of varying numbers of inputs, quotiented to alpha-equivalence and sorted according to a binding signature. The theory includes many properties of the standard operators on terms: substitution, swapping and freshness. It also includes bindings-aware induction and recursion principles and support for semantic interpretation. This work has been presented in the ITP 2017 paper “A Formalized General Theory of Syntax with Bindings”. [LTL_Master_Theorem] title = A Compositional and Unified Translation of LTL into ω-Automata author = Benedikt Seidl <mailto:benedikt.seidl@tum.de>, Salomon Sickert <mailto:s.sickert@tum.de> topic = Computer science/Automata and formal languages date = 2019-04-16 notify = benedikt.seidl@tum.de, s.sickert@tum.de abstract = We present a formalisation of the unified translation approach of linear temporal logic (LTL) into ω-automata from [1]. This approach decomposes LTL formulas into ``simple'' languages and allows a clear separation of concerns: first, we formalise the purely logical result yielding this decomposition; second, we instantiate this generic theory to obtain a construction for deterministic (state-based) Rabin automata (DRA). We extract from this particular instantiation an executable tool translating LTL to DRAs. To the best of our knowledge this is the first verified translation from LTL to DRAs that is proven to be double exponential in the worst case which asymptotically matches the known lower bound. [1] Javier Esparza, Jan Kretínský, Salomon Sickert. One Theorem to Rule Them All: A Unified Translation of LTL into ω-Automata. LICS 2018 [LambdaAuth] title = Formalization of Generic Authenticated Data Structures author = Matthias Brun<>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Security, Computer science/Programming languages/Lambda calculi date = 2019-05-14 notify = traytel@inf.ethz.ch abstract = Authenticated data structures are a technique for outsourcing data storage and maintenance to an untrusted server. The server is required to produce an efficiently checkable and cryptographically secure proof that it carried out precisely the requested computation. <a href="https://doi.org/10.1145/2535838.2535851">Miller et al.</a> introduced λ• (pronounced lambda auth)—a functional programming language with a built-in primitive authentication construct, which supports a wide range of user-specified authenticated data structures while guaranteeing certain correctness and security properties for all well-typed programs. We formalize λ• and prove its correctness and security properties. With Isabelle's help, we uncover and repair several mistakes in the informal proofs and lemma statements. Our findings are summarized in an <a href="https://doi.org/10.4230/LIPIcs.ITP.2019.10">ITP'19 paper</a>. [IMP2_Binary_Heap] title = Binary Heaps for IMP2 author = Simon Griebel<> topic = Computer science/Data structures, Computer science/Algorithms date = 2019-06-13 notify = s.griebel@tum.de abstract = In this submission array-based binary minimum heaps are formalized. The correctness of the following heap operations is proved: insert, get-min, delete-min and make-heap. These are then used to verify an in-place heapsort. The formalization is based on IMP2, an imperative program verification framework implemented in Isabelle/HOL. The verified heap functions are iterative versions of the partly recursive functions found in "Algorithms and Data Structures – The Basic Toolbox" by K. Mehlhorn and P. Sanders and "Introduction to Algorithms" by T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein. [Groebner_Macaulay] title = Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/> topic = Mathematics/Algebra date = 2019-06-15 notify = alexander.maletzky@risc.jku.at abstract = This entry formalizes the connection between Gröbner bases and Macaulay matrices (sometimes also referred to as `generalized Sylvester matrices'). In particular, it contains a method for computing Gröbner bases, which proceeds by first constructing some Macaulay matrix of the initial set of polynomials, then row-reducing this matrix, and finally converting the result back into a set of polynomials. The output is shown to be a Gröbner basis if the Macaulay matrix constructed in the first step is sufficiently large. In order to obtain concrete upper bounds on the size of the matrix (and hence turn the method into an effectively executable algorithm), Dubé's degree bounds on Gröbner bases are utilized; consequently, they are also part of the formalization. [Linear_Inequalities] title = Linear Inequalities author = Ralph Bottesch <http://cl-informatik.uibk.ac.at/users/bottesch/>, Alban Reynaud <>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/> topic = Mathematics/Algebra date = 2019-06-21 notify = rene.thiemann@uibk.ac.at abstract = We formalize results about linear inqualities, mainly from Schrijver's book. The main results are the proof of the fundamental theorem on linear inequalities, Farkas' lemma, Carathéodory's theorem, the Farkas-Minkowsky-Weyl theorem, the decomposition theorem of polyhedra, and Meyer's result that the integer hull of a polyhedron is a polyhedron itself. Several theorems include bounds on the appearing numbers, and in particular we provide an a-priori bound on mixed-integer solutions of linear inequalities. [Linear_Programming] title = Linear Programming author = Julian Parsert <http://www.parsert.com/>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/cek/> topic = Mathematics/Algebra date = 2019-08-06 notify = julian.parsert@gmail.com, cezary.kaliszyk@uibk.ac.at abstract = We use the previous formalization of the general simplex algorithm to formulate an algorithm for solving linear programs. We encode the linear programs using only linear constraints. Solving these constraints also solves the original linear program. This algorithm is proven to be sound by applying the weak duality theorem which is also part of this formalization. [Differential_Game_Logic] title = Differential Game Logic author = André Platzer <http://www.cs.cmu.edu/~aplatzer/> topic = Computer science/Programming languages/Logics date = 2019-06-03 notify = aplatzer@cs.cmu.edu abstract = This formalization provides differential game logic (dGL), a logic for proving properties of hybrid game. In addition to the syntax and semantics, it formalizes a uniform substitution calculus for dGL. Church's uniform substitutions substitute a term or formula for a function or predicate symbol everywhere. The uniform substitutions for dGL also substitute hybrid games for a game symbol everywhere. We prove soundness of one-pass uniform substitutions and the axioms of differential game logic with respect to their denotational semantics. One-pass uniform substitutions are faster by postponing soundness-critical admissibility checks with a linear pass homomorphic application and regain soundness by a variable condition at the replacements. The formalization is based on prior non-mechanized soundness proofs for dGL. [BenOr_Kozen_Reif] title = The BKR Decision Procedure for Univariate Real Arithmetic author = Katherine Cordwell <https://www.cs.cmu.edu/~kcordwel/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/>, André Platzer <https://www.cs.cmu.edu/~aplatzer/> topic = Computer science/Algorithms/Mathematical date = 2021-04-24 notify = kcordwel@cs.cmu.edu, yongkiat@cs.cmu.edu, aplatzer@cs.cmu.edu abstract = We formalize the univariate case of Ben-Or, Kozen, and Reif's decision procedure for first-order real arithmetic (the BKR algorithm). We also formalize the univariate case of Renegar's variation of the BKR algorithm. The two formalizations differ mathematically in minor ways (that have significant impact on the multivariate case), but are quite similar in proof structure. Both rely on sign-determination (finding the set of consistent sign assignments for a set of polynomials). The method used for sign-determination is similar to Tarski's original quantifier elimination algorithm (it stores key information in a matrix equation), but with a reduction step to keep complexity low. [Complete_Non_Orders] title = Complete Non-Orders and Fixed Points author = Akihisa Yamada <http://group-mmm.org/~ayamada/>, Jérémy Dubut <http://group-mmm.org/~dubut/> topic = Mathematics/Order date = 2019-06-27 notify = akihisayamada@nii.ac.jp, dubut@nii.ac.jp abstract = We develop an Isabelle/HOL library of order-theoretic concepts, such as various completeness conditions and fixed-point theorems. We keep our formalization as general as possible: we reprove several well-known results about complete orders, often without any properties of ordering, thus complete non-orders. In particular, we generalize the Knaster–Tarski theorem so that we ensure the existence of a quasi-fixed point of monotone maps over complete non-orders, and show that the set of quasi-fixed points is complete under a mild condition—attractivity—which is implied by either antisymmetry or transitivity. This result generalizes and strengthens a result by Stauti and Maaden. Finally, we recover Kleene’s fixed-point theorem for omega-complete non-orders, again using attractivity to prove that Kleene’s fixed points are least quasi-fixed points. [Priority_Search_Trees] title = Priority Search Trees author = Peter Lammich <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> topic = Computer science/Data structures date = 2019-06-25 notify = lammich@in.tum.de abstract = We present a new, purely functional, simple and efficient data structure combining a search tree and a priority queue, which we call a priority search tree. The salient feature of priority search trees is that they offer a decrease-key operation, something that is missing from other simple, purely functional priority queue implementations. Priority search trees can be implemented on top of any search tree. This entry does the implementation for red-black trees. This entry formalizes the first part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [Prim_Dijkstra_Simple] title = Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra author = Peter Lammich <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~nipkow> topic = Computer science/Algorithms/Graph date = 2019-06-25 notify = lammich@in.tum.de abstract = We verify purely functional, simple and efficient implementations of Prim's and Dijkstra's algorithms. This constitutes the first verification of an executable and even efficient version of Prim's algorithm. This entry formalizes the second part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [MFOTL_Monitor] title = Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic author = Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Algorithms, Logic/General logic/Temporal logic, Computer science/Automata and formal languages date = 2019-07-04 notify = joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order temporal logic (MFOTL), an expressive extension of linear temporal logic with real-time constraints and first-order quantification. The verified monitor implements a simplified variant of the algorithm used in the efficient MonPoly monitoring tool. The formalization is presented in a <a href="https://doi.org/10.1007/978-3-030-32079-9_18">RV 2019 paper</a>, which also compares the output of the verified monitor to that of other monitoring tools on randomly generated inputs. This case study revealed several errors in the optimized but unverified tools. extra-history = Change history: [2020-08-13]: added the formalization of the abstract slicing framework and joint data slicer (revision b1639ed541b7) [FOL_Seq_Calc1] title = A Sequent Calculus for First-Order Logic author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> contributors = Alexander Birch Jensen <https://people.compute.dtu.dk/aleje/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/> topic = Logic/Proof theory date = 2019-07-18 notify = ahfrom@dtu.dk abstract = This work formalizes soundness and completeness of a one-sided sequent calculus for first-order logic. The completeness is shown via a translation from a complete semantic tableau calculus, the proof of which is based on the First-Order Logic According to Fitting theory. The calculi and proof techniques are taken from Ben-Ari's Mathematical Logic for Computer Science. Paper: <a href="http://ceur-ws.org/Vol-3002/paper7.pdf">http://ceur-ws.org/Vol-3002/paper7.pdf</a>. [Szpilrajn] title = Order Extension and Szpilrajn's Extension Theorem author = Peter Zeller <mailto:p_zeller@cs.uni-kl.de>, Lukas Stevens <https://www21.in.tum.de/team/stevensl> topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = This entry is concerned with the principle of order extension, i.e. the extension of an order relation to a total order relation. To this end, we prove a more general version of Szpilrajn's extension theorem employing terminology from the book "Consistency, Choice, and Rationality" by Bossert and Suzumura. We also formalize theorem 2.7 of their book. extra-history = Change history: [2021-03-22]: (by Lukas Stevens) generalise Szpilrajn's extension theorem and add material from the book "Consistency, Choice, and Rationality" [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van <mailto:hai.nguyenvan.phie@gmail.com>, Frédéric Boulanger <mailto:frederic.boulanger@centralesupelec.fr>, Burkhart Wolff <mailto:burkhart.wolff@lri.fr> topic = Computer science/System description languages, Computer science/Semantics, Computer science/Concurrency date = 2019-07-30 notify = frederic.boulanger@centralesupelec.fr, burkhart.wolff@lri.fr abstract = The design of complex systems involves different formalisms for modeling their different parts or aspects. The global model of a system may therefore consist of a coordination of concurrent sub-models that use different paradigms. We develop here a theory for a language used to specify the timed coordination of such heterogeneous subsystems by addressing the following issues: <ul><li>the behavior of the sub-systems is observed only at a series of discrete instants,</li><li>events may occur in different sub-systems at unrelated times, leading to polychronous systems, which do not necessarily have a common base clock,</li><li>coordination between subsystems involves causality, so the occurrence of an event may enforce the occurrence of other events, possibly after a certain duration has elapsed or an event has occurred a given number of times,</li><li>the domain of time (discrete, rational, continuous...) may be different in the subsystems, leading to polytimed systems,</li><li>the time frames of different sub-systems may be related (for instance, time in a GPS satellite and in a GPS receiver on Earth are related although they are not the same).</li></ul> Firstly, a denotational semantics of the language is defined. Then, in order to be able to incrementally check the behavior of systems, an operational semantics is given, with proofs of progress, soundness and completeness with regard to the denotational semantics. These proofs are made according to a setup that can scale up when new operators are added to the language. In order for specifications to be composed in a clean way, the language should be invariant by stuttering (i.e., adding observation instants at which nothing happens). The proof of this invariance is also given. [Stellar_Quorums] title = Stellar Quorum Systems author = Giuliano Losa <mailto:giuliano@galois.com> topic = Computer science/Algorithms/Distributed date = 2019-08-01 notify = giuliano@galois.com abstract = We formalize the static properties of personal Byzantine quorum systems (PBQSs) and Stellar quorum systems, as described in the paper ``Stellar Consensus by Reduction'' (to appear at DISC 2019). [IMO2019] title = Selected Problems from the International Mathematical Olympiad 2019 author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Misc date = 2019-08-05 notify = manuel@pruvisto.org abstract = This entry contains formalisations of the answers to three of the six problem of the International Mathematical Olympiad 2019, namely Q1, Q4, and Q5. The reason why these problems were chosen is that they are particularly amenable to formalisation: they can be solved with minimal use of libraries. The remaining three concern geometry and graph theory, which, in the author's opinion, are more difficult to formalise resp. require a more complex library. [Adaptive_State_Counting] title = Formalisation of an Adaptive State Counting Algorithm author = Robert Sachtleben <mailto:rob_sac@uni-bremen.de> topic = Computer science/Automata and formal languages, Computer science/Algorithms date = 2019-08-16 notify = rob_sac@uni-bremen.de abstract = This entry provides a formalisation of a refinement of an adaptive state counting algorithm, used to test for reduction between finite state machines. The algorithm has been originally presented by Hierons in the paper <a href="https://doi.org/10.1109/TC.2004.85">Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting</a>. Definitions for finite state machines and adaptive test cases are given and many useful theorems are derived from these. The algorithm is formalised using mutually recursive functions, for which it is proven that the generated test suite is sufficient to test for reduction against finite state machines of a certain fault domain. Additionally, the algorithm is specified in a simple WHILE-language and its correctness is shown using Hoare-logic. [Jacobson_Basic_Algebra] title = A Case Study in Basic Algebra author = Clemens Ballarin <http://www21.in.tum.de/~ballarin/> topic = Mathematics/Algebra date = 2019-08-30 notify = ballarin@in.tum.de abstract = The focus of this case study is re-use in abstract algebra. It contains locale-based formalisations of selected parts of set, group and ring theory from Jacobson's Basic Algebra leading to the respective fundamental homomorphism theorems. The study is not intended as a library base for abstract algebra. It rather explores an approach towards abstract algebra in Isabelle. [Hybrid_Systems_VCs] title = Verification Components for Hybrid Systems author = Jonathan Julian Huerta y Munive <> topic = Mathematics/Algebra, Mathematics/Analysis date = 2019-09-10 notify = jjhuertaymunive1@sheffield.ac.uk, jonjulian23@gmail.com abstract = These components formalise a semantic framework for the deductive verification of hybrid systems. They support reasoning about continuous evolutions of hybrid programs in the style of differential dynamics logic. Vector fields or flows model these evolutions, and their verification is done with invariants for the former or orbits for the latter. Laws of modal Kleene algebra or categorical predicate transformers implement the verification condition generation. Examples show the approach at work. extra-history = Change history: [2020-12-13]: added components based on Kleene algebras with tests. These implement differential Hoare logic (dH) and a Morgan-style differential refinement calculus (dR) for verification of hybrid programs. [Generic_Join] title = Formalization of Multiway-Join Algorithms author = Thibault Dardinier<> topic = Computer science/Algorithms date = 2019-09-16 notify = tdardini@student.ethz.ch, traytel@inf.ethz.ch abstract = Worst-case optimal multiway-join algorithms are recent seminal achievement of the database community. These algorithms compute the natural join of multiple relational databases and improve in the worst case over traditional query plan optimizations of nested binary joins. In 2014, <a href="https://doi.org/10.1145/2590989.2590991">Ngo, Ré, and Rudra</a> gave a unified presentation of different multi-way join algorithms. We formalized and proved correct their "Generic Join" algorithm and extended it to support negative joins. [Aristotles_Assertoric_Syllogistic] title = Aristotle's Assertoric Syllogistic author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/> topic = Logic/Philosophical aspects date = 2019-10-08 notify = ak2110@cam.ac.uk abstract = We formalise with Isabelle/HOL some basic elements of Aristotle's assertoric syllogistic following the <a href="https://plato.stanford.edu/entries/aristotle-logic/">article from the Stanford Encyclopedia of Philosophy by Robin Smith.</a> To this end, we use a set theoretic formulation (covering both individual and general predication). In particular, we formalise the deductions in the Figures and after that we present Aristotle's metatheoretical observation that all deductions in the Figures can in fact be reduced to either Barbara or Celarent. As the formal proofs prove to be straightforward, the interest of this entry lies in illustrating the functionality of Isabelle and high efficiency of Sledgehammer for simple exercises in philosophy. [VerifyThis2019] title = VerifyThis 2019 -- Polished Isabelle Solutions author = Peter Lammich<>, Simon Wimmer<http://home.in.tum.de/~wimmers/> topic = Computer science/Algorithms date = 2019-10-16 notify = lammich@in.tum.de, wimmers@in.tum.de abstract = VerifyThis 2019 (http://www.pm.inf.ethz.ch/research/verifythis.html) was a program verification competition associated with ETAPS 2019. It was the 8th event in the VerifyThis competition series. In this entry, we present polished and completed versions of our solutions that we created during the competition. [ZFC_in_HOL] title = Zermelo Fraenkel Set Theory in Higher-Order Logic author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Logic/Set theory date = 2019-10-24 notify = lp15@cam.ac.uk abstract = This entry is a new formalisation of ZFC set theory in Isabelle/HOL. It is logically equivalent to Obua's HOLZF; the point is to have the closest possible integration with the rest of Isabelle/HOL, minimising the amount of new notations and exploiting type classes. There is a type V of sets and a function elts :: V => V set mapping a set to its elements. Classes simply have type V set, and a predicate identifies the small classes: those that correspond to actual sets. Type classes connected with orders and lattices are used to minimise the amount of new notation for concepts such as the subset relation, union and intersection. Basic concepts — Cartesian products, disjoint sums, natural numbers, functions, etc. — are formalised. More advanced set-theoretic concepts, such as transfinite induction, ordinals, cardinals and the transitive closure of a set, are also provided. The definition of addition and multiplication for general sets (not just ordinals) follows Kirby. The theory provides two type classes with the aim of facilitating developments that combine V with other Isabelle/HOL types: embeddable, the class of types that can be injected into V (including V itself as well as V*V, etc.), and small, the class of types that correspond to some ZF set. extra-history = Change history: [2020-01-28]: Generalisation of the "small" predicate and order types to arbitrary sets; ordinal exponentiation; introduction of the coercion ord_of_nat :: "nat => V"; numerous new lemmas. (revision 6081d5be8d08) [Interval_Arithmetic_Word32] title = Interval Arithmetic on 32-bit Words author = Brandon Bohrer <mailto:bbohrer@cs.cmu.edu> topic = Computer science/Data structures date = 2019-11-27 notify = bjbohrer@gmail.com, bbohrer@cs.cmu.edu abstract = Interval_Arithmetic implements conservative interval arithmetic computations, then uses this interval arithmetic to implement a simple programming language where all terms have 32-bit signed word values, with explicit infinities for terms outside the representable bounds. Our target use case is interpreters for languages that must have a well-understood low-level behavior. We include a formalization of bounded-length strings which are used for the identifiers of our language. Bounded-length identifiers are useful in some applications, for example the <a href="https://www.isa-afp.org/entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a> article, where a Euclidean space indexed by identifiers demands that identifiers are finitely many. [Generalized_Counting_Sort] title = An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> topic = Computer science/Algorithms, Computer science/Functional programming date = 2019-12-04 notify = pasquale.noce.lavoro@gmail.com abstract = Counting sort is a well-known algorithm that sorts objects of any kind mapped to integer keys, or else to keys in one-to-one correspondence with some subset of the integers (e.g. alphabet letters). However, it is suitable for direct use, viz. not just as a subroutine of another sorting algorithm (e.g. radix sort), only if the key range is not significantly larger than the number of the objects to be sorted. This paper describes a tail-recursive generalization of counting sort making use of a bounded number of counters, suitable for direct use in case of a large, or even infinite key range of any kind, subject to the only constraint of being a subset of an arbitrary linear order. After performing a pen-and-paper analysis of how such algorithm has to be designed to maximize its efficiency, this paper formalizes the resulting generalized counting sort (GCsort) algorithm and then formally proves its correctness properties, namely that (a) the counters' number is maximized never exceeding the fixed upper bound, (b) objects are conserved, (c) objects get sorted, and (d) the algorithm is stable. [Poincare_Bendixson] title = The Poincaré-Bendixson Theorem author = Fabian Immler <http://home.in.tum.de/~immler/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/> topic = Mathematics/Analysis date = 2019-12-18 notify = fimmler@cs.cmu.edu, yongkiat@cs.cmu.edu abstract = The Poincaré-Bendixson theorem is a classical result in the study of (continuous) dynamical systems. Colloquially, it restricts the possible behaviors of planar dynamical systems: such systems cannot be chaotic. In practice, it is a useful tool for proving the existence of (limiting) periodic behavior in planar systems. The theorem is an interesting and challenging benchmark for formalized mathematics because proofs in the literature rely on geometric sketches and only hint at symmetric cases. It also requires a substantial background of mathematical theories, e.g., the Jordan curve theorem, real analysis, ordinary differential equations, and limiting (long-term) behavior of dynamical systems. [Isabelle_C] title = Isabelle/C author = Frédéric Tuong <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~wolff/> topic = Computer science/Programming languages/Language definitions, Computer science/Semantics, Tools date = 2019-10-22 notify = tuong@users.gforge.inria.fr, wolff@lri.fr abstract = We present a framework for C code in C11 syntax deeply integrated into the Isabelle/PIDE development environment. Our framework provides an abstract interface for verification back-ends to be plugged-in independently. Thus, various techniques such as deductive program verification or white-box testing can be applied to the same source, which is part of an integrated PIDE document model. Semantic back-ends are free to choose the supported C fragment and its semantics. In particular, they can differ on the chosen memory model or the specification mechanism for framing conditions. Our framework supports semantic annotations of C sources in the form of comments. Annotations serve to locally control back-end settings, and can express the term focus to which an annotation refers. Both the logical and the syntactic context are available when semantic annotations are evaluated. As a consequence, a formula in an annotation can refer both to HOL or C variables. Our approach demonstrates the degree of maturity and expressive power the Isabelle/PIDE sub-system has achieved in recent years. Our integration technique employs Lex and Yacc style grammars to ensure efficient deterministic parsing. This is the core-module of Isabelle/C; the AFP package for Clean and Clean_wrapper as well as AutoCorres and AutoCorres_wrapper (available via git) are applications of this front-end. [Zeta_3_Irrational] title = The Irrationality of ζ(3) author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2019-12-27 notify = manuel.eberl@tum.de abstract = This article provides a formalisation of Beukers's straightforward analytic proof that ζ(3) is irrational. This was first proven by Apéry (which is why this result is also often called ‘Apéry's Theorem’) using a more algebraic approach. This formalisation follows <a href="http://people.math.sc.edu/filaseta/gradcourses/Math785/Math785Notes4.pdf">Filaseta's presentation</a> of Beukers's proof. [Hybrid_Logic] title = Formalizing a Seligman-Style Tableau System for Hybrid Logic author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> topic = Logic/General logic/Modal logic date = 2019-12-20 notify = ahfrom@dtu.dk abstract = This work is a formalization of soundness and completeness proofs for a Seligman-style tableau system for hybrid logic. The completeness result is obtained via a synthetic approach using maximally consistent sets of tableau blocks. The formalization differs from previous work in a few ways. First, to avoid the need to backtrack in the construction of a tableau, the formalized system has no unnamed initial segment, and therefore no Name rule. Second, I show that the full Bridge rule is admissible in the system. Third, I start from rules restricted to only extend the branch with new formulas, including only witnessing diamonds that are not already witnessed, and show that the unrestricted rules are admissible. Similarly, I start from simpler versions of the @-rules and show that these are sufficient. The GoTo rule is restricted using a notion of potential such that each application consumes potential and potential is earned through applications of the remaining rules. I show that if a branch can be closed then it can be closed starting from a single unit. Finally, Nom is restricted by a fixed set of allowed nominals. The resulting system should be terminating. extra-history = Change history: [2020-06-03]: The fully restricted system has been shown complete by updating the synthetic completeness proof. [Bicategory] title = Bicategories author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu> topic = Mathematics/Category theory date = 2020-01-06 notify = stark@cs.stonybrook.edu abstract = Taking as a starting point the author's previous work on developing aspects of category theory in Isabelle/HOL, this article gives a compatible formalization of the notion of "bicategory" and develops a framework within which formal proofs of facts about bicategories can be given. The framework includes a number of basic results, including the Coherence Theorem, the Strictness Theorem, pseudofunctors and biequivalence, and facts about internal equivalences and adjunctions in a bicategory. As a driving application and demonstration of the utility of the framework, it is used to give a formal proof of a theorem, due to Carboni, Kasangian, and Street, that characterizes up to biequivalence the bicategories of spans in a category with pullbacks. The formalization effort necessitated the filling-in of many details that were not evident from the brief presentation in the original paper, as well as identifying a few minor corrections along the way. Revisions made subsequent to the first version of this article added additional material on pseudofunctors, pseudonatural transformations, modifications, and equivalence of bicategories; the main thrust being to give a proof that a pseudofunctor is a biequivalence if and only if it can be extended to an equivalence of bicategories. extra-history = Change history: [2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867) [2020-11-04]: Added new material on equivalence of bicategories, with associated changes. (revision 472cb2268826) [2021-07-22]: Added new material: "concrete bicategories" and "bicategory of categories". (revision 49d3aa43c180) [Subset_Boolean_Algebras] title = A Hierarchy of Algebras for Boolean Subsets author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Bernhard Möller <https://www.informatik.uni-augsburg.de/en/chairs/dbis/pmi/staff/moeller/> topic = Mathematics/Algebra date = 2020-01-31 notify = walter.guttmann@canterbury.ac.nz abstract = We present a collection of axiom systems for the construction of Boolean subalgebras of larger overall algebras. The subalgebras are defined as the range of a complement-like operation on a semilattice. This technique has been used, for example, with the antidomain operation, dynamic negation and Stone algebras. We present a common ground for these constructions based on a new equational axiomatisation of Boolean algebras. [Goodstein_Lambda] title = Implementing the Goodstein Function in λ-Calculus author = Bertram Felgenhauer <mailto:int-e@gmx.de> topic = Logic/Rewriting date = 2020-02-21 notify = int-e@gmx.de abstract = In this formalization, we develop an implementation of the Goodstein function G in plain λ-calculus, linked to a concise, self-contained specification. The implementation works on a Church-encoded representation of countable ordinals. The initial conversion to hereditary base 2 is not covered, but the material is sufficient to compute the particular value G(16), and easily extends to other fixed arguments. [VeriComp] title = A Generic Framework for Verified Compilers author = Martin Desharnais <https://martin.desharnais.me> topic = Computer science/Programming languages/Compiling date = 2020-02-10 notify = martin.desharnais@unibw.de abstract = This is a generic framework for formalizing compiler transformations. It leverages Isabelle/HOL’s locales to abstract over concrete languages and transformations. It states common definitions for language semantics, program behaviours, forward and backward simulations, and compilers. We provide generic operations, such as simulation and compiler composition, and prove general (partial) correctness theorems, resulting in reusable proof components. [Hello_World] title = Hello World author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~hupel/> topic = Computer science/Functional programming date = 2020-03-07 notify = diekmann@net.in.tum.de abstract = In this article, we present a formalization of the well-known "Hello, World!" code, including a formal framework for reasoning about IO. Our model is inspired by the handling of IO in Haskell. We start by formalizing the 🌍 and embrace the IO monad afterwards. Then we present a sample main :: IO (), followed by its proof of correctness. [WOOT_Strong_Eventual_Consistency] title = Strong Eventual Consistency of the Collaborative Editing Framework WOOT author = Emin Karayel <https://orcid.org/0000-0003-3290-5034>, Edgar Gonzàlez <mailto:edgargip@google.com> topic = Computer science/Algorithms/Distributed date = 2020-03-25 notify = eminkarayel@google.com, edgargip@google.com, me@eminkarayel.de abstract = Commutative Replicated Data Types (CRDTs) are a promising new class of data structures for large-scale shared mutable content in applications that only require eventual consistency. The WithOut Operational Transforms (WOOT) framework is a CRDT for collaborative text editing introduced by Oster et al. (CSCW 2006) for which the eventual consistency property was verified only for a bounded model to date. We contribute a formal proof for WOOTs strong eventual consistency. [Furstenberg_Topology] title = Furstenberg's topology and his proof of the infinitude of primes author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2020-03-22 notify = manuel.eberl@tum.de abstract = This article gives a formal version of Furstenberg's topological proof of the infinitude of primes. He defines a topology on the integers based on arithmetic progressions (or, equivalently, residue classes). Using some fairly obvious properties of this topology, the infinitude of primes is then easily obtained. Apart from this, this topology is also fairly ‘nice’ in general: it is second countable, metrizable, and perfect. All of these (well-known) facts are formally proven, including an explicit metric for the topology given by Zulfeqarr. [Saturation_Framework] title = A Comprehensive Framework for Saturation Theorem Proving author = Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret/> topic = Logic/General logic/Mechanization of proofs date = 2020-04-09 notify = stourret@mpi-inf.mpg.de abstract = This Isabelle/HOL formalization is the companion of the technical report “A comprehensive framework for saturation theorem proving”, itself companion of the eponym IJCAR 2020 paper, written by Uwe Waldmann, Sophie Tourret, Simon Robillard and Jasmin Blanchette. It verifies a framework for formal refutational completeness proofs of abstract provers that implement saturation calculi, such as ordered resolution or superposition, and allows to model entire prover architectures in such a way that the static refutational completeness of a calculus immediately implies the dynamic refutational completeness of a prover implementing the calculus using a variant of the given clause loop. The technical report “A comprehensive framework for saturation theorem proving” is available <a href="http://matryoshka.gforge.inria.fr/pubs/satur_report.pdf">on the Matryoshka website</a>. The names of the Isabelle lemmas and theorems corresponding to the results in the report are indicated in the margin of the report. [Saturation_Framework_Extensions] title = Extensions to the Comprehensive Framework for Saturation Theorem Proving author = Jasmin Blanchette <https://www.cs.vu.nl/~jbe248/>, Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret> topic = Logic/General logic/Mechanization of proofs date = 2020-08-25 notify = jasmin.blanchette@gmail.com abstract = This Isabelle/HOL formalization extends the AFP entry Saturation_Framework with the following contributions: <ul> <li>an application of the framework to prove Bachmair and Ganzinger's resolution prover RP refutationally complete, which was formalized in a more ad hoc fashion by Schlichtkrull et al. in the AFP entry Ordered_Resultion_Prover;</li> <li>generalizations of various basic concepts formalized by Schlichtkrull et al., which were needed to verify RP and could be useful to formalize other calculi, such as superposition;</li> <li>alternative proofs of fairness (and hence saturation and ultimately refutational completeness) for the given clause procedures GC and LGC, based on invariance.</li> </ul> [MFODL_Monitor_Optimized] title = Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations author = Thibault Dardinier<>, Lukas Heimes<>, Martin Raszyk <mailto:martin.raszyk@inf.ethz.ch>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io> topic = Computer science/Algorithms, Logic/General logic/Modal logic, Computer science/Automata and formal languages date = 2020-04-09 notify = martin.raszyk@inf.ethz.ch, joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order dynamic logic (MFODL), which combines the features of metric first-order temporal logic (MFOTL) and metric dynamic logic. Thus, MFODL supports real-time constraints, first-order parameters, and regular expressions. Additionally, the monitor supports aggregation operations such as count and sum. This formalization, which is described in a <a href="http://people.inf.ethz.ch/trayteld/papers/ijcar20-verimonplus/verimonplus.pdf"> forthcoming paper at IJCAR 2020</a>, significantly extends <a href="https://www.isa-afp.org/entries/MFOTL_Monitor.html">previous work on a verified monitor</a> for MFOTL. Apart from the addition of regular expressions and aggregations, we implemented <a href="https://www.isa-afp.org/entries/Generic_Join.html">multi-way joins</a> and a specialized sliding window algorithm to further optimize the monitor. extra-history = Change history: [2021-10-19]: corrected a mistake in the calculation of median aggregations (reported by Nicolas Kaletsch, revision 02b14c9bf3da) [Sliding_Window_Algorithm] title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows author = Lukas Heimes<>, Dmitriy Traytel <https://traytel.bitbucket.io>, Joshua Schneider<> topic = Computer science/Algorithms date = 2020-04-10 notify = heimesl@student.ethz.ch, traytel@inf.ethz.ch, joshua.schneider@inf.ethz.ch abstract = Basin et al.'s <a href="https://doi.org/10.1016/j.ipl.2014.09.009">sliding window algorithm (SWA)</a> is an algorithm for combining the elements of subsequences of a sequence with an associative operator. It is greedy and minimizes the number of operator applications. We formalize the algorithm and verify its functional correctness. We extend the algorithm with additional operations and provide an alternative interface to the slide operation that does not require the entire input sequence. [Lucas_Theorem] title = Lucas's Theorem author = Chelsea Edmonds <mailto:cle47@cam.ac.uk> topic = Mathematics/Number theory date = 2020-04-07 notify = cle47@cam.ac.uk abstract = This work presents a formalisation of a generating function proof for Lucas's theorem. We first outline extensions to the existing Formal Power Series (FPS) library, including an equivalence relation for coefficients modulo n, an alternate binomial theorem statement, and a formalised proof of the Freshman's dream (mod p) lemma. The second part of the work presents the formal proof of Lucas's Theorem. Working backwards, the formalisation first proves a well known corollary of the theorem which is easier to formalise, and then applies induction to prove the original theorem statement. The proof of the corollary aims to provide a good example of a formalised generating function equivalence proof using the FPS library. The final theorem statement is intended to be integrated into the formalised proof of Hilbert's 10th Problem. [ADS_Functor] title = Authenticated Data Structures As Functors author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Ognjen Marić <mailto:ogi.afp@mynosefroze.com> topic = Computer science/Data structures date = 2020-04-16 notify = andreas.lochbihler@digitalasset.com, mail@andreas-lochbihler.de abstract = Authenticated data structures allow several systems to convince each other that they are referring to the same data structure, even if each of them knows only a part of the data structure. Using inclusion proofs, knowledgeable systems can selectively share their knowledge with other systems and the latter can verify the authenticity of what is being shared. In this article, we show how to modularly define authenticated data structures, their inclusion proofs, and operations thereon as datatypes in Isabelle/HOL, using a shallow embedding. Modularity allows us to construct complicated trees from reusable building blocks, which we call Merkle functors. Merkle functors include sums, products, and function spaces and are closed under composition and least fixpoints. As a practical application, we model the hierarchical transactions of <a href="https://www.canton.io">Canton</a>, a practical interoperability protocol for distributed ledgers, as authenticated data structures. This is a first step towards formalizing the Canton protocol and verifying its integrity and security guarantees. [Power_Sum_Polynomials] title = Power Sum Polynomials author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Algebra date = 2020-04-24 notify = manuel@pruvisto.org abstract = This article provides a formalisation of the symmetric multivariate polynomials known as power sum polynomials. These are of the form pn(X1,…, Xk) = X1n + … + Xkn. A formal proof of the Girard–Newton Theorem is also given. This theorem relates the power sum polynomials to the elementary symmetric polynomials sk in the form of a recurrence relation (-1)k k sk = ∑i∈[0,k) (-1)i si pk-i . As an application, this is then used to solve a generalised form of a puzzle given as an exercise in Dummit and Foote's Abstract Algebra: For k complex unknowns x1, …, xk, define pj := x1j + … + xkj. Then for each vector a ∈ ℂk, show that there is exactly one solution to the system p1 = a1, …, pk = ak up to permutation of the xi and determine the value of pi for i>k. [Formal_Puiseux_Series] title = Formal Puiseux Series author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Algebra date = 2021-02-17 notify = manuel@pruvisto.org abstract = Formal Puiseux series are generalisations of formal power series and formal Laurent series that also allow for fractional exponents. They have the following general form: \[\sum_{i=N}^\infty a_{i/d} X^{i/d}\] where N is an integer and d is a positive integer. This entry defines these series including their basic algebraic properties. Furthermore, it proves the Newton–Puiseux Theorem, namely that the Puiseux series over an algebraically closed field of characteristic 0 are also algebraically closed. [Gaussian_Integers] title = Gaussian Integers author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Number theory date = 2020-04-24 notify = manuel@pruvisto.org abstract = The Gaussian integers are the subring ℤ[i] of the complex numbers, i. e. the ring of all complex numbers with integral real and imaginary part. This article provides a definition of this ring as well as proofs of various basic properties, such as that they form a Euclidean ring and a full classification of their primes. An executable (albeit not very efficient) factorisation algorithm is also provided. Lastly, this Gaussian integer formalisation is used in two short applications: <ol> <li> The characterisation of all positive integers that can be written as sums of two squares</li> <li> Euclid's formula for primitive Pythagorean triples</li> </ol> While elementary proofs for both of these are already available in the AFP, the theory of Gaussian integers provides more concise proofs and a more high-level view. [Forcing] title = Formalization of Forcing in Isabelle/ZF author = Emmanuel Gunther <mailto:gunther@famaf.unc.edu.ar>, Miguel Pagano <https://cs.famaf.unc.edu.ar/~mpagano/>, Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en> topic = Logic/Set theory date = 2020-05-06 notify = gunther@famaf.unc.edu.ar, pagano@famaf.unc.edu.ar, sterraf@famaf.unc.edu.ar abstract = We formalize the theory of forcing in the set theory framework of Isabelle/ZF. Under the assumption of the existence of a countable transitive model of ZFC, we construct a proper generic extension and show that the latter also satisfies ZFC. [Delta_System_Lemma] title = Cofinality and the Delta System Lemma author = Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en.html> topic = Mathematics/Combinatorics, Logic/Set theory date = 2020-12-27 notify = sterraf@famaf.unc.edu.ar abstract = We formalize the basic results on cofinality of linearly ordered sets and ordinals and Šanin’s Lemma for uncountable families of finite sets. This last result is used to prove the countable chain condition for Cohen posets. We work in the set theory framework of Isabelle/ZF, using the Axiom of Choice as needed. [Recursion-Addition] title = Recursion Theorem in ZF author = Georgy Dunaev <mailto:georgedunaev@gmail.com> topic = Logic/Set theory date = 2020-05-11 notify = georgedunaev@gmail.com abstract = This document contains a proof of the recursion theorem. This is a mechanization of the proof of the recursion theorem from the text Introduction to Set Theory, by Karel Hrbacek and Thomas Jech. This implementation may be used as the basis for a model of Peano arithmetic in ZF. While recursion and the natural numbers are already available in Isabelle/ZF, this clean development is much easier to follow. [LTL_Normal_Form] title = An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation author = Salomon Sickert <mailto:s.sickert@tum.de> topic = Computer science/Automata and formal languages, Logic/General logic/Temporal logic date = 2020-05-08 notify = s.sickert@tum.de abstract = In the mid 80s, Lichtenstein, Pnueli, and Zuck proved a classical theorem stating that every formula of Past LTL (the extension of LTL with past operators) is equivalent to a formula of the form $\bigwedge_{i=1}^n \mathbf{G}\mathbf{F} \varphi_i \vee \mathbf{F}\mathbf{G} \psi_i$, where $\varphi_i$ and $\psi_i$ contain only past operators. Some years later, Chang, Manna, and Pnueli built on this result to derive a similar normal form for LTL. Both normalisation procedures have a non-elementary worst-case blow-up, and follow an involved path from formulas to counter-free automata to star-free regular expressions and back to formulas. We improve on both points. We present an executable formalisation of a direct and purely syntactic normalisation procedure for LTL yielding a normal form, comparable to the one by Chang, Manna, and Pnueli, that has only a single exponential blow-up. [Matrices_for_ODEs] title = Matrices for ODEs author = Jonathan Julian Huerta y Munive <mailto:jjhuertaymunive1@sheffield.ac.uk> topic = Mathematics/Analysis, Mathematics/Algebra date = 2020-04-19 notify = jonjulian23@gmail.com abstract = Our theories formalise various matrix properties that serve to establish existence, uniqueness and characterisation of the solution to affine systems of ordinary differential equations (ODEs). In particular, we formalise the operator and maximum norm of matrices. Then we use them to prove that square matrices form a Banach space, and in this setting, we show an instance of Picard-Lindelöf’s theorem for affine systems of ODEs. Finally, we use this formalisation to verify three simple hybrid programs. [Irrational_Series_Erdos_Straus] title = Irrationality Criteria for Series by Erdős and Straus author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Number theory, Mathematics/Analysis date = 2020-05-12 notify = ak2110@cam.ac.uk, wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = We formalise certain irrationality criteria for infinite series of the form: \[\sum_{n=1}^\infty \frac{b_n}{\prod_{i=1}^n a_i} \] where $\{b_n\}$ is a sequence of integers and $\{a_n\}$ a sequence of positive integers with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus <a href="https://projecteuclid.org/euclid.pjm/1102911140">[1]</a>. In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1. The latter is an application of Theorem 2.1 involving the prime numbers. [Knuth_Bendix_Order] title = A Formalization of Knuth–Bendix Orders author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/> topic = Logic/Rewriting date = 2020-05-13 notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at abstract = We define a generalized version of Knuth–Bendix orders, including subterm coefficient functions. For these orders we formalize several properties such as strong normalization, the subterm property, closure properties under substitutions and contexts, as well as ground totality. [Stateful_Protocol_Composition_and_Typing] title = Stateful Protocol Composition and Typing author = Andreas V. Hess <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/> topic = Computer science/Security date = 2020-04-08 notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk abstract = We provide in this AFP entry several relative soundness results for security protocols. In particular, we prove typing and compositionality results for stateful protocols (i.e., protocols with mutable state that may span several sessions), and that focuses on reachability properties. Such results are useful to simplify protocol verification by reducing it to a simpler problem: Typing results give conditions under which it is safe to verify a protocol in a typed model where only "well-typed" attacks can occur whereas compositionality results allow us to verify a composed protocol by only verifying the component protocols in isolation. The conditions on the protocols under which the results hold are furthermore syntactic in nature allowing for full automation. The foundation presented here is used in another entry to provide fully automated and formalized security proofs of stateful protocols. [Automated_Stateful_Protocol_Verification] title = Automated Stateful Protocol Verification author = Andreas V. Hess <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/> topic = Computer science/Security, Tools date = 2020-04-08 notify = avhe@dtu.dk, andreasvhess@gmail.com, samo@dtu.dk, brucker@spamfence.net, andschl@dtu.dk abstract = In protocol verification we observe a wide spectrum from fully automated methods to interactive theorem proving with proof assistants like Isabelle/HOL. In this AFP entry, we present a fully-automated approach for verifying stateful security protocols, i.e., protocols with mutable state that may span several sessions. The approach supports reachability goals like secrecy and authentication. We also include a simple user-friendly transaction-based protocol specification language that is embedded into Isabelle. [Smith_Normal_Form] title = A verified algorithm for computing the Smith normal form of a matrix author = Jose Divasón <https://www.unirioja.es/cu/jodivaso/> topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical date = 2020-05-23 notify = jose.divason@unirioja.es abstract = This work presents a formal proof in Isabelle/HOL of an algorithm to transform a matrix into its Smith normal form, a canonical matrix form, in a general setting: the algorithm is parameterized by operations to prove its existence over elementary divisor rings, while execution is guaranteed over Euclidean domains. We also provide a formal proof on some results about the generality of this algorithm as well as the uniqueness of the Smith normal form. Since Isabelle/HOL does not feature dependent types, the development is carried out switching conveniently between two different existing libraries: the Hermite normal form (based on HOL Analysis) and the Jordan normal form AFP entries. This permits to reuse results from both developments and it is done by means of the lifting and transfer package together with the use of local type definitions. [Nash_Williams] title = The Nash-Williams Partition Theorem author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Combinatorics date = 2020-05-16 notify = lp15@cam.ac.uk abstract = In 1965, Nash-Williams discovered a generalisation of the infinite form of Ramsey's theorem. Where the latter concerns infinite sets of n-element sets for some fixed n, the Nash-Williams theorem concerns infinite sets of finite sets (or lists) subject to a “no initial segment” condition. The present formalisation follows a monograph on Ramsey Spaces by Todorčević. [Safe_Distance] title = A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles author = Albert Rizaldi <mailto:albert.rizaldi@ntu.edu.sg>, Fabian Immler <http://home.in.tum.de/~immler/> topic = Computer science/Algorithms/Mathematical, Mathematics/Physics date = 2020-06-01 notify = albert.rizaldi@ntu.edu.sg, fimmler@andrew.cmu.edu, martin.rau@tum.de abstract = The Vienna Convention on Road Traffic defines the safe distance traffic rules informally. This could make autonomous vehicle liable for safe-distance-related accidents because there is no clear definition of how large a safe distance is. We provide a formally proven prescriptive definition of a safe distance, and checkers which can decide whether an autonomous vehicle is obeying the safe distance rule. Not only does our work apply to the domain of law, but it also serves as a specification for autonomous vehicle manufacturers and for online verification of path planners. [Relational_Paths] title = Relational Characterisations of Paths author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/> topic = Mathematics/Graph theory date = 2020-07-13 notify = walter.guttmann@canterbury.ac.nz, peter@hoefner-online.de abstract = Binary relations are one of the standard ways to encode, characterise and reason about graphs. Relation algebras provide equational axioms for a large fragment of the calculus of binary relations. Although relations are standard tools in many areas of mathematics and computing, researchers usually fall back to point-wise reasoning when it comes to arguments about paths in a graph. We present a purely algebraic way to specify different kinds of paths in Kleene relation algebras, which are relation algebras equipped with an operation for reflexive transitive closure. We study the relationship between paths with a designated root vertex and paths without such a vertex. Since we stay in first-order logic this development helps with mechanising proofs. To demonstrate the applicability of the algebraic framework we verify the correctness of three basic graph algorithms. [Amicable_Numbers] title = Amicable Numbers author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/> topic = Mathematics/Number theory date = 2020-08-04 notify = ak2110@cam.ac.uk abstract = This is a formalisation of Amicable Numbers, involving some relevant material including Euler's sigma function, some relevant definitions, results and examples as well as rules such as Thābit ibn Qurra's Rule, Euler's Rule, te Riele's Rule and Borho's Rule with breeders. [Ordinal_Partitions] title = Ordinal Partitions author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Combinatorics, Logic/Set theory date = 2020-08-03 notify = lp15@cam.ac.uk abstract = The theory of partition relations concerns generalisations of Ramsey's theorem. For any ordinal $\alpha$, write $\alpha \to (\alpha, m)^2$ if for each function $f$ from unordered pairs of elements of $\alpha$ into $\{0,1\}$, either there is a subset $X\subseteq \alpha$ order-isomorphic to $\alpha$ such that $f\{x,y\}=0$ for all $\{x,y\}\subseteq X$, or there is an $m$ element set $Y\subseteq \alpha$ such that $f\{x,y\}=1$ for all $\{x,y\}\subseteq Y$. (In both cases, with $\{x,y\}$ we require $x\not=y$.) In particular, the infinite Ramsey theorem can be written in this notation as $\omega \to (\omega, \omega)^2$, or if we restrict $m$ to the positive integers as above, then $\omega \to (\omega, m)^2$ for all $m$. This entry formalises Larson's proof of $\omega^\omega \to (\omega^\omega, m)^2$ along with a similar proof of a result due to Specker: $\omega^2 \to (\omega^2, m)^2$. Also proved is a necessary result by Erdős and Milner: $\omega^{1+\alpha\cdot n} \to (\omega^{1+\alpha}, 2^n)^2$. [Relational_Disjoint_Set_Forests] title = Relational Disjoint-Set Forests author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Computer science/Data structures date = 2020-08-26 notify = walter.guttmann@canterbury.ac.nz abstract = We give a simple relation-algebraic semantics of read and write operations on associative arrays. The array operations seamlessly integrate with assignments in the Hoare-logic library. Using relation algebras and Kleene algebras we verify the correctness of an array-based implementation of disjoint-set forests with a naive union operation and a find operation with path compression. extra-history = Change history: [2021-06-19]: added path halving, path splitting, relational Peano structures, union by rank (revision 98c7aa03457d) [PAC_Checker] title = Practical Algebraic Calculus Checker author = Mathias Fleury <http://fmv.jku.at/fleury>, Daniela Kaufmann <http://fmv.jku.at/kaufmann> topic = Computer science/Algorithms date = 2020-08-31 notify = mathias.fleury@jku.at abstract = Generating and checking proof certificates is important to increase the trust in automated reasoning tools. In recent years formal verification using computer algebra became more important and is heavily used in automated circuit verification. An existing proof format which covers algebraic reasoning and allows efficient proof checking is the practical algebraic calculus (PAC). In this development, we present the verified checker Pastèque that is obtained by synthesis via the Refinement Framework. This is the formalization going with our FMCAD'20 tool presentation. [BirdKMP] title = Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching author = Peter Gammie <http://peteg.org> topic = Computer science/Functional programming date = 2020-08-25 notify = peteg42@gmail.com abstract = Richard Bird and collaborators have proposed a derivation of an intricate cyclic program that implements the Morris-Pratt string matching algorithm. Here we provide a proof of total correctness for Bird's derivation and complete it by adding Knuth's optimisation. [Extended_Finite_State_Machines] title = A Formal Model of Extended Finite State Machines -author = Michael Foster <mailto:jmafoster1@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk> +author = Michael Foster <mailto:m.foster@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk> topic = Computer science/Automata and formal languages date = 2020-09-07 -notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org +notify = m.foster@sheffield.ac.uk, adbrucker@0x5f.org abstract = In this AFP entry, we provide a formalisation of extended finite state machines (EFSMs) where models are represented as finite sets of transitions between states. EFSMs execute traces to produce observable outputs. We also define various simulation and equality metrics for EFSMs in terms of traces and prove their strengths in relation to each other. Another key contribution is a framework of function definitions such that LTL properties can be phrased over EFSMs. Finally, we provide a simple example case study in the form of a drinks machine. [Extended_Finite_State_Machine_Inference] title = Inference of Extended Finite State Machines -author = Michael Foster <mailto:jmafoster1@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk> +author = Michael Foster <mailto:m.foster@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk> topic = Computer science/Automata and formal languages date = 2020-09-07 -notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org +notify = m.foster@sheffield.ac.uk, adbrucker@0x5f.org abstract = In this AFP entry, we provide a formal implementation of a state-merging technique to infer extended finite state machines (EFSMs), complete with output and update functions, from black-box traces. In particular, we define the subsumption in context relation as a means of determining whether one transition is able to account for the behaviour of another. Building on this, we define the direct subsumption relation, which lifts the subsumption in context relation to EFSM level such that we can use it to determine whether it is safe to merge a given pair of transitions. Key proofs include the conditions necessary for subsumption to occur and that subsumption and direct subsumption are preorder relations. We also provide a number of different heuristics which can be used to abstract away concrete values into registers so that more states and transitions can be merged and provide proofs of the various conditions which must hold for these abstractions to subsume their ungeneralised counterparts. A Code Generator setup to create executable Scala code is also defined. [Physical_Quantities] title = A Sound Type System for Physical Quantities, Units, and Measurements author = Simon Foster <https://www-users.cs.york.ac.uk/~simonf/>, Burkhart Wolff <https://www.lri.fr/~wolff/> topic = Mathematics/Physics, Computer science/Programming languages/Type systems date = 2020-10-20 notify = simon.foster@york.ac.uk, wolff@lri.fr abstract = The present Isabelle theory builds a formal model for both the International System of Quantities (ISQ) and the International System of Units (SI), which are both fundamental for physics and engineering. Both the ISQ and the SI are deeply integrated into Isabelle's type system. Quantities are parameterised by dimension types, which correspond to base vectors, and thus only quantities of the same dimension can be equated. Since the underlying "algebra of quantities" induces congruences on quantity and SI types, specific tactic support is developed to capture these. Our construction is validated by a test-set of known equivalences between both quantities and SI units. Moreover, the presented theory can be used for type-safe conversions between the SI system and others, like the British Imperial System (BIS). [Shadow_DOM] title = A Formal Model of the Document Object Model with Shadow Roots author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we extend our formalization of the core DOM with Shadow Roots. Shadow roots are a recent proposal of the web community to support a component-based development approach for client-side web applications. Shadow roots are a significant extension to the DOM standard and, as web standards are condemned to be backward compatible, such extensions often result in complex specification that may contain unwanted subtleties that can be detected by a formalization. Our Isabelle/HOL formalization is, in the sense of object-orientation, an extension of our formalization of the core DOM and enjoys the same basic properties, i.e., it is extensible, i.e., can be extended without the need of re-proving already proven properties and executable, i.e., we can generate executable code from our specification. We exploit the executability to show that our formalization complies to the official standard of the W3C, respectively, the WHATWG. [DOM_Components] title = A Formalization of Web Components author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg> topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = While the DOM with shadow trees provide the technical basis for defining web components, the DOM standard neither defines the concept of web components nor specifies the safety properties that web components should guarantee. Consequently, the standard also does not discuss how or even if the methods for modifying the DOM respect component boundaries. In AFP entry, we present a formally verified model of web components and define safety properties which ensure that different web components can only interact with each other using well-defined interfaces. Moreover, our verification of the application programming interface (API) of the DOM revealed numerous invariants that implementations of the DOM API need to preserve to ensure the integrity of components. [Interpreter_Optimizations] title = Inline Caching and Unboxing Optimization for Interpreters author = Martin Desharnais <https://martin.desharnais.me> topic = Computer science/Programming languages/Misc date = 2020-12-07 notify = martin.desharnais@unibw.de abstract = This Isabelle/HOL formalization builds on the VeriComp entry of the Archive of Formal Proofs to provide the following contributions: <ul> <li>an operational semantics for a realistic virtual machine (Std) for dynamically typed programming languages;</li> <li>the formalization of an inline caching optimization (Inca), a proof of bisimulation with (Std), and a compilation function;</li> <li>the formalization of an unboxing optimization (Ubx), a proof of bisimulation with (Inca), and a simple compilation function.</li> </ul> This formalization was described in the CPP 2021 paper Towards Efficient and Verified Virtual Machines for Dynamic Languages extra-history = Change history: [2021-06-14]: refactored function definitions to contain explicit basic blocks [2021-06-25]: proved conditional completeness of compilation [Isabelle_Marries_Dirac] title = Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Hanna Lachnitt<mailto:lachnitt@stanford.edu>, Yijun He<mailto:yh403@cam.ac.uk> topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information date = 2020-11-22 notify = apdb3@cam.ac.uk, lachnitt@stanford.edu abstract = This work is an effort to formalise some quantum algorithms and results in quantum information theory. Formal methods being critical for the safety and security of algorithms and protocols, we foresee their widespread use for quantum computing in the future. We have developed a large library for quantum computing in Isabelle based on a matrix representation for quantum circuits, successfully formalising the no-cloning theorem, quantum teleportation, Deutsch's algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's Dilemma. [Projective_Measurements] title = Quantum projective measurements and the CHSH inequality author = Mnacho Echenim <https://lig-membres.imag.fr/mechenim/> topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information date = 2021-03-03 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = This work contains a formalization of quantum projective measurements, also known as von Neumann measurements, which are based on elements of spectral theory. We also formalized the CHSH inequality, an inequality involving expectations in a probability space that is violated by quantum measurements, thus proving that quantum mechanics cannot be modeled with an underlying local hidden-variable theory. [Finite-Map-Extras] title = Finite Map Extras author = Javier Díaz <mailto:javier.diaz.manzi@gmail.com> topic = Computer science/Data structures date = 2020-10-12 notify = javier.diaz.manzi@gmail.com abstract = This entry includes useful syntactic sugar, new operators and functions, and their associated lemmas for finite maps which currently are not present in the standard Finite_Map theory. [Relational_Minimum_Spanning_Trees] title = Relational Minimum Spanning Tree Algorithms author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Nicolas Robinson-O'Brien<> topic = Computer science/Algorithms/Graph date = 2020-12-08 notify = walter.guttmann@canterbury.ac.nz abstract = We verify the correctness of Prim's, Kruskal's and Borůvka's minimum spanning tree algorithms based on algebras for aggregation and minimisation. [Topological_Semantics] title = Topological semantics for paraconsistent and paracomplete logics author = David Fuenmayor <mailto:davfuenmayor@gmail.com> topic = Logic/General logic date = 2020-12-17 notify = davfuenmayor@gmail.com abstract = We introduce a generalized topological semantics for paraconsistent and paracomplete logics by drawing upon early works on topological Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey & Tarski, etc.). In particular, this work exemplarily illustrates the shallow semantical embeddings approach (<a href="http://dx.doi.org/10.1007/s11787-012-0052-y">SSE</a>) employing the proof assistant Isabelle/HOL. By means of the SSE technique we can effectively harness theorem provers, model finders and 'hammers' for reasoning with quantified non-classical logics. [CSP_RefTK] title = The HOL-CSP Refinement Toolkit author = Safouan Taha <mailto:safouan.taha@lri.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/>, Lina Ye <mailto:lina.ye@lri.fr> topic = Computer science/Concurrency/Process calculi, Computer science/Semantics date = 2020-11-19 notify = wolff@lri.fr abstract = We use a formal development for CSP, called HOL-CSP2.0, to analyse a family of refinement notions, comprising classic and new ones. This analysis enables to derive a number of properties that allow to deepen the understanding of these notions, in particular with respect to specification decomposition principles for the case of infinite sets of events. The established relations between the refinement relations help to clarify some obscure points in the CSP literature, but also provide a weapon for shorter refinement proofs. Furthermore, we provide a framework for state-normalisation allowing to formally reason on parameterised process architectures. As a result, we have a modern environment for formal proofs of concurrent systems that allow for the combination of general infinite processes with locally finite ones in a logically safe way. We demonstrate these verification-techniques for classical, generalised examples: The CopyBuffer for arbitrary data and the Dijkstra's Dining Philosopher Problem of arbitrary size. [Hood_Melville_Queue] title = Hood-Melville Queue author = Alejandro Gómez-Londoño<mailto:alejandro.gomez@chalmers.se> topic = Computer science/Data structures date = 2021-01-18 notify = nipkow@in.tum.de abstract = This is a verified implementation of a constant time queue. The original design is due to <a href="https://doi.org/10.1016/0020-0190(81)90030-2">Hood and Melville</a>. This formalization follows the presentation in Purely Functional Data Structuresby Okasaki. [JinjaDCI] title = JinjaDCI: a Java semantics with dynamic class initialization author = Susannah Mansky <mailto:sjohnsn2@illinois.edu> topic = Computer science/Programming languages/Language definitions date = 2021-01-11 notify = sjohnsn2@illinois.edu, susannahej@gmail.com abstract = We extend Jinja to include static fields, methods, and instructions, and dynamic class initialization, based on the Java SE 8 specification. This includes extension of definitions and proofs. This work is partially described in Mansky and Gunter's paper at CPP 2019 and Mansky's doctoral thesis (UIUC, 2020). [Blue_Eyes] title = Solution to the xkcd Blue Eyes puzzle author = Jakub Kądziołka <mailto:kuba@kadziolka.net> topic = Logic/General logic/Logics of knowledge and belief date = 2021-01-30 notify = kuba@kadziolka.net abstract = In a <a href="https://xkcd.com/blue_eyes.html">puzzle published by Randall Munroe</a>, perfect logicians forbidden from communicating are stranded on an island, and may only leave once they have figured out their own eye color. We present a method of modeling the behavior of perfect logicians and formalize a solution of the puzzle. [Laws_of_Large_Numbers] title = The Laws of Large Numbers author = Manuel Eberl <https://pruvisto.org> topic = Mathematics/Probability theory date = 2021-02-10 notify = manuel@pruvisto.org abstract = The Law of Large Numbers states that, informally, if one performs a random experiment $X$ many times and takes the average of the results, that average will be very close to the expected value $E[X]$. More formally, let $(X_i)_{i\in\mathbb{N}}$ be a sequence of independently identically distributed random variables whose expected value $E[X_1]$ exists. Denote the running average of $X_1, \ldots, X_n$ as $\overline{X}_n$. Then: <ul> <li>The Weak Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability for $n\to\infty$, i.e. $\mathcal{P}(|\overline{X}_{n} - E[X_1]| > \varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon > 0$.</li> <li>The Strong Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for $n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow E[X_1]) = 1$.</li> </ul> In this entry, I formally prove the strong law and from it the weak law. The approach used for the proof of the strong law is a particularly quick and slick one based on ergodic theory, which was formalised by Gouëzel in another AFP entry. [BTree] title = A Verified Imperative Implementation of B-Trees author = Niels Mündler <mailto:n.muendler@tum.de> topic = Computer science/Data structures date = 2021-02-24 notify = n.muendler@tum.de abstract = In this work, we use the interactive theorem prover Isabelle/HOL to verify an imperative implementation of the classical B-tree data structure invented by Bayer and McCreight [ACM 1970]. The implementation supports set membership, insertion and deletion queries with efficient binary search for intra-node navigation. This is accomplished by first specifying the structure abstractly in the functional modeling language HOL and proving functional correctness. Using manual refinement, we derive an imperative implementation in Imperative/HOL. We show the validity of this refinement using the separation logic utilities from the <a href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html"> Isabelle Refinement Framework </a> . The code can be exported to the programming languages SML, OCaml and Scala. We examine the runtime of all operations indirectly by reproducing results of the logarithmic relationship between height and the number of nodes. The results are discussed in greater detail in the corresponding <a href="https://mediatum.ub.tum.de/1596550">Bachelor's Thesis</a>. extra-history = Change history: [2021-05-02]: Add implementation and proof of correctness of imperative deletion operations. Further add the option to export code to OCaml. [Sunflowers] title = The Sunflower Lemma of Erdős and Rado author = René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Mathematics/Combinatorics date = 2021-02-25 notify = rene.thiemann@uibk.ac.at abstract = We formally define sunflowers and provide a formalization of the sunflower lemma of Erdős and Rado: whenever a set of size-k-sets has a larger cardinality than (r - 1)k · k!, then it contains a sunflower of cardinality r. [Mereology] title = Mereology author = Ben Blumson <https://philpeople.org/profiles/ben-blumson> topic = Logic/Philosophical aspects date = 2021-03-01 notify = benblumson@gmail.com abstract = We use Isabelle/HOL to verify elementary theorems and alternative axiomatizations of classical extensional mereology. [Modular_arithmetic_LLL_and_HNF_algorithms] title = Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation author = Ralph Bottesch <>, Jose Divasón <https://www.unirioja.es/cu/jodivaso/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Computer science/Algorithms/Mathematical date = 2021-03-12 notify = rene.thiemann@uibk.ac.at abstract = We verify two algorithms for which modular arithmetic plays an essential role: Storjohann's variant of the LLL lattice basis reduction algorithm and Kopparty's algorithm for computing the Hermite normal form of a matrix. To do this, we also formalize some facts about the modulo operation with symmetric range. Our implementations are based on the original papers, but are otherwise efficient. For basis reduction we formalize two versions: one that includes all of the optimizations/heuristics from Storjohann's paper, and one excluding a heuristic that we observed to often decrease efficiency. We also provide a fast, self-contained certifier for basis reduction, based on the efficient Hermite normal form algorithm. [Constructive_Cryptography_CM] title = Constructive Cryptography in HOL: the Communication Modeling Aspect author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <> topic = Computer science/Security/Cryptography, Mathematics/Probability theory date = 2021-03-17 notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch abstract = Constructive Cryptography (CC) [<a href="https://conference.iiis.tsinghua.edu.cn/ICS2011/content/papers/14.html">ICS 2011</a>, <a href="https://doi.org/10.1007/978-3-642-27375-9_3">TOSCA 2011</a>, <a href="https://doi.org/10.1007/978-3-662-53641-4_1">TCC 2016</a>] introduces an abstract approach to composable security statements that allows one to focus on a particular aspect of security proofs at a time. Instead of proving the properties of concrete systems, CC studies system classes, i.e., the shared behavior of similar systems, and their transformations. Modeling of systems communication plays a crucial role in composability and reusability of security statements; yet, this aspect has not been studied in any of the existing CC results. We extend our previous CC formalization [<a href="https://isa-afp.org/entries/Constructive_Cryptography.html">Constructive_Cryptography</a>, <a href="https://doi.org/10.1109/CSF.2019.00018">CSF 2019</a>] with a new semantic domain called Fused Resource Templates (FRT) that abstracts over the systems communication patterns in CC proofs. This widens the scope of cryptography proof formalizations in the CryptHOL library [<a href="https://isa-afp.org/entries/CryptHOL.html">CryptHOL</a>, <a href="https://doi.org/10.1007/978-3-662-49498-1_20">ESOP 2016</a>, <a href="https://doi.org/10.1007/s00145-019-09341-z">J Cryptol 2020</a>]. This formalization is described in <a href="http://www.andreas-lochbihler.de/pub/basin2021.pdf">Abstract Modeling of Systems Communication in Constructive Cryptography using CryptHOL</a>. [IFC_Tracking] title = Information Flow Control via Dependency Tracking author = Benedikt Nordhoff <mailto:b.n@wwu.de> topic = Computer science/Security date = 2021-04-01 notify = b.n@wwu.de abstract = We provide a characterisation of how information is propagated by program executions based on the tracking data and control dependencies within executions themselves. The characterisation might be used for deriving approximative safety properties to be targeted by static analyses or checked at runtime. We utilise a simple yet versatile control flow graph model as a program representation. As our model is not assumed to be finite it can be instantiated for a broad class of programs. The targeted security property is indistinguishable security where executions produce sequences of observations and only non-terminating executions are allowed to drop a tail of those. A very crude approximation of our characterisation is slicing based on program dependence graphs, which we use as a minimal example and derive a corresponding soundness result. For further details and applications refer to the authors upcoming dissertation. [Grothendieck_Schemes] title = Grothendieck's Schemes in Algebraic Geometry author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Lawrence Paulson <https://www.cl.cam.ac.uk/~lp15/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Algebra, Mathematics/Geometry date = 2021-03-29 notify = apdb3@cam.ac.uk, lp15@cam.ac.uk abstract = We formalize mainstream structures in algebraic geometry culminating in Grothendieck's schemes: presheaves of rings, sheaves of rings, ringed spaces, locally ringed spaces, affine schemes and schemes. We prove that the spectrum of a ring is a locally ringed space, hence an affine scheme. Finally, we prove that any affine scheme is a scheme. [Progress_Tracking] title = Formalization of Timely Dataflow's Progress Tracking Protocol author = Matthias Brun<>, Sára Decova<>, Andrea Lattuada<https://andrea.lattuada.me>, Dmitriy Traytel <https://traytel.bitbucket.io/> topic = Computer science/Algorithms/Distributed date = 2021-04-13 notify = matthias.brun@inf.ethz.ch, traytel@di.ku.dk abstract = Large-scale stream processing systems often follow the dataflow paradigm, which enforces a program structure that exposes a high degree of parallelism. The Timely Dataflow distributed system supports expressive cyclic dataflows for which it offers low-latency data- and pipeline-parallel stream processing. To achieve high expressiveness and performance, Timely Dataflow uses an intricate distributed protocol for tracking the computation’s progress. We formalize this progress tracking protocol and verify its safety. Our formalization is described in detail in our forthcoming <a href="https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf">ITP'21 paper</a>. [GaleStewart_Games] title = Gale-Stewart Games author = Sebastiaan Joosten <https://sjcjoosten.nl> topic = Mathematics/Games and economics date = 2021-04-23 notify = sjcjoosten@gmail.com abstract = This is a formalisation of the main result of Gale and Stewart from 1953, showing that closed finite games are determined. This property is now known as the Gale Stewart Theorem. While the original paper shows some additional theorems as well, we only formalize this main result, but do so in a somewhat general way. We formalize games of a fixed arbitrary length, including infinite length, using co-inductive lists, and show that defensive strategies exist unless the other player is winning. For closed games, defensive strategies are winning for the closed player, proving that such games are determined. For finite games, which are a special case in our formalisation, all games are closed. [Metalogic_ProofChecker] title = Isabelle's Metalogic: Formalization and Proof Checker author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Simon Roßkopf <http://www21.in.tum.de/~rosskops> topic = Logic/General logic date = 2021-04-27 notify = rosskops@in.tum.de abstract = In this entry we formalize Isabelle's metalogic in Isabelle/HOL. Furthermore, we define a language of proof terms and an executable proof checker and prove its soundness wrt. the metalogic. The formalization is intentionally kept close to the Isabelle implementation(for example using de Brujin indices) to enable easy integration of generated code with the Isabelle system without a complicated translation layer. The formalization is described in our <a href="https://arxiv.org/pdf/2104.12224.pdf">CADE 28 paper</a>. [Regression_Test_Selection] title = Regression Test Selection author = Susannah Mansky <mailto:sjohnsn2@illinois.edu> topic = Computer science/Algorithms date = 2021-04-30 notify = sjohnsn2@illinois.edu, susannahej@gmail.com abstract = This development provides a general definition for safe Regression Test Selection (RTS) algorithms. RTS algorithms select which tests to rerun on revised code, reducing the time required to check for newly introduced errors. An RTS algorithm is considered safe if and only if all deselected tests would have unchanged results. This definition is instantiated with two class-collection-based RTS algorithms run over the JVM as modeled by JinjaDCI. This is achieved with a general definition for Collection Semantics, small-step semantics instrumented to collect information during execution. As the RTS definition mandates safety, these instantiations include proofs of safety. This work is described in Mansky and Gunter's LSFA 2020 paper and Mansky's doctoral thesis (UIUC, 2020). [Padic_Ints] title = Hensel's Lemma for the p-adic Integers author = Aaron Crighton <mailto:crightoa@mcmaster.ca> topic = Mathematics/Number theory date = 2021-03-23 notify = crightoa@mcmaster.ca abstract = We formalize the ring of p-adic integers within the framework of the HOL-Algebra library. The carrier of the ring is formalized as the inverse limit of quotients of the integers by powers of a fixed prime p. We define an integer-valued valuation, as well as an extended-integer valued valuation which sends 0 to the infinite element. Basic topological facts about the p-adic integers are formalized, including completeness and sequential compactness. Taylor expansions of polynomials over a commutative ring are defined, culminating in the formalization of Hensel's Lemma based on a proof due to Keith Conrad. [Combinatorics_Words] title = Combinatorics on Words Basics author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Martin Raška<>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/> topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = We formalize basics of Combinatorics on Words. This is an extension of existing theories on lists. We provide additional properties related to prefix, suffix, factor, length and rotation. The topics include prefix and suffix comparability, mismatch, word power, total and reversed morphisms, border, periods, primitivity and roots. We also formalize basic, mostly folklore results related to word equations: equidivisibility, commutation and conjugation. Slightly advanced properties include the Periodicity lemma (often cited as the Fine and Wilf theorem) and the variant of the Lyndon-Schützenberger theorem for words. We support the algebraic point of view which sees words as generators of submonoids of a free monoid. This leads to the concepts of the (free) hull, the (free) basis (or code). [Combinatorics_Words_Lyndon] title = Lyndon words author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/> topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = Lyndon words are words lexicographically minimal in their conjugacy class. We formalize their basic properties and characterizations, in particular the concepts of the longest Lyndon suffix and the Lyndon factorization. Most of the work assumes a fixed lexicographical order. Nevertheless we also define the smallest relation guaranteeing lexicographical minimality of a given word (in its conjugacy class). [Combinatorics_Words_Graph_Lemma] title = Graph Lemma author = Štěpán Holub <https://www2.karlin.mff.cuni.cz/~holub/>, Štěpán Starosta <https://users.fit.cvut.cz/~staroste/> topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = Graph lemma quantifies the defect effect of a system of word equations. That is, it provides an upper bound on the rank of the system. We formalize the proof based on the decomposition of a solution into its free basis. A direct application is an alternative proof of the fact that two noncommuting words form a code. [Lifting_the_Exponent] title = Lifting the Exponent author = Jakub Kądziołka <mailto:kuba@kadziolka.net> topic = Mathematics/Number theory date = 2021-04-27 notify = kuba@kadziolka.net abstract = We formalize the Lifting the Exponent Lemma, which shows how to find the largest power of $p$ dividing $a^n \pm b^n$, for a prime $p$ and positive integers $a$ and $b$. The proof follows <a href="https://s3.amazonaws.com/aops-cdn.artofproblemsolving.com/resources/articles/lifting-the-exponent.pdf">Amir Hossein Parvardi's</a>. [IMP_Compiler] title = A Shorter Compiler Correctness Proof for Language IMP author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> topic = Computer science/Programming languages/Compiling date = 2021-06-04 notify = pasquale.noce.lavoro@gmail.com abstract = This paper presents a compiler correctness proof for the didactic imperative programming language IMP, introduced in Nipkow and Klein's book on formal programming language semantics (version of March 2021), whose size is just two thirds of the book's proof in the number of formal text lines. As such, it promises to constitute a further enhanced reference for the formal verification of compilers meant for larger, real-world programming languages. The presented proof does not depend on language determinism, so that the proposed approach can be applied to non-deterministic languages as well. As a confirmation, this paper extends IMP with an additional non-deterministic choice command, and proves compiler correctness, viz. the simulation of compiled code execution by source code, for such extended language. [Public_Announcement_Logic] title = Public Announcement Logic author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> topic = Logic/General logic/Logics of knowledge and belief date = 2021-06-17 notify = ahfrom@dtu.dk abstract = This work is a formalization of public announcement logic with countably many agents. It includes proofs of soundness and completeness for a variant of the axiom system PA + DIST! + NEC!. The completeness proof builds on the Epistemic Logic theory. Paper: <a href="https://doi.org/10.1007/978-3-030-90138-7_2">https://doi.org/10.1007/978-3-030-90138-7_2</a>. [MiniSail] title = MiniSail - A kernel language for the ISA specification language SAIL author = Mark Wassell <mailto:mpwassell@gmail.com> topic = Computer science/Programming languages/Type systems date = 2021-06-18 notify = mpwassell@gmail.com abstract = MiniSail is a kernel language for Sail, an instruction set architecture (ISA) specification language. Sail is an imperative language with a light-weight dependent type system similar to refinement type systems. From an ISA specification, the Sail compiler can generate theorem prover code and C (or OCaml) to give an executable emulator for an architecture. The idea behind MiniSail is to capture the key and novel features of Sail in terms of their syntax, typing rules and operational semantics, and to confirm that they work together by proving progress and preservation lemmas. We use the Nominal2 library to handle binding. [SpecCheck] title = SpecCheck - Specification-Based Testing for Isabelle/ML author = Kevin Kappelmann <https://www21.in.tum.de/team/kappelmk/>, Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>, Sebastian Willenbrink <mailto:sebastian.willenbrink@tum.de> topic = Tools date = 2021-07-01 notify = kevin.kappelmann@tum.de abstract = SpecCheck is a <a href="https://en.wikipedia.org/wiki/QuickCheck">QuickCheck</a>-like testing framework for Isabelle/ML. You can use it to write specifications for ML functions. SpecCheck then checks whether your specification holds by testing your function against a given number of generated inputs. It helps you to identify bugs by printing counterexamples on failure and provides you timing information. SpecCheck is customisable and allows you to specify your own input generators, test output formats, as well as pretty printers and shrinking functions for counterexamples among other things. [Relational_Forests] title = Relational Forests author = Walter Guttmann <https://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Mathematics/Graph theory date = 2021-08-03 notify = walter.guttmann@canterbury.ac.nz abstract = We study second-order formalisations of graph properties expressed as first-order formulas in relation algebras extended with a Kleene star. The formulas quantify over relations while still avoiding quantification over elements of the base set. We formalise the property of undirected graphs being acyclic this way. This involves a study of various kinds of orientation of graphs. We also verify basic algorithms to constructively prove several second-order properties. [Fresh_Identifiers] title = Fresh identifiers author = Andrei Popescu <https://www.andreipopescu.uk>, Thomas Bauereiss <mailto:thomas@bauereiss.name> topic = Computer science/Data structures date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry defines a type class with an operator returning a fresh identifier, given a set of already used identifiers and a preferred identifier. The entry provides a default instantiation for any infinite type, as well as executable instantiations for natural numbers and strings. [CoCon] title = CoCon: A Confidentiality-Verified Conference Management System author = Andrei Popescu <https://www.andreipopescu.uk>, Peter Lammich <mailto:lammich@in.tum.de>, Thomas Bauereiss <mailto:thomas@bauereiss.name> topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoCon conference management system [<a href="https://doi.org/10.1007/978-3-319-08867-9_11">1</a>, <a href="https://doi.org/10.1007/s10817-020-09566-9">2</a>]. The confidentiality properties refer to the documents managed by the system, namely papers, reviews, discussion logs and acceptance/rejection decisions, and also to the assignment of reviewers to papers. They have all been formulated as instances of BD Security [<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">3</a>, <a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">4</a>] and verified using the BD Security unwinding technique. [BD_Security_Compositional] title = Compositional BD Security author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk> topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = Building on a previous <a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">AFP entry</a> that formalizes the Bounded-Deducibility Security (BD Security) framework <a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">[1]</a>, we formalize compositionality and transport theorems for information flow security. These results allow lifting BD Security properties from individual components specified as transition systems, to a composition of systems specified as communicating products of transition systems. The underlying ideas of these results are presented in the papers <a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">[1]</a> and <a href="https://doi.org/10.1109/SP.2017.24">[2]</a>. The latter paper also describes a major case study where these results have been used: on verifying the CoSMeDis distributed social media platform (itself formalized as an <a href="https://www.isa-afp.org/entries/CoSMeDis.html">AFP entry</a> that builds on this entry). [CoSMed] title = CoSMed: A confidentiality-verified social media platform author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk> topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoSMed social media platform. The confidentiality properties are formalized as instances of BD Security [<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">1</a>, <a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">2</a>]. An innovation in the deployment of BD Security compared to previous work is the use of dynamic declassification triggers, incorporated as part of inductive bounds, for providing stronger guarantees that account for the repeated opening and closing of access windows. To further strengthen the confidentiality guarantees, we also prove "traceback" properties about the accessibility decisions affecting the information managed by the system. [CoSMeDis] title = CoSMeDis: A confidentiality-verified distributed social media platform author = Thomas Bauereiss <mailto:thomas@bauereiss.name>, Andrei Popescu <https://www.andreipopescu.uk> topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoSMeDis distributed social media platform presented in [<a href="https://doi.org/10.1109/SP.2017.24">1</a>]. CoSMeDis is a multi-node extension the CoSMed prototype social media platform [<a href="https://doi.org/10.1007/978-3-319-43144-4_6">2</a>, <a href="https://doi.org/10.1007/s10817-017-9443-3">3</a>, <a href="https://www.isa-afp.org/entries/CoSMed.html">4</a>]. The confidentiality properties are formalized as instances of BD Security [<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">5</a>, <a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">6</a>]. The lifting of confidentiality properties from single nodes to the entire CoSMeDis network is performed using compositionality and transport theorems for BD Security, which are described in [<a href="https://doi.org/10.1109/SP.2017.24">1</a>] and formalized in a separate <a href="https://www.isa-afp.org/entries/BD_Security_Compositional.html">AFP entry</a>. [Three_Circles] title = The Theorem of Three Circles author = Fox Thomson <mailto:foxthomson0@gmail.com>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/> topic = Mathematics/Analysis date = 2021-08-21 notify = foxthomson0@gmail.com, wl302@cam.ac.uk abstract = The Descartes test based on Bernstein coefficients and Descartes’ rule of signs effectively (over-)approximates the number of real roots of a univariate polynomial over an interval. In this entry we formalise the theorem of three circles, which gives sufficient conditions for when the Descartes test returns 0 or 1. This is the first step for efficient root isolation. [Design_Theory] title = Combinatorial Design Theory author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Lawrence Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Combinatorics date = 2021-08-13 notify = cle47@cam.ac.uk abstract = Combinatorial design theory studies incidence set systems with certain balance and symmetry properties. It is closely related to hypergraph theory. This formalisation presents a general library for formal reasoning on incidence set systems, designs and their applications, including formal definitions and proofs for many key properties, operations, and theorems on the construction and existence of designs. Notably, this includes formalising t-designs, balanced incomplete block designs (BIBD), group divisible designs (GDD), pairwise balanced designs (PBD), design isomorphisms, and the relationship between graphs and designs. A locale-centric approach has been used to manage the relationships between the many different types of designs. Theorems of particular interest include the necessary conditions for existence of a BIBD, Wilson's construction on GDDs, and Bose's inequality on resolvable designs. Parts of this formalisation are explored in the paper "A Modular First Formalisation of Combinatorial Design Theory", presented at CICM 2021. [Logging_Independent_Anonymity] title = Logging-independent Message Anonymity in the Relational Method author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com> topic = Computer science/Security date = 2021-08-26 notify = pasquale.noce.lavoro@gmail.com abstract = In the context of formal cryptographic protocol verification, logging-independent message anonymity is the property for a given message to remain anonymous despite the attacker's capability of mapping messages of that sort to agents based on some intrinsic feature of such messages, rather than by logging the messages exchanged by legitimate agents as with logging-dependent message anonymity. This paper illustrates how logging-independent message anonymity can be formalized according to the relational method for formal protocol verification by considering a real-world protocol, namely the Restricted Identification one by the BSI. This sample model is used to verify that the pseudonymous identifiers output by user identification tokens remain anonymous under the expected conditions. [Dominance_CHK] title = A data flow analysis algorithm for computing dominators author = Nan Jiang<> topic = Computer science/Programming languages/Static analysis date = 2021-09-05 notify = nanjiang@whu.edu.cn abstract = This entry formalises the fast iterative algorithm for computing dominators due to Cooper, Harvey and Kennedy. It gives a specification of computing dominators on a control flow graph where each node refers to its reverse post order number. A semilattice of reversed-ordered list which represents dominators is built and a Kildall-style algorithm on the semilattice is defined for computing dominators. Finally the soundness and completeness of the algorithm are proved w.r.t. the specification. [Conditional_Simplification] title = Conditional Simplification author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides a collection of experimental general-purpose proof methods for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The methods in the collection offer functionality that is similar to certain aspects of the functionality provided by the standard proof methods of Isabelle that combine classical reasoning and rewriting, such as the method auto, but use a different approach for rewriting. More specifically, these methods allow for the side conditions of the rewrite rules to be solved via intro-resolution. [Intro_Dest_Elim] title = IDE: Introduction, Destruction, Elimination author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides the command mk_ide for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The command mk_ide enables the automated synthesis of the introduction, destruction and elimination rules from arbitrary definitions of constant predicates stated in Isabelle/HOL. [CZH_Foundations] title = Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Mathematics/Category theory, Logic/Set theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a foundational framework for the formalization of category theory in the object logic ZFC in HOL of the formal proof assistant Isabelle. More specifically, this article provides a formalization of canonical set-theoretic constructions internalized in the type V associated with the ZFC in HOL, establishes a design pattern for the formalization of mathematical structures using sequences and locales, and showcases the developed infrastructure by providing formalizations of the elementary theories of digraphs and semicategories. The methodology chosen for the formalization of the theories of digraphs and semicategories (and categories in future articles) rests on the ideas that were originally expressed in the article Set-Theoretical Foundations of Category Theory written by Solomon Feferman and Georg Kreisel. Thus, in the context of this work, each of the aforementioned mathematical structures is represented as a term of the type V embedded into a stage of the von Neumann hierarchy. [CZH_Elementary_Categories] title = Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Mathematics/Category theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a formalization of the foundations of the theory of 1-categories in the object logic ZFC in HOL of the formal proof assistant Isabelle. The article builds upon the foundations that were established in the AFP entry Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories. [CZH_Universal_Constructions] title = Category Theory for ZFC in HOL III: Universal Constructions author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Mathematics/Category theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides a formalization of elements of the theory of universal constructions for 1-categories (such as limits, adjoints and Kan extensions) in the object logic ZFC in HOL of the formal proof assistant Isabelle. The article builds upon the foundations established in the AFP entry Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories. [Conditional_Transfer_Rule] title = Conditional Transfer Rule author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a collection of experimental utilities for unoverloading of definitions and synthesis of conditional transfer rules for the object logic Isabelle/HOL of the formal proof assistant Isabelle written in Isabelle/ML. [Types_To_Sets_Extension] title = Extension of Types-To-Sets author = Mihails Milehins <mailto:user9716869@gmail.com> topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = In their article titled From Types to Sets by Local Type Definitions in Higher-Order Logic and published in the proceedings of the conference Interactive Theorem Proving in 2016, Ondřej Kunčar and Andrei Popescu propose an extension of the logic Isabelle/HOL and an associated algorithm for the relativization of the type-based theorems to more flexible set-based theorems, collectively referred to as Types-To-Sets. One of the aims of their work was to open an opportunity for the development of a software tool for applied relativization in the implementation of the logic Isabelle/HOL of the proof assistant Isabelle. In this article, we provide a prototype of a software framework for the interactive automated relativization of theorems in Isabelle/HOL, developed as an extension of the proof language Isabelle/Isar. The software framework incorporates the implementation of the proposed extension of the logic, and builds upon some of the ideas for further work expressed in the original article on Types-To-Sets by Ondřej Kunčar and Andrei Popescu and the subsequent article Smooth Manifolds and Types to Sets for Linear Algebra in Isabelle/HOL that was written by Fabian Immler and Bohua Zhan and published in the proceedings of the International Conference on Certified Programs and Proofs in 2019. [Complex_Bounded_Operators] title = Complex Bounded Operators author = Jose Manuel Rodriguez Caballero <https://josephcmac.github.io/>, Dominique Unruh <https://www.ut.ee/~unruh/> topic = Mathematics/Analysis date = 2021-09-18 notify = unruh@ut.ee abstract = We present a formalization of bounded operators on complex vector spaces. Our formalization contains material on complex vector spaces (normed spaces, Banach spaces, Hilbert spaces) that complements and goes beyond the developments of real vectors spaces in the Isabelle/HOL standard library. We define the type of bounded operators between complex vector spaces (cblinfun) and develop the theory of unitaries, projectors, extension of bounded linear functions (BLT theorem), adjoints, Loewner order, closed subspaces and more. For the finite-dimensional case, we provide code generation support by identifying finite-dimensional operators with matrices as formalized in the <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a> AFP entry. [Weighted_Path_Order] title = A Formalization of Weighted Path Orders and Recursive Path Orders author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@aist.go.jp> topic = Logic/Rewriting date = 2021-09-16 notify = rene.thiemann@uibk.ac.at abstract = We define the weighted path order (WPO) and formalize several properties such as strong normalization, the subterm property, and closure properties under substitutions and contexts. Our definition of WPO extends the original definition by also permitting multiset comparisons of arguments instead of just lexicographic extensions. Therefore, our WPO not only subsumes lexicographic path orders (LPO), but also recursive path orders (RPO). We formally prove these subsumptions and therefore all of the mentioned properties of WPO are automatically transferable to LPO and RPO as well. Such a transformation is not required for Knuth–Bendix orders (KBO), since they have already been formalized. Nevertheless, we still provide a proof that WPO subsumes KBO and thereby underline the generality of WPO. [FOL_Axiomatic] title = Soundness and Completeness of an Axiomatic System for First-Order Logic author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/> topic = Logic/General logic/Classical first-order logic, Logic/Proof theory date = 2021-09-24 notify = ahfrom@dtu.dk abstract = This work is a formalization of the soundness and completeness of an axiomatic system for first-order logic. The proof system is based on System Q1 by Smullyan and the completeness proof follows his textbook "First-Order Logic" (Springer-Verlag 1968). The completeness proof is in the Henkin style where a consistent set is extended to a maximal consistent set using Lindenbaum's construction and Henkin witnesses are added during the construction to ensure saturation as well. The resulting set is a Hintikka set which, by the model existence theorem, is satisfiable in the Herbrand universe. [Virtual_Substitution] title = Verified Quadratic Virtual Substitution for Real Arithmetic author = Matias Scharager <mailto:mscharag@cs.cmu.edu>, Katherine Cordwell <mailto:kcordwel@cs.cmu.edu>, Stefan Mitsch <mailto:smitsch@cs.cmu.edu>, André Platzer <mailto:aplatzer@cs.cmu.edu> topic = Computer science/Algorithms/Mathematical date = 2021-10-02 notify = mscharag@cs.cmu.edu, kcordwel@cs.cmu.edu, smitsch@cs.cmu.edu, aplatzer@cs.cmu.edu abstract = This paper presents a formally verified quantifier elimination (QE) algorithm for first-order real arithmetic by linear and quadratic virtual substitution (VS) in Isabelle/HOL. The Tarski-Seidenberg theorem established that the first-order logic of real arithmetic is decidable by QE. However, in practice, QE algorithms are highly complicated and often combine multiple methods for performance. VS is a practically successful method for QE that targets formulas with low-degree polynomials. To our knowledge, this is the first work to formalize VS for quadratic real arithmetic including inequalities. The proofs necessitate various contributions to the existing multivariate polynomial libraries in Isabelle/HOL. Our framework is modularized and easily expandable (to facilitate integrating future optimizations), and could serve as a basis for developing practical general-purpose QE algorithms. Further, as our formalization is designed with practicality in mind, we export our development to SML and test the resulting code on 378 benchmarks from the literature, comparing to Redlog, Z3, Wolfram Engine, and SMT-RAT. This identified inconsistencies in some tools, underscoring the significance of a verified approach for the intricacies of real arithmetic. [Correctness_Algebras] title = Algebras for Iteration, Infinite Executions and Correctness of Sequential Computations author = Walter Guttmann <https://www.cosc.canterbury.ac.nz/walter.guttmann/> topic = Computer science/Programming languages/Logics date = 2021-10-12 notify = walter.guttmann@canterbury.ac.nz abstract = We study models of state-based non-deterministic sequential computations and describe them using algebras. We propose algebras that describe iteration for strict and non-strict computations. They unify computation models which differ in the fixpoints used to represent iteration. We propose algebras that describe the infinite executions of a computation. They lead to a unified approximation order and results that connect fixpoints in the approximation and refinement orders. This unifies the semantics of recursion for a range of computation models. We propose algebras that describe preconditions and the effect of while-programs under postconditions. They unify correctness statements in two dimensions: one statement applies in various computation models to various correctness claims. [Belief_Revision] title = Belief Revision Theory author = Valentin Fouillard <mailto:valentin.fouillard@limsi.fr>, Safouan Taha <mailto:safouan.taha@lri.fr>, Frédéric Boulanger <mailto:frederic.boulanger@centralesupelec.fr>, Nicolas Sabouret <> topic = Logic/General logic/Logics of knowledge and belief date = 2021-10-19 notify = safouan.taha@lri.fr, valentin.fouillard@limsi.fr abstract = The 1985 paper by Carlos Alchourrón, Peter Gärdenfors, and David Makinson (AGM), “On the Logic of Theory Change: Partial Meet Contraction and Revision Functions” launches a large and rapidly growing literature that employs formal models and logics to handle changing beliefs of a rational agent and to take into account new piece of information observed by this agent. In 2011, a review book titled "AGM 25 Years: Twenty-Five Years of Research in Belief Change" was edited to summarize the first twenty five years of works based on AGM. This HOL-based AFP entry is a faithful formalization of the AGM operators (e.g. contraction, revision, remainder ...) axiomatized in the original paper. It also contains the proofs of all the theorems stated in the paper that show how these operators combine. Both proofs of Harper and Levi identities are established. [X86_Semantics] title = X86 instruction semantics and basic block symbolic execution author = Freek Verbeek <mailto:freek@vt.edu>, Abhijith Bharadwaj <>, Joshua Bockenek <>, Ian Roessle <>, Timmy Weerwag <>, Binoy Ravindran <> topic = Computer science/Hardware, Computer science/Semantics date = 2021-10-13 notify = freek@vt.edu abstract = This AFP entry provides semantics for roughly 120 different X86-64 assembly instructions. These instructions include various moves, arithmetic/logical operations, jumps, call/return, SIMD extensions and others. External functions are supported by allowing a user to provide custom semantics for these calls. Floating-point operations are mapped to uninterpreted functions. The model provides semantics for register aliasing and a byte-level little-endian memory model. The semantics are purposefully incomplete, but overapproximative. For example, the precise effect of flags may be undefined for certain instructions, or instructions may simply have no semantics at all. In those cases, the semantics are mapped to universally quantified uninterpreted terms from a locale. Second, this entry provides a method to symbolic execution of basic blocks. The method, called ''se_step'' (for: symbolic execution step) fetches an instruction and updates the current symbolic state while keeping track of assumptions made over the memory model. A key component is a set of theorems that prove how reads from memory resolve after writes have occurred. Thirdly, this entry provides a parser that allows the user to copy-paste the output of the standard disassembly tool objdump into Isabelle/HOL. A couple small and explanatory examples are included, including functions from the word count program. Several examples can be supplied upon request (they are not included due to the running time of verification): functions from the floating-point modulo function from FDLIBM, the GLIBC strlen function and the CoreUtils SHA256 implementation. [Registers] title = Quantum and Classical Registers author = Dominique Unruh <https://www.ut.ee/~unruh/> topic = Computer science/Algorithms/Quantum computing, Computer science/Programming languages/Logics, Computer science/Semantics date = 2021-10-28 notify = unruh@ut.ee abstract = A formalization of the theory of quantum and classical registers as developed by (Unruh, Quantum and Classical Registers). In a nutshell, a register refers to a part of a larger memory or system that can be accessed independently. Registers can be constructed from other registers and several (compatible) registers can be composed. This formalization develops both the generic theory of registers as well as specific instantiations for classical and quantum registers. [Szemeredi_Regularity] title = Szemerédi's Regularity Lemma author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Angeliki Koutsoukou-Argyraki <https://www.cst.cam.ac.uk/people/ak2110>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> topic = Mathematics/Graph theory, Mathematics/Combinatorics date = 2021-11-05 notify = lp15@cam.ac.uk abstract = <a href="https://en.wikipedia.org/wiki/Szemerédi_regularity_lemma">Szemerédi's regularity lemma</a> is a key result in the study of large - graphs. It asserts the existence an upper bound on the number of parts + graphs. It asserts the existence of an upper bound on the number of parts the vertices of a graph need to be partitioned into such that the edges between the parts are random in a certain sense. This bound depends only on the desired precision and not on the graph itself, in the spirit of Ramsey's theorem. The formalisation follows online course notes by <a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Tim Gowers</a> and <a href="https://yufeizhao.com/gtac/gtac.pdf">Yufei Zhao</a>. [Factor_Algebraic_Polynomial] title = Factorization of Polynomials with Algebraic Coefficients author = Manuel Eberl <https://pruvisto.org>, René Thiemann <mailto:rene.thiemann@uibk.ac.at> topic = Mathematics/Algebra date = 2021-11-08 notify = rene.thiemann@uibk.ac.at abstract = The AFP already contains a verified implementation of algebraic numbers. However, it is has a severe limitation in its factorization algorithm of real and complex polynomials: the factorization is only guaranteed to succeed if the coefficients of the polynomial are rational numbers. In this work, we verify an algorithm to factor all real and complex polynomials whose coefficients are algebraic. The existence of such an algorithm proves in a constructive way that the set of complex algebraic numbers is algebraically closed. Internally, the algorithm is based on resultants of multivariate polynomials and an approximation algorithm using interval arithmetic. [PAL] title = Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL author = Christoph Benzmüller <http://christoph-benzmueller.de>, Sebastian Reiche <https://www.linkedin.com/in/sebastian-reiche-0b2093178> topic = Logic/General logic/Logics of knowledge and belief date = 2021-11-08 notify = c.benzmueller@gmail.com abstract = We present a shallow embedding of public announcement logic (PAL) with relativized general knowledge in HOL. We then use PAL to obtain an elegant encoding of the wise men puzzle, which we solve automatically using sledgehammer. [SimplifiedOntologicalArgument] title = Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL author = Christoph Benzmüller <http://christoph-benzmueller.de> topic = Logic/Philosophical aspects, Logic/General logic/Modal logic date = 2021-11-08 notify = c.benzmueller@gmail.com abstract = Simplified variants of Gödel's ontological argument are explored. Among those is a particularly interesting simplified argument which is (i) valid already in basic modal logics K or KT, (ii) which does not suffer from modal collapse, and (iii) which avoids the rather complex predicates of essence (Ess.) and necessary existence (NE) as used by Gödel. Whether the presented variants increase or decrease the attractiveness and persuasiveness of the ontological argument is a question I would like to pass on to philosophy and theology. [Van_Emde_Boas_Trees] title = van Emde Boas Trees author = Thomas Ammer<>, Peter Lammich<> topic = Computer science/Data structures date = 2021-11-23 notify = lammich@in.tum.de abstract = The van Emde Boas tree or van Emde Boas priority queue is a data structure supporting membership test, insertion, predecessor and successor search, minimum and maximum determination and deletion in O(log log U) time, where U = 0,...,2n-1 is the overall range to be considered. The presented formalization follows Chapter 20 of the popular Introduction to Algorithms (3rd ed.) by Cormen, Leiserson, Rivest and Stein (CLRS), extending the list of formally verified CLRS algorithms. Our current formalization is based on the first author's bachelor's thesis. First, we prove correct a functional implementation, w.r.t. an abstract data type for sets. Apart from functional correctness, we show a resource bound, and runtime bounds w.r.t. manually defined timing functions for the operations. Next, we refine the operations to Imperative HOL with time, and show correctness and complexity. This yields a practically more efficient implementation, and eliminates the manually defined timing functions from the trusted base of the proof. [Hahn_Jordan_Decomposition] title = The Hahn and Jordan Decomposition Theorems author = Marie Cousin <mailto:marie.cousin@grenoble-inp.org>, Mnacho Echenim <mailto:mnacho.echenim@univ-grenoble-alpes.fr>, Hervé Guiol <mailto:herve.guiol@univ-grenoble-alpes.fr> topic = Mathematics/Measure theory date = 2021-11-19 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = In this work we formalize the Hahn decomposition theorem for signed measures, namely that any measure space for a signed measure can be decomposed into a positive and a negative set, where every measurable subset of the positive one has a positive measure, and every measurable subset of the negative one has a negative measure. We also formalize the Jordan decomposition theorem as a corollary, which states that the signed measure under consideration admits a unique decomposition into a difference of two positive measures, at least one of which is finite. [Simplicial_complexes_and_boolean_functions] title = Simplicial Complexes and Boolean functions author = Jesús Aransay <https://www.unirioja.es/cu/jearansa>, Alejandro del Campo <mailto:alejandro.del-campo@alum.unirioja.es>, Julius Michaelis <http://liftm.de/> topic = Mathematics/Topology date = 2021-11-29 notify = jesus-maria.aransay@unirioja.es abstract = In this work we formalise the isomorphism between simplicial complexes of dimension $n$ and monotone Boolean functions in $n$ variables, mainly following the definitions and results as introduced by N. A. Scoville. We also take advantage of the AFP representation of <a href="https://www.isa-afp.org/entries/ROBDD.html">ROBDD</a> (Reduced Ordered Binary Decision Diagrams) to compute the ROBDD representation of a given simplicial complex (by means of the isomorphism to Boolean functions). Some examples of simplicial complexes and associated Boolean functions are also presented. [Foundation_of_geometry] title = Foundation of geometry in planes, and some complements: Excluding the parallel axioms author = Fumiya Iwama <> topic = Mathematics/Geometry date = 2021-11-22 notify = d1623001@s.konan-u.ac.jp abstract = "Foundations of Geometry" is a mathematical book written by Hilbert in 1899. This entry is a complete formalization of "Incidence" (excluding cubic axioms), "Order" and "Congruence" (excluding point sequences) of the axioms constructed in this book. In addition, the theorem of the problem about the part that is treated implicitly and is not clearly stated in it is being carried out in parallel. + +[Regular_Tree_Relations] +title = Regular Tree Relations +author = Alexander Lochmann <mailto:alexander.lochmann@uibk.ac.at>, Bertram Felgenhauer<>, Christian Sternagel <http://cl-informatik.uibk.ac.at/users/griff/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Thomas Sternagel<> +topic = Computer science/Automata and formal languages +date = 2021-12-15 +notify = alexander.lochmann@uibk.ac.at +abstract = + Tree automata have good closure properties and therefore a commonly + used to prove/disprove properties. This formalization contains among + other things the proofs of many closure properties of tree automata + (anchored) ground tree transducers and regular relations. Additionally + it includes the well known pumping lemma and a lifting of the Myhill + Nerode theorem for regular languages to tree languages. We want to + mention the existence of a <a + href="https://www.isa-afp.org/entries/Tree-Automata.html">tree + automata APF-entry</a> developed by Peter Lammich. His work is + based on epsilon free top-down tree automata, while this entry builds + on bottom-up tree auotamta with epsilon transitions. Moreover our + formalization relies on the <a + href="https://www.isa-afp.org/entries/Collections.html">Collections + Framework</a>, also by Peter Lammich, to obtain efficient code. + All proven constructions of the closure properties are exportable + using the Isabelle/HOL code generation facilities. + +[Roth_Arithmetic_Progressions] +title = Roth's Theorem on Arithmetic Progressions +author = Chelsea Edmonds <https://www.cst.cam.ac.uk/people/cle47>, Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/> +topic = Mathematics/Graph theory, Mathematics/Combinatorics +date = 2021-12-28 +notify = lp15@cam.ac.uk +abstract = + We formalise a proof of Roth's Theorem on Arithmetic + Progressions, a major result in additive combinatorics on the + existence of 3-term arithmetic progressions in subsets of natural + numbers. To this end, we follow a proof using graph regularity. We + employ our recent formalisation of Szemerédi's Regularity Lemma, + a major result in extremal graph theory, which we use here to prove + the Triangle Counting Lemma and the Triangle Removal Lemma. Our + sources are Yufei Zhao's MIT lecture notes + "<a href="https://ocw.mit.edu/courses/mathematics/18-217-graph-theory-and-additive-combinatorics-fall-2019/lecture-notes/MIT18_217F19_ch3.pdf">Graph Theory and Additive Combinatorics</a>" + (revised version <a href="https://yufeizhao.com/gtac/gtac17.pdf">here</a>) + and W.T. Gowers's Cambridge lecture notes + "<a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Topics in Combinatorics</a>". + We also refer to the University of + Georgia notes by Stephanie Bell and Will Grodzicki, + "<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327">Using Szemerédi's Regularity Lemma to Prove Roth's Theorem</a>". + +[Gale_Shapley] +title = Gale-Shapley Algorithm +author = Tobias Nipkow <http://www21.in.tum.de/~nipkow> +topic = Computer science/Algorithms, Mathematics/Games and economics +date = 2021-12-29 +notify = nipkow@in.tum.de +abstract = + This is a stepwise refinement and proof of the Gale-Shapley stable + matching (or marriage) algorithm down to executable code. Both a + purely functional implementation based on lists and a functional + implementation based on efficient arrays (provided by the Collections + Framework in the AFP) are developed. The latter implementation runs in + time O(n2) where + n is the cardinality of the two sets to be matched. + +[Knights_Tour] +title = Knight's Tour Revisited Revisited +author = Lukas Koller <mailto:lukas.koller@tum.de> +topic = Mathematics/Graph theory +date = 2022-01-04 +notify = lukas.koller@tum.de +abstract = + This is a formalization of the article Knight's Tour Revisited by + Cull and De Curtins where they prove the existence of a Knight's + path for arbitrary n × m-boards with min(n,m) ≥ + 5. If n · m is even, then there exists a Knight's + circuit. A Knight's Path is a sequence of moves of a Knight on a + chessboard s.t. the Knight visits every square of a chessboard + exactly once. Finding a Knight's path is a an instance of the + Hamiltonian path problem. A Knight's circuit is a Knight's path, + where additionally the Knight can move from the last square to the + first square of the path, forming a loop. During the formalization + two mistakes in the original proof were discovered. These mistakes + are corrected in this formalization. + +[Hyperdual] +title = Hyperdual Numbers and Forward Differentiation +author = Filip Smola <>, Jacques Fleuriot <https://www.inf.ed.ac.uk/people/staff/Jacques_Fleuriot.html> +topic = Mathematics/Algebra, Mathematics/Analysis +date = 2021-12-31 +notify = f.smola@sms.ed.ac.uk, Jacques.Fleuriot@ed.ac.uk +abstract = + Hyperdual numbers are ones with a real component and a number + of infinitesimal components, usually written as $a_0 + a_1 \cdot + \epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$. + They have been proposed by <a + href="https://doi.org/10.2514/6.2011-886">Fike and + Alonso</a> in an approach to automatic + differentiation. In this entry we formalise + hyperdual numbers and their application to forward differentiation. We + show them to be an instance of multiple algebraic structures and then, + along with facts about twice-differentiability, we define what we call + the hyperdual extensions of functions on real-normed fields. This + extension formally represents the proposed way that the first and + second derivatives of a function can be automatically calculated. We + demonstrate it on the standard logistic function $f(x) = \frac{1}{1 + + e^{-x}}$ and also reproduce the example analytic function $f(x) = + \frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike + and Alonso. + diff --git a/thys/Gale_Shapley/Gale_Shapley1.thy b/thys/Gale_Shapley/Gale_Shapley1.thy new file mode 100644 --- /dev/null +++ b/thys/Gale_Shapley/Gale_Shapley1.thy @@ -0,0 +1,1298 @@ +(* +Stepwise refinement of the Gale-Shapley algorithm down to executable functional code. + +Part 1: Refinement down to lists. + +Author: Tobias Nipkow +*) + +theory Gale_Shapley1 +imports Main + "HOL-Hoare.Hoare_Logic" + "List-Index.List_Index" + "HOL-Library.While_Combinator" + "HOL-Library.LaTeXsugar" +begin + +lemmas conj12 = conjunct1 conjunct2 + +(* TODO: mv *) +theorem while_rule2: + "[| P s; + !!s. [| P s; b s |] ==> P (c s) \<and> (c s, s) \<in> r; + !!s. [| P s; \<not> b s |] ==> Q s; + wf r |] ==> + Q (while b c s)" +using while_rule[of P] by metis + +(* by now in Map *) +lemma ran_map_upd_Some: + "\<lbrakk> m x = Some y; inj_on m (dom m); z \<notin> ran m \<rbrakk> \<Longrightarrow> ran(m(x := Some z)) = ran m - {y} \<union> {z}" +by(force simp add: ran_def domI inj_onD) + +syntax + "_assign_list" :: "idt \<Rightarrow> nat \<Rightarrow> 'b \<Rightarrow> 'com" ("(2_[_] :=/ _)" [70, 0, 65] 61) + +translations + "xs[n] := e" \<rightharpoonup> "xs := CONST list_update xs n e" + +abbreviation upt_set :: "nat \<Rightarrow> nat set" ("{<_}") where +"{<n} \<equiv> {0..<n}" + +(* Maybe also require y : set P? *) +definition prefers :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where +"prefers P x y = (index P x < index P y)" + +abbreviation prefa :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("(_ \<turnstile>/ _ < _)" [50,50,50] 50) where +"P \<turnstile> x < y \<equiv> prefers P x y" + +lemma prefers_asym: "P \<turnstile> x < y \<Longrightarrow> \<not> P \<turnstile> y < x" +by(simp add: prefers_def) + +lemma prefers_trans: "P \<turnstile> x < y \<Longrightarrow> P \<turnstile> y < z \<Longrightarrow> P \<turnstile> x < z" +by (meson order_less_trans prefers_def) + +fun rk_of_pref :: "nat \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow> nat list" where +"rk_of_pref r rs (n#ns) = (rk_of_pref (r+1) rs ns)[n := r]" | +"rk_of_pref r rs [] = rs" + +definition ranking :: "nat list \<Rightarrow> nat list" where +"ranking P = rk_of_pref 0 (replicate (length P) 0) P" + +lemma length_rk_of_pref[simp]: "length(rk_of_pref v vs P) = length vs" +by(induction P arbitrary: v)(auto) + +lemma nth_rk_of_pref: "\<lbrakk> length P \<le> length rs; i \<in> set P; distinct P; set P \<subseteq> {<length rs} \<rbrakk> + \<Longrightarrow> rk_of_pref r rs P ! i = index P i + r" +by(induction P arbitrary: r i) (auto simp add: nth_list_update) + +lemma ranking_iff_pref: "\<lbrakk> set P = {<length P}; i < length P; j < length P \<rbrakk> + \<Longrightarrow> ranking P ! i < ranking P ! j \<longleftrightarrow> P \<turnstile> i < j" +by(simp add: ranking_def prefers_def nth_rk_of_pref card_distinct) + + +subsection \<open>Fixing the preference lists\<close> + +type_synonym prefs = "nat list list" + +locale Pref = +fixes n +fixes P\<^sub>a :: prefs +fixes P\<^sub>b :: prefs +defines "n \<equiv> length P\<^sub>a" +assumes length_P\<^sub>b: "length P\<^sub>b = n" +assumes P\<^sub>a_set: "a < n \<Longrightarrow> length(P\<^sub>a!a) = n \<and> set(P\<^sub>a!a) = {<n}" +assumes P\<^sub>b_set: "b < n \<Longrightarrow> length(P\<^sub>b!b) = n \<and> set(P\<^sub>b!b) = {<n}" +begin + + +abbreviation wf :: "nat list \<Rightarrow> bool" where +"wf xs \<equiv> length xs = n \<and> set xs \<subseteq> {<n}" + +lemma wf_less_n: "\<lbrakk> wf A; a < n \<rbrakk> \<Longrightarrow> A!a < n" +by (simp add: subset_eq) + +corollary wf_le_n1: "\<lbrakk> wf A; a < n \<rbrakk> \<Longrightarrow> A!a \<le> n-1" +using wf_less_n by fastforce + +lemma sumA_ub: "wf A \<Longrightarrow> (\<Sum>a<n. A!a) \<le> n*(n-1)" +using sum_bounded_above[of "{..<n}" "((!) A)" "n-1"] wf_le_n1[of A] by (simp) + + +subsubsection \<open>The (termination) variant(s)\<close> + +text \<open>Basic idea: either some \<open>A!a\<close> is incremented or size of \<open>M\<close> is incremented, but this cannot +go on forever because in the worst case all \<open>A!a = n-1\<close> and \<open>M = n\<close>. Because \<open>n*(n-1) + n = n^2\<close>, +this leads to the following simple variant:\<close> + +definition var0 :: "nat list \<Rightarrow> nat set \<Rightarrow> nat" where +[simp]: "var0 A M = (n^2 - ((\<Sum>a<n. A!a) + card M))" + +lemma var0_match: +assumes "wf A" "M \<subseteq> {<n}" "a < n \<and> a \<notin> M" +shows "var0 A (M \<union> {a}) < var0 A M" +proof - + have 2: "M \<subset> {<n}" using assms(2-3) by auto + have 3: "card M < n" using psubset_card_mono[OF _ 2] by simp + then show ?thesis + using sumA_ub[OF assms(1)] assms(3) finite_subset[OF assms(2)] + by (simp add: power2_eq_square algebra_simps le_diff_conv2) +qed + +lemma var0_next: +assumes "wf A" "M \<subseteq> {<n}" "M \<noteq> {<n}" "a' < n" +shows "var0 (A[a' := A ! a' + 1]) M < var0 A M" +proof - + have 0: "card M < n" using assms(2,3) + by (metis atLeast0LessThan card_lessThan card_subset_eq finite_lessThan lessThan_iff nat_less_le + subset_eq_atLeast0_lessThan_card) + have *: "1 + (\<Sum>a<n. A!a) + card M \<le> n*n" + using sumA_ub[OF assms(1)] 0 by (simp add: algebra_simps le_diff_conv2) + have "var0 (A[a' := A ! a' + 1]) M = n*n - (1 + (A ! a' + sum ((!) A) ({<n} - {a'})) + card M)" + using assms by(simp add: power2_eq_square nth_list_update sum.If_cases lessThan_atLeast0 flip:Diff_eq) + also have "\<dots> = n^2 - (1 + (\<Sum>a<n. A!a) + card M)" + using sum.insert_remove[of "{<n}" "nth A" a',simplified,symmetric] assms(4) + by (simp add:insert_absorb lessThan_atLeast0 power2_eq_square) + also have "\<dots> < n^2 - ((\<Sum>a<n. A!a) + card M)" unfolding power2_eq_square using * by linarith + finally show ?thesis unfolding var0_def . +qed + +definition var :: "nat list \<Rightarrow> nat set \<Rightarrow> nat" where +[simp]: "var A M = (n^2 - n + 1 - ((\<Sum>a<n. A!a) + card M))" + +lemma sumA_ub2: +assumes "a' < n" "A!a' \<le> n-1" "\<forall>a < n. a \<noteq> a' \<longrightarrow> A!a \<le> n-2" +shows "(\<Sum>a<n. A!a) \<le> (n-1)*(n-1)" +proof - + have "(\<Sum>a<n. A!a) = (\<Sum>a \<in> ({<n}-{a'}) \<union> {a'}. A!a)" + by (simp add: assms(1) atLeast0LessThan insert_absorb) + also have "\<dots> =(\<Sum>a \<in> {<n}-{a'}. A!a) + A!a'" + by (simp add: sum.insert_remove) + also have "\<dots> \<le> (\<Sum>a \<in> {<n}-{a'}. A!a) + (n-1)" using assms(2) by linarith + also have "\<dots> \<le> (n-1)*(n-2) + (n-1)" + using sum_bounded_above[of "{..<n}-{a'}" "((!) A)" "n-2"] assms(1,3) + by (simp add: atLeast0LessThan) + also have "\<dots> = (n-1)*(n-1)" + by (metis Suc_diff_Suc Suc_eq_plus1 add.commute diff_is_0_eq' linorder_not_le mult_Suc_right mult_cancel_left nat_1_add_1) + finally show ?thesis . +qed + +definition "match A a = P\<^sub>a ! a ! (A ! a)" + +lemma match_less_n: "\<lbrakk> wf A; a < n \<rbrakk> \<Longrightarrow> match A a < n" +by (metis P\<^sub>a_set atLeastLessThan_iff match_def nth_mem subset_eq) + +lemma match_upd_neq: "\<lbrakk> wf A; a < n; a \<noteq> a' \<rbrakk> \<Longrightarrow> match (A[a := b]) a' = match A a'" +by (simp add: match_def) + +definition blocks :: "nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where +"blocks A a a' = (P\<^sub>a ! a \<turnstile> match A a' < match A a \<and> P\<^sub>b ! match A a' \<turnstile> a < a')" + +definition stable :: "nat list \<Rightarrow> nat set \<Rightarrow> bool" where +"stable A M = (\<not>(\<exists>a\<in>M. \<exists>a'\<in>M. a \<noteq> a' \<and> blocks A a a'))" + +text \<open>The set of Bs that an A would prefer to its current match, +i.e. all Bs above its current match \<open>A!a\<close>.\<close> +abbreviation preferred where +"preferred A a == nth (P\<^sub>a!a) ` {<A!a}" + +definition matching where [simp]: +"matching A M = (wf A \<and> inj_on (match A) M)" + + +text \<open>If \<open>a'\<close> is unmatched and final then all other \<open>a\<close> are matched:\<close> + +lemma final_last: +assumes M: "M \<subseteq> {<n}" and inj: "inj_on (match A) M" and pref_match': "preferred A a \<subseteq> match A ` M" +and a: "a < n \<and> a \<notin> M" and final: "A ! a + 1 = n" +shows "insert a M = {<n}" +proof - + let ?B = "preferred A a" + have "(!) (P\<^sub>a ! a) ` {<n} = {<n}" by (metis P\<^sub>a_set a map_nth set_map set_upt) + hence "inj_on ((!) (P\<^sub>a ! a)) {<n}" by(simp add: eq_card_imp_inj_on) + hence "inj_on ((!) (P\<^sub>a ! a)) {<A!a}" using final by(simp add: subset_inj_on) + hence 1: "Suc(card ?B) = n" using P\<^sub>a_set a final by (simp add: card_image) + have 2: "card ?B \<le> card M" + by(rule surj_card_le[OF subset_eq_atLeast0_lessThan_finite[OF M] pref_match']) + have 3: "card M < n" using M a + by (metis atLeast0LessThan card_seteq order.refl finite_atLeastLessThan le_neq_implies_less lessThan_iff subset_eq_atLeast0_lessThan_card) + have "Suc (card M) = n" using 1 2 3 by simp + thus ?thesis using M a by (simp add: card_subset_eq finite_subset) +qed + +lemma more_choices: +assumes A: "matching A M" and M: "M \<subseteq> {<n}" "M \<noteq> {<n}" +and pref_match': "preferred A a \<subseteq> match A ` M" +and "a < n" and matched: "match A a \<in> match A ` M" +shows "A ! a + 1 < n" +proof (rule ccontr) + have match: "match A ` M \<subseteq> {<n}" using A M P\<^sub>a_set unfolding matching_def + by (smt (verit, best) atLeastLessThan_iff match_def image_subsetI in_mono nth_mem) + have "card M < n" using M + by (metis card_atLeastLessThan card_seteq diff_zero finite_atLeastLessThan not_less) + assume "\<not> A ! a + 1 < n" + hence "A ! a + 1 = n" using A \<open>a < n\<close> unfolding matching_def + by (metis add.commute wf_less_n linorder_neqE_nat not_less_eq plus_1_eq_Suc) + hence *: "nth (P\<^sub>a ! a) ` {<n} \<subseteq> match A ` M" + using pref_match' matched less_Suc_eq match_def by fastforce + have "nth (P\<^sub>a!a) ` {<n} = {<n}" + by (metis \<open>a < n\<close> map_nth P\<^sub>a_set set_map set_upt) + hence "match A ` M = {<n}" + by (metis * match set_eq_subset) + then show False using A M \<open>card M < n\<close> unfolding matching_def + by (metis atLeast0LessThan card_image card_lessThan nat_neq_iff) +qed + +corollary more_choices_matched: +assumes "matching A M" "M \<subseteq> {<n}" "M \<noteq> {<n}" +and "preferred A a \<subseteq> match A ` M" and "a \<in> M" +shows "A ! a + 1 < n" +using more_choices[OF assms(1-4)] \<open>a \<in> M\<close> \<open>M \<subseteq> {<n}\<close> atLeastLessThan_iff by blast + +lemma atmost1_final: assumes M: "M \<subseteq> {<n}" and inj: "inj_on (match A) M" +and "\<forall>a<n. preferred A a \<subseteq> match A ` M" +shows "\<exists>\<^sub>\<le>\<^sub>1 a. a < n \<and> a \<notin> M \<and> A ! a + 1 = n" +apply rule +subgoal for x y +using final_last[OF M inj, of x] final_last[OF M inj, of y] assms(3) by blast +done + +lemma sumA_UB: +assumes "matching A M" "M \<subseteq> {<n}" "M \<noteq> {<n}" "\<forall>a<n. preferred A a \<subseteq> match A ` M" +shows "(\<Sum>a<n. A!a) \<le> (n-1)^2" +proof - + have M: "\<forall>a\<in>M. A!a + 1 < n" using more_choices_matched[OF assms(1-3)] assms(4) + \<open>M \<subseteq> {<n}\<close> atLeastLessThan_iff by blast + note Ainj = conj12[OF assms(1)[unfolded matching_def]] + show ?thesis + proof (cases "\<exists>a'<n. a' \<notin> M \<and> A!a' + 1 = n") + case True + then obtain a' where a': "a'<n" "a' \<notin> M" "A!a' + 1 = n" using \<open>M \<subseteq> {<n}\<close> \<open>M \<noteq> {<n}\<close> by blast + hence "\<forall>a<n. a \<noteq> a' \<longrightarrow> A!a \<le> n-2" + using Uniq_D[OF atmost1_final[OF assms(2) Ainj(2) assms(4)], of a'] M wf_le_n1[OF Ainj(1)] + by (metis Suc_1 Suc_eq_plus1 add_diff_cancel_right' add_le_imp_le_diff diff_diff_left less_eq_Suc_le order_less_le) + from sumA_ub2[OF a'(1) _ this] a'(3) show ?thesis unfolding power2_eq_square by linarith + next + case False + hence "\<forall>a'<n. a' \<notin> M \<longrightarrow> A ! a' + 1 < n" + by (metis Suc_eq_plus1 Suc_lessI wf_less_n[OF Ainj(1)]) + with M have "\<forall>a<n. A ! a + 1 < n" by blast + hence "(\<Sum>a<n. A!a) \<le> n*(n-2)" using sum_bounded_above[of "{..<n}" "((!) A)" "n-2"] by fastforce + also have "\<dots> \<le> (n-1)*(n-1)" by(simp add: algebra_simps) + finally show ?thesis unfolding power2_eq_square . + qed +qed + +lemma var_ub: +assumes "matching A M" "M \<subseteq> {<n}" "M \<noteq> {<n}" "\<forall>a<n. preferred A a \<subseteq> match A ` M" +shows "(\<Sum>a<n. A!a) + card M < n^2 - n + 1" +proof - + have 1: "M \<subset> {<n}" using assms(2,3) by auto + have 2: "card M < n" using psubset_card_mono[OF _ 1] by simp + have 3: "sum ((!) A) {..<n} \<le> n^2 + 1 - 2*n" + using sumA_UB[OF assms(1-4)] by (simp add: power2_eq_square algebra_simps) + have 4: "2*n \<le> Suc (n^2)" using le_square[of n] unfolding power2_eq_square + by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_SucI mult_2 mult_le_mono1 not_less_eq_eq plus_1_eq_Suc) + show "(\<Sum>a<n. A!a) + card M < n^2 - n + 1" using 2 3 4 by linarith +qed + +lemma var_match: +assumes "matching A M" "M \<subseteq> {<n}" "M \<noteq> {<n}" "\<forall>a<n. preferred A a \<subseteq> match A ` M" "a \<notin> M" +shows "var A (M \<union> {a}) < var A M" +proof - + have 2: "M \<subset> {<n}" using assms(2,3) by auto + have 3: "card M < n" using psubset_card_mono[OF _ 2] by simp + have 4: "sum ((!) A) {..<n} \<le> n^2 + 1 - 2*n" + using sumA_UB[OF assms(1-4)] by (simp add: power2_eq_square algebra_simps) + have 5: "2*n \<le> Suc (n^2)" using le_square[of n] unfolding power2_eq_square + by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_SucI mult_2 mult_le_mono1 not_less_eq_eq plus_1_eq_Suc) + have 6: "(\<Sum>a<n. A!a) + card M < n^2 + 1 - n" using 3 4 5 by linarith + from var_ub[OF assms(1-4)] show ?thesis using \<open>a \<notin> M\<close> finite_subset[OF assms(2)] by(simp) +qed + +lemma var_next: +assumes"matching A M" "M \<subseteq> {<n}" "M \<noteq> {<n}" "\<forall>a<n. preferred A a \<subseteq> match A ` M" + "a < n" +shows "var (A[a := A ! a + 1]) M < var A M" +proof - + have "var (A[a := A ! a + 1]) M = n*n - n + 1 - (1 + (A ! a + sum ((!) A) ({<n} - {a})) + card M)" + using assms(1,5) by(simp add: power2_eq_square nth_list_update sum.If_cases lessThan_atLeast0 flip:Diff_eq) + also have "\<dots> = n^2 - n + 1 - (1 + (\<Sum>a<n. A!a) + card M)" + using sum.insert_remove[of "{<n}" "nth A" a,simplified,symmetric] assms(5) + by (simp add:insert_absorb lessThan_atLeast0 power2_eq_square) + also have "\<dots> < n^2 - n + 1 - ((\<Sum>a<n. A!a) + card M)" using var_ub[OF assms(1-4)] unfolding power2_eq_square + by linarith + finally show ?thesis unfolding var_def . +qed + + +text \<open>The following two predicates express the same property: +if \<open>a\<close> prefers \<open>b\<close> over \<open>a\<close>'s current match, +then \<open>b\<close> is matched with an \<open>a'\<close> that \<open>b\<close> prefers to \<open>a\<close>.\<close> + +definition pref_match where +"pref_match A M = (\<forall>a<n. \<forall>b<n. P\<^sub>a!a \<turnstile> b < match A a \<longrightarrow> (\<exists>a'\<in>M. b = match A a' \<and> P\<^sub>b ! b \<turnstile> a' < a))" + +definition pref_match' where +"pref_match' A M = (\<forall>a<n. \<forall>b \<in> preferred A a. \<exists>a'\<in>M. b = match A a' \<and> P\<^sub>b ! b \<turnstile> a' < a)" + +lemma pref_match'_iff: "wf A \<Longrightarrow> pref_match' A M = pref_match A M" +apply (auto simp add: pref_match'_def pref_match_def imp_ex prefers_def match_def) + apply (smt (verit) P\<^sub>a_set atLeast0LessThan order.strict_trans index_first lessThan_iff linorder_neqE_nat nth_index) + by (smt (verit, best) P\<^sub>a_set atLeast0LessThan card_atLeastLessThan card_distinct diff_zero in_mono index_nth_id lessThan_iff less_trans nth_mem) + +definition opti\<^sub>a where +"opti\<^sub>a A = (\<nexists>A'. matching A' {<n} \<and> stable A' {<n} \<and> + (\<exists>a<n. P\<^sub>a ! a \<turnstile> match A' a < match A a))" + +definition pessi\<^sub>b where +"pessi\<^sub>b A = (\<nexists>A'. matching A' {<n} \<and> stable A' {<n} \<and> + (\<exists>a<n. \<exists>a'<n. match A a = match A' a' \<and> P\<^sub>b ! match A a \<turnstile> a < a'))" + +lemma opti\<^sub>a_pessi\<^sub>b: assumes "opti\<^sub>a A" shows "pessi\<^sub>b A" +unfolding pessi\<^sub>b_def +proof (safe, goal_cases) + case (1 A' a a') + have "\<not> P\<^sub>a!a \<turnstile> match A a < match A' a" using 1 + by (metis atLeast0LessThan blocks_def lessThan_iff prefers_asym stable_def) + with 1 \<open>opti\<^sub>a A\<close> show ?case using P\<^sub>a_set match_less_n opti\<^sub>a_def prefers_def unfolding matching_def + by (metis (no_types) atLeast0LessThan inj_on_contraD lessThan_iff less_not_refl linorder_neqE_nat nth_index) +qed + +lemma opti\<^sub>a_inv: +assumes A: "wf A" and a: "a < n" and a': "a' < n" and same_match: "match A a' = match A a" +and pref: "P\<^sub>b ! match A a' \<turnstile> a' < a" and "opti\<^sub>a A" +shows "opti\<^sub>a (A[a := A ! a + 1])" +proof (unfold opti\<^sub>a_def matching_def, rule notI, elim exE conjE) + note opti\<^sub>a = \<open>opti\<^sub>a A\<close>[unfolded opti\<^sub>a_def matching_def] + let ?A = "A[a := A ! a + 1]" + fix A' a'' + assume "a'' < n" and A': "length A' = n" "set A' \<subseteq> {<n}" "stable A' {<n}" "inj_on (match A') {<n}" + and pref_a'': "P\<^sub>a ! a'' \<turnstile> match A' a'' < match ?A a''" + show False + proof cases + assume [simp]: "a'' = a" + have "A!a < n" using A a by(simp add: subset_eq) + with A A' a pref_a'' have "P\<^sub>a ! a \<turnstile> match A' a < match A a \<or> match A' a = match A a" + apply(auto simp: prefers_def match_def) + by (smt (verit) P\<^sub>a_set wf_less_n card_atLeastLessThan card_distinct diff_zero index_nth_id + not_less_eq not_less_less_Suc_eq) + thus False + proof + assume "P\<^sub>a ! a \<turnstile> match A' a < match A a " thus False using opti\<^sub>a A' \<open>a < n\<close> by(fastforce) + next + assume "match A' a = match A a" + have "a \<noteq> a'" using pref a' by(auto simp: prefers_def) + hence "blocks A' a' a" using opti\<^sub>a pref A' same_match \<open>match A' a = match A a\<close> a a' + unfolding blocks_def + by (metis P\<^sub>a_set atLeast0LessThan match_less_n inj_onD lessThan_iff linorder_neqE_nat nth_index prefers_def) + thus False using a a' \<open>a \<noteq> a'\<close> A'(3) by (metis stable_def atLeastLessThan_iff zero_le) + qed + next + assume "a'' \<noteq> a" thus False using opti\<^sub>a A' pref_a'' \<open>a'' < n\<close> by(metis match_def nth_list_update_neq) + qed +qed + +lemma pref_match_stable: + "\<lbrakk> matching A {<n}; pref_match A {<n} \<rbrakk> \<Longrightarrow> stable A {<n}" +unfolding pref_match_def stable_def blocks_def matching_def +by (metis atLeast0LessThan match_less_n inj_onD lessThan_iff prefers_asym) + +definition invAM where +[simp]: "invAM A M = (matching A M \<and> M \<subseteq> {<n} \<and> pref_match A M \<and> opti\<^sub>a A)" + +lemma invAM_match: + "\<lbrakk> invAM A M; a < n \<and> a \<notin> M; match A a \<notin> match A ` M \<rbrakk> \<Longrightarrow> invAM A (M \<union> {a})" +by(simp add: pref_match_def) + +lemma invAM_swap: +assumes "invAM A M" +assumes a: "a < n \<and> a \<notin> M" and a': "a' \<in> M \<and> match A a' = match A a" and pref: "P\<^sub>b ! match A a' \<turnstile> a < a'" +shows "invAM (A[a' := A!a'+1]) (M - {a'} \<union> {a})" +proof - + have A: "wf A" and M : "M \<subseteq> {<n}" and inj: "inj_on (match A) M" and pref_match: "pref_match A M" + and "opti\<^sub>a A" by(insert \<open>invAM A M\<close>) (auto) + have "M \<noteq> {<n}" "a' < n" "a \<noteq> a'" using a' a M by auto + have pref_match': "pref_match' A M" using pref_match pref_match'_iff[OF A] by blast + let ?A = "A[a' := A!a'+1]" let ?M = "M - {a'} \<union> {a}" + have neq_a': "\<forall>x. x \<in> ?M \<longrightarrow> a' \<noteq> x" using \<open>a \<noteq> a'\<close> by blast + have \<open>set ?A \<subseteq> {<n}\<close> + apply(rule set_update_subsetI[OF A[THEN conjunct2]]) + using more_choices[OF _ M \<open>M \<noteq> {<n}\<close>] A inj pref_match' a' subsetD[OF M, of a'] + by(fastforce simp: pref_match'_def) + hence "wf ?A" using A by(simp) + moreover have "inj_on (match ?A) ?M" using a a' inj + by(simp add: match_def inj_on_def)(metis Diff_iff insert_iff nth_list_update_neq) + moreover have "pref_match' ?A ?M" using a a' pref_match' A pref \<open>a' < n\<close> + apply(simp add: pref_match'_def match_upd_neq neq_a' Ball_def Bex_def image_iff imp_ex nth_list_update less_Suc_eq + flip: match_def) + by (metis prefers_trans) + moreover have "opti\<^sub>a ?A" using opti\<^sub>a_inv[OF A \<open>a' < n\<close> _ _ _ \<open>opti\<^sub>a A\<close>] a a'[THEN conjunct2] pref by auto + ultimately show ?thesis using a a' M pref_match'_iff by auto +qed + +lemma invAM_next: +assumes "invAM A M" +assumes a: "a < n \<and> a \<notin> M" and a': "a' \<in> M \<and> match A a' = match A a" and pref: "\<not> P\<^sub>b ! match A a' \<turnstile> a < a'" +shows "invAM (A[a := A!a + 1]) M" +proof - + have A: "wf A" and M : "M \<subseteq> {<n}" and inj: "inj_on (match A) M" and pref_match: "pref_match A M" + and opti\<^sub>a: "opti\<^sub>a A" and "a' < n" + by(insert \<open>invAM A M\<close> a') (auto) + hence pref': "P\<^sub>b ! match A a' \<turnstile> a' < a" + using pref a a' P\<^sub>b_set unfolding prefers_def + by (metis match_def match_less_n index_eq_index_conv linorder_less_linear subsetD) + have "M \<noteq> {<n}" using a by fastforce + have neq_a: "\<forall>x. x\<in> M \<longrightarrow> a \<noteq> x" using a by blast + have pref_match': "pref_match' A M" using pref_match pref_match'_iff[OF A,of M] by blast + hence "\<forall>a<n. preferred A a \<subseteq> match A ` M" unfolding pref_match'_def by blast + hence "A!a + 1 < n" + using more_choices[OF _ M \<open>M \<noteq> {<n}\<close>] A inj a a' unfolding matching_def by (metis (no_types, lifting) imageI) + let ?A = "A[a := A!a+1]" + have "wf ?A" using A \<open>A!a + 1 < n\<close> by(simp add: set_update_subsetI) + moreover have "inj_on (match ?A) M" using a inj + by(simp add: match_def inj_on_def) (metis nth_list_update_neq) + moreover have "pref_match' ?A M" using a pref_match' pref' A a' neq_a + by(auto simp: match_upd_neq pref_match'_def Ball_def Bex_def image_iff nth_list_update imp_ex less_Suc_eq + simp flip: match_def) + moreover have "opti\<^sub>a ?A" using opti\<^sub>a_inv[OF A conjunct1[OF a] \<open>a' < n\<close> conjunct2[OF a'] pref' opti\<^sub>a] . + ultimately show ?thesis using M by (simp add: pref_match'_iff) +qed + + +subsection \<open>Algorithm 1\<close> + +lemma Gale_Shapley1: "VARS M A a a' + [M = {} \<and> A = replicate n 0] + WHILE M \<noteq> {<n} + INV { invAM A M } + VAR {var A M} + DO a := (SOME a. a < n \<and> a \<notin> M); + IF match A a \<notin> match A ` M + THEN M := M \<union> {a} + ELSE a' := (SOME a'. a' \<in> M \<and> match A a' = match A a); + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN A[a'] := A!a'+1; M := M - {a'} \<union> {a} + ELSE A[a] := A!a+1 + FI + FI + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case + by(auto simp: stable_def opti\<^sub>a_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def) +next + case 3 thus ?case using pref_match_stable by auto +next + case (2 v M A a) + hence invAM: "invAM A M" and m: "matching A M" and M: "M \<subseteq> {<n}" "M \<noteq> {<n}" + and pref_match: "pref_match A M" and "opti\<^sub>a A" and v: "var A M = v" by auto + note Ainj = conj12[OF m[unfolded matching_def]] + note pref_match' = pref_match[THEN pref_match'_iff[OF Ainj(1), THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` M" unfolding pref_match'_def by blast + define a where "a = (SOME a. a < n \<and> a \<notin> M)" + have a: "a < n \<and> a \<notin> M" unfolding a_def using M + by (metis (no_types, lifting) atLeastLessThan_iff someI_ex subsetI subset_antisym) + show ?case (is "?P((SOME a. a < n \<and> a \<notin> M))") unfolding a_def[symmetric] + proof - + show "?P a" (is "(?not_matched \<longrightarrow> ?THEN) \<and> (\<not> ?not_matched \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?not_matched + show ?THEN + proof(simp only:mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using invAM_match[OF invAM a \<open>?not_matched\<close>] . + + case 2 show ?case + using var_match[OF m M pref_match1] var0_match[OF Ainj(1) M(1)] a unfolding v by blast + qed + next + assume matched: "\<not> ?not_matched" + define a' where "a' = (SOME a'. a' \<in> M \<and> match A a' = match A a)" + have a': "a' \<in> M \<and> match A a' = match A a" unfolding a'_def using matched + by (smt (verit) image_iff someI_ex) + hence "a' < n" "a \<noteq> a'" using a M atLeast0LessThan by auto + show ?ELSE (is "?P((SOME a'. a' \<in> M \<and> match A a' = match A a))") unfolding a'_def[symmetric] + proof - + show "?P a'" (is "(?pref \<longrightarrow> ?THEN) \<and> (\<not> ?pref \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?pref + show ?THEN + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case by(rule invAM_swap[OF invAM a a' \<open>?pref\<close>]) + + case 2 + have "card(M - {a'} \<union> {a}) = card M" + using a a' card.remove subset_eq_atLeast0_lessThan_finite[OF M(1)] by fastforce + thus ?case using v var_next[OF m M pref_match1 \<open>a' < n\<close>] var0_next[OF Ainj(1) M \<open>a' < n\<close>] + by simp + qed + next + assume "\<not> ?pref" + show ?ELSE + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using invAM_next[OF invAM a a' \<open>\<not> ?pref\<close>] . + + case 2 + show ?case using a v var_next[OF m M pref_match1, of a] var0_next[OF Ainj(1) M, of a] + by simp + qed + qed + qed + qed + qed +qed + +text \<open>Proof also works for @{const var0} instead of @{const var}.\<close> + + +subsection \<open>Algorithm 2: List of unmatched As\<close> + +abbreviation invas where +"invas as == (set as \<subseteq> {<n} \<and> distinct as)" + +lemma Gale_Shapley2: "VARS A a a' as + [as = [0..<n] \<and> A = replicate n 0] + WHILE as \<noteq> [] + INV { invAM A ({<n} - set as) \<and> invas as} + VAR {var A ({<n} - set as)} + DO a := hd as; + IF match A a \<notin> match A ` ({<n} - set as) + THEN as := tl as + ELSE a' := (SOME a'. a' \<in> {<n} - set as \<and> match A a' = match A a); + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN A[a'] := A!a'+1; as := a' # tl as + ELSE A[a] := A!a+1 + FI + FI + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case + by(auto simp: stable_def opti\<^sub>a_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def) +next + case 3 thus ?case using pref_match_stable by auto +next + case (2 v A _ a' as) + let ?M = "{<n} - set as" + have "invAM A ?M" and m: "matching A ?M" and A: "wf A" and M: "?M \<subseteq> {<n}" + and pref_match: "pref_match A ?M" and "opti\<^sub>a A" and "as \<noteq> []" and v: "var A ?M = v" + and as: "invas as" using 2 by auto + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + from \<open>as \<noteq> []\<close> obtain a as' where aseq: "as = a # as'" by (fastforce simp: neq_Nil_conv) + have set_as: "?M \<union> {a} = {<n} - set as'" using as aseq by force + have a: "a < n \<and> a \<notin> ?M" using as unfolding aseq by (simp) + show ?case + proof (simp only: aseq list.sel, goal_cases) + case 1 show ?case (is "(?not_matched \<longrightarrow> ?THEN) \<and> (\<not> ?not_matched \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?not_matched + then have nm: "match A a \<notin> match A ` ?M" unfolding aseq . + show ?THEN + proof(simp only:mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using invAM_match[OF \<open>invAM A ?M\<close> a nm] as unfolding set_as by (simp add: aseq) + case 2 show ?case + using var_match[OF m M _ pref_match1, of a] a atLeast0LessThan + unfolding set_as v by blast + qed + next + assume matched: "\<not> ?not_matched" + define a' where "a' = (SOME a'. a' \<in> ?M \<and> match A a' = match A a)" + have a': "a' \<in> ?M \<and> match A a' = match A a" unfolding a'_def aseq using matched + by (smt (verit) image_iff someI_ex) + hence "a' < n" "a \<noteq> a'" using a M atLeast0LessThan by auto + show ?ELSE unfolding aseq[symmetric] a'_def[symmetric] + proof (goal_cases) + case 1 + show ?case (is "(?pref \<longrightarrow> ?THEN) \<and> (\<not> ?pref \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?pref + show ?THEN + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + have *: "{<n} - set as - {a'} \<union> {a} = {<n} - set (a' # as')" using a a' as aseq by auto + case 1 show ?case using invAM_swap[OF \<open>invAM A ?M\<close> a a' \<open>?pref\<close>] unfolding * + using a' as aseq by force + case 2 + have "card({<n} - set as) = card({<n} - set (a' # as'))" using a a' as aseq by auto + thus ?case using v var_next[OF m M _ pref_match1, of a'] \<open>a' < n\<close> a atLeast0LessThan + by (metis Suc_eq_plus1 lessThan_iff var_def) + qed + next + assume "\<not> ?pref" + show ?ELSE + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using invAM_next[OF \<open>invAM A ?M\<close> a a' \<open>\<not> ?pref\<close>] as by blast + + case 2 + show ?case using a v var_next[OF m M _ pref_match1, of a] + by (metis Suc_eq_plus1 atLeast0LessThan lessThan_iff) + qed + qed + qed + qed + qed +qed + + +abbreviation invAB :: "nat list \<Rightarrow> (nat \<Rightarrow> nat option) \<Rightarrow> nat set \<Rightarrow> bool" where +"invAB A B M == (ran B = M \<and> (\<forall>b a. B b = Some a \<longrightarrow> match A a = b))" + +lemma invAB_swap: +assumes invAB: "invAB A B M" +assumes a: "a < n \<and> a \<notin> M" and a': "a' \<in> M \<and> match A a' = match A a" + and "inj_on B (dom B)" "B(match A a) = Some a'" +shows "invAB (A[a' := A!a'+1]) (B(match A a := Some a)) (M - {a'} \<union> {a})" +proof - + have "\<forall>b x. b \<noteq> match A a \<longrightarrow> B b = Some x \<longrightarrow> a'\<noteq> x" using invAB a' by blast + moreover have "a \<noteq> a'" using a a' by auto + ultimately show ?thesis using assms by(simp add: ran_map_upd_Some match_def) +qed + + +subsection \<open>Algorithm 3: Record matching of Bs to As\<close> + +lemma Gale_Shapley3: "VARS A B a a' as b + [as = [0..<n] \<and> A = replicate n 0 \<and> B = (\<lambda>_. None)] + WHILE as \<noteq> [] + INV { invAM A ({<n} - set as) \<and> invAB A B ({<n} - set as) \<and> invas as} + VAR {var A ({<n} - set as)} + DO a := hd as; b := match A a; + IF B b = None + THEN B := B(b := Some a); as := tl as + ELSE a' := the(B b); + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN B := B(b := Some a); A[a'] := A!a'+1; as := a' # tl as + ELSE A[a] := A!a+1 + FI + FI + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case + by(auto simp: stable_def opti\<^sub>a_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def) +next + case 3 thus ?case using pref_match_stable by auto +next + case (2 v A B _ a' as) + let ?M = "{<n} - set as" + have invAM: "invAM A ?M" and m: "matching A ?M" and A: "wf A" and M: "?M \<subseteq> {<n}" + and pref_match: "pref_match A ?M" and "opti\<^sub>a A" and "as \<noteq> []" and v: "var A ?M = v" + and as: "invas as" and invAB: "invAB A B ?M" using 2 by auto + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + from \<open>as \<noteq> []\<close> obtain a as' where aseq: "as = a # as'" by (fastforce simp: neq_Nil_conv) + have set_as: "?M \<union> {a} = {<n} - set as'" using as aseq by force + have a: "a < n \<and> a \<notin> ?M" using as unfolding aseq by (simp) + show ?case + proof (simp only: aseq list.sel, goal_cases) + case 1 show ?case (is "(?not_matched \<longrightarrow> ?THEN) \<and> (\<not> ?not_matched \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?not_matched + then have nm: "match A a \<notin> match A ` ?M" using invAB unfolding aseq ran_def + apply (clarsimp simp: set_eq_iff) using not_None_eq by blast + show ?THEN + proof(simp only:mem_Collect_eq prod.case, rule conjI, goal_cases) + have invAM': "invAM A ({<n} - set as')" + using invAM_match[OF invAM a nm] unfolding set_as[symmetric] by simp + have invAB': "invAB A (B(match A a := Some a)) ({<n} - set as')" + using invAB \<open>?not_matched\<close> set_as by (simp) + case 1 show ?case using invAM' as invAB' unfolding set_as aseq + by (metis distinct.simps(2) insert_subset list.simps(15)) + case 2 show ?case + using var_match[OF m M _ pref_match1, of a] a atLeast0LessThan + unfolding set_as v by blast + qed + next + assume matched: "\<not> ?not_matched" + then obtain a' where a'eq: "B(match A a) = Some a'" by auto + have a': "a' \<in> ?M \<and> match A a' = match A a" unfolding aseq using a'eq invAB + by (metis ranI aseq) + hence "a' < n" "a \<noteq> a'" using a M atLeast0LessThan by auto + show ?ELSE unfolding aseq[symmetric] a'eq option.sel + proof (goal_cases) + have inj_dom: "inj_on B (dom B)" by (metis (mono_tags) domD inj_onI invAB) + case 1 + show ?case (is "(?pref \<longrightarrow> ?THEN) \<and> (\<not> ?pref \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?pref + show ?THEN + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + have *: "{<n} - set as - {a'} \<union> {a} = {<n} - set (a' # as')" using a a' as aseq by auto + have a'neq: "\<forall>b x. b \<noteq> match A a \<longrightarrow> B b = Some x \<longrightarrow> a'\<noteq> x" + using invAB a' by blast + have invAB': "invAB (A[a' := A ! a' + 1]) (B(match A a := Some a)) ({<n} - insert a' (set as'))" + using invAB_swap[OF invAB a a' inj_dom a'eq] * by simp + case 1 show ?case using invAM_swap[OF invAM a a' \<open>?pref\<close>] invAB' unfolding * + using a' as aseq by simp + case 2 + have "card({<n} - set as) = card({<n} - set (a' # as'))" using a a' as aseq by auto + thus ?case using v var_next[OF m M _ pref_match1, of a'] \<open>a' < n\<close> a atLeast0LessThan + by (metis Suc_eq_plus1 lessThan_iff var_def) + qed + next + assume "\<not> ?pref" + show ?ELSE + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 + have "invAB (A[a := A ! a + 1]) B ?M" using invAB a + by (metis match_def nth_list_update_neq ranI) + thus ?case using invAM_next[OF invAM a a' \<open>\<not> ?pref\<close>] as by blast + case 2 + show ?case using a v var_next[OF m M _ pref_match1, of a] + by (metis Suc_eq_plus1 atLeast0LessThan lessThan_iff) + qed + qed + qed + qed + qed +qed + +(* begin unused: directly implement function B via lists B and M (data refinement); + also done in Alg. 4 in a more principled manner *) + +abbreviation invAB' :: "nat list \<Rightarrow> nat list \<Rightarrow> bool list \<Rightarrow> nat set \<Rightarrow> bool" where +"invAB' A B M M' == (length B = n \<and> length M = n \<and> M' = nth B ` {b. b < n \<and> M!b} + \<and> (\<forall>b<n. M!b \<longrightarrow> B!b < n \<and> match A (B!b) = b))" + +lemma Gale_Shapley4': "VARS A B M a a' as b + [as = [0..<n] \<and> A = replicate n 0 \<and> B = replicate n 0 \<and> M = replicate n False] + WHILE as \<noteq> [] + INV { invAM A ({<n} - set as) \<and> invAB' A B M ({<n} - set as) \<and> invas as} + VAR {var A ({<n} - set as)} + DO a := hd as; b := match A a; + IF \<not> (M ! b) + THEN M[b] := True; B[b] := a; as := tl as + ELSE a' := B ! b; + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN B[b] := a; A[a'] := A!a'+1; as := a' # tl as + ELSE A[a] := A!a+1 + FI + FI + OD + [wf A \<and> inj_on (match A) {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case + by(auto simp: stable_def opti\<^sub>a_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def) +next + case 3 thus ?case using pref_match_stable by auto +next + case (2 v A B M _ a' as) + let ?M = "{<n} - set as" + have invAM: "invAM A ?M" and m: "matching A ?M" and A: "wf A" and M: "?M \<subseteq> {<n}" + and pref_match: "pref_match A ?M" and "opti\<^sub>a A" and notall: "as \<noteq> []" and v: "var A ?M = v" + and as: "invas as" and invAB: "invAB' A B M ?M" using 2 by auto + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + from notall obtain a as' where aseq: "as = a # as'" by (fastforce simp: neq_Nil_conv) + have set_as: "?M \<union> {a} = {<n} - set as'" using as aseq by force + have a: "a < n \<and> a \<notin> ?M" using as unfolding aseq by (simp) + show ?case + proof (simp only: aseq list.sel, goal_cases) + case 1 show ?case (is "(?not_matched \<longrightarrow> ?THEN) \<and> (\<not> ?not_matched \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?not_matched + then have nm: "match A a \<notin> match A ` ?M" using invAB set_as unfolding aseq by force + show ?THEN + proof(simp only:mem_Collect_eq prod.case, rule conjI, goal_cases) + have invAM': "invAM A ({<n} - set as')" + using invAM_match[OF invAM a nm] unfolding set_as[symmetric] by simp + then have invAB': "invAB' A (B[match A a := a]) (M[match A a := True]) ({<n} - set as')" + using invAB \<open>?not_matched\<close> set_as match_less_n[OF A] a + by (auto simp add: image_def nth_list_update) + case 1 show ?case using invAM' invAB as invAB' unfolding set_as aseq + by (metis distinct.simps(2) insert_subset list.simps(15)) + case 2 show ?case + using var_match[OF m M _ pref_match1, of a] a atLeast0LessThan + unfolding set_as v by blast + qed + next + assume matched: "\<not> ?not_matched" + hence "match A a \<in> match A ` ({<n} - insert a (set as'))" using match_less_n[OF A] a invAB + apply(auto) by (metis (lifting) image_eqI list.simps(15) mem_Collect_eq aseq) + hence "Suc(A!a) < n" using more_choices[OF m M, of a] a pref_match1 + using aseq atLeast0LessThan by auto + let ?a = "B ! match A a" + have a': "?a \<in> ?M \<and> match A ?a = match A a" + using invAB match_less_n[OF A] matched a by blast + hence "?a < n" "a \<noteq> ?a" using a by auto + show ?ELSE unfolding aseq option.sel + proof (goal_cases) + case 1 + show ?case (is "(?pref \<longrightarrow> ?THEN) \<and> (\<not> ?pref \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?pref + show ?THEN + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + have *: "{<n} - set as - {?a} \<union> {a} = {<n} - set (?a # as')" using a a' as aseq by auto + have a'neq: "\<forall>b<n. b \<noteq> match A a \<longrightarrow> M!b \<longrightarrow> ?a \<noteq> B!b" + using invAB a' by metis + have invAB': "invAB' (A[?a := A ! ?a + 1]) (B[match A a := a]) M ({<n} - set (?a#as'))" + using invAB aseq * \<open>a \<noteq> ?a\<close> a' match_less_n[OF A, of a] a + apply (simp add: nth_list_update) + apply rule + apply(auto simp add: image_def)[] + apply (clarsimp simp add: match_def) + apply (metis (opaque_lifting) nth_list_update_neq) + done + case 1 show ?case using invAM_swap[OF invAM a a' \<open>?pref\<close>] invAB' unfolding * + using a' as aseq by (auto) + case 2 + have "card({<n} - set as) = card({<n} - set (?a # as'))" using a a' as aseq by simp + thus ?case using v var_next[OF m M _ pref_match1, of ?a] \<open>?a < n\<close> a atLeast0LessThan + by (metis Suc_eq_plus1 lessThan_iff var_def) + qed + next + assume "\<not> ?pref" + show ?ELSE + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 + have "invAB' (A[a := A ! a + 1]) B M ({<n} - set as)" using invAB a \<open>a \<noteq> ?a\<close> + by (metis match_def nth_list_update_neq) + thus ?case using invAM_next[OF invAM a a' \<open>\<not> ?pref\<close>] as aseq by fastforce + case 2 + show ?case using a v var_next[OF m M _ pref_match1, of a] aseq + by (metis Suc_eq_plus1 atLeast0LessThan lessThan_iff) + qed + qed + qed + qed + qed +qed + +(* end unused *) + + +subsection \<open>Algorithm 4: remove list of unmatched As\<close> + +lemma Gale_Shapley4: +"VARS A B ai a a' + [ai = 0 \<and> A = replicate n 0 \<and> B = (\<lambda>_. None)] + WHILE ai < n + INV { invAM A {<ai} \<and> invAB A B {<ai} \<and> ai \<le> n } + VAR {z = n - ai} + DO a := ai; + WHILE B (match A a) \<noteq> None + INV { invAM A ({<ai+1} - {a}) \<and> invAB A B ({<ai+1} - {a}) \<and> (a \<le> ai \<and> ai < n) \<and> z = n-ai } + VAR {var A {<ai}} + DO a' := the(B (match A a)); + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN B := B(match A a := Some a); A[a'] := A!a'+1; a := a' + ELSE A[a] := A!a+1 + FI + OD; + B := B(match A a := Some a); ai := ai+1 + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case (* outer invar holds initially *) + by(auto simp: stable_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def opti\<^sub>a_def)[] +next + case 2 (* outer invar and b ibplies inner invar *) + thus ?case by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) +next + case (4 z A B ai a) (* inner invar' and not b ibplies outer invar *) + note inv = 4[THEN conjunct1] + note invAM = inv[THEN conjunct1] + note aai = inv[THEN conjunct2,THEN conjunct2] + show ?case + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 + have *: "{<Suc ai} = insert a ({<Suc ai} - {a})" using aai by (simp add: insert_absorb) + have **: "inj_on (match A) {<Suc ai} = (inj_on (match A) ({<Suc ai} - {a}) \<and> match A a \<notin> match A ` ({<Suc ai} - {a}))" + by (metis "*" Diff_idemp inj_on_insert) + have nm: "match A a \<notin> match A ` ({<Suc ai} - {a})" using 4 unfolding ran_def + apply (clarsimp simp: set_eq_iff) by (metis not_None_eq) + have invAM': "invAM A {<ai+1}" + using invAM_match[OF invAM, of a] aai nm by (simp add: ** insert_absorb) + show ?case using 4 invAM' by (simp add: insert_absorb) + next + case 2 thus ?case using 4 by auto + qed +next + case 5 (* outer invar and not b implies post *) + thus ?case using pref_match_stable unfolding invAM_def by (metis le_neq_implies_less) +next + case (3 z v A B ai a a') (* preservation of inner invar *) + let ?M = "{<ai+1} - {a}" + have invAM: "invAM A ?M" and m: "matching A ?M" and A: "wf A" and M: "?M \<subseteq> {<n}" + and pref_match: "pref_match A ?M" and matched: "B(match A a) \<noteq> None" and "a \<le> ai" + and v: "var A ?M = v" and as: "a \<le> ai \<and> ai < n" and invAB: "invAB A B ?M" using 3 by auto + note invar = 3[THEN conjunct1,THEN conjunct1] + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + from matched obtain a' where a'eq: "B(match A a) = Some a'" by auto + have a': "a' \<in> ?M \<and> match A a' = match A a" using a'eq invAB by (metis ranI) + have a: "a < n \<and> a \<notin> ?M" using invar by auto + have "?M \<noteq> {<n}" and "a' < n" using M a a' atLeast0LessThan by auto + have card: "card {<ai} = card ?M" using \<open>a \<le> ai\<close> by simp + show ?case unfolding a'eq option.sel + proof (goal_cases) + case 1 + show ?case (is "(?unstab \<longrightarrow> ?THEN) \<and> (\<not> ?unstab \<longrightarrow> ?ELSE)") + proof (rule; rule) + assume ?unstab + have *: "{<ai + 1} - {a} - {a'} \<union> {a} = {<ai + 1} - {a'}" using invar a' by auto + show ?THEN + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + have inj_dom: "inj_on B (dom B)" by (metis (mono_tags) domD inj_onI invAB) + have invAB': "invAB (A[a' := A ! a' + 1]) (B(match A a \<mapsto> a)) ({<ai + 1} - {a'})" + using invAB_swap[OF invAB a a' inj_dom a'eq] * by simp + case 1 show ?case + using invAM_swap[OF invAM a a' \<open>?unstab\<close>] invAB' invar a' unfolding * by (simp) + next + case 2 + show ?case using v var_next[OF m M \<open>?M \<noteq> {<n}\<close> pref_match1 \<open>a' < n\<close>] card + by (metis var_def Suc_eq_plus1 psubset_eq) + qed + next + assume "\<not> ?unstab" + show ?ELSE + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + have *: "\<forall>b a'. B b = Some a' \<longrightarrow> a \<noteq> a'" by (metis invAB ranI a) + case 1 show ?case using invAM_next[OF invAM a a' \<open>\<not> ?unstab\<close>] invar * by (simp add: match_def) + next + case 2 + show ?case using v var_next[OF m M \<open>?M \<noteq> {<n}\<close> pref_match1, of a] a card + by (metis Suc_eq_plus1 var_def) + qed + qed + qed +qed + +definition "\<alpha> B M = (\<lambda>b. if b < n \<and> M!b then Some(B!b) else None)" + +lemma \<alpha>_Some[simp]: "\<alpha> B M b = Some a \<longleftrightarrow> b < n \<and> M!b \<and> a = B!b" +by(auto simp add: \<alpha>_def) + +lemma \<alpha>update1: "\<lbrakk> \<not> M ! b; b < length B; b < length M; n = length M \<rbrakk> + \<Longrightarrow> ran(\<alpha> (B[b := a]) (M[b := True])) = ran(\<alpha> B M) \<union> {a}" +by(force simp add: \<alpha>_def ran_def nth_list_update) + +lemma \<alpha>update2: "\<lbrakk> M!b; b < length B; b < length M; length M = n \<rbrakk> + \<Longrightarrow> \<alpha> (B[b := a]) M = (\<alpha> B M)(b := Some a)" +by(force simp add: \<alpha>_def nth_list_update) + + +abbreviation invAB2 :: "nat list \<Rightarrow> nat list \<Rightarrow> bool list \<Rightarrow> nat set \<Rightarrow> bool" where +"invAB2 A B M M' == (invAB A (\<alpha> B M) M' \<and> (length B = n \<and> length M = n))" + +definition invar1 where +[simp]: "invar1 A B M ai = (invAM A {<ai} \<and> invAB2 A B M {<ai} \<and> ai \<le> n)" + +definition invar2 where +[simp]: "invar2 A B M ai a \<equiv> (invAM A ({<ai+1} - {a}) \<and> invAB2 A B M ({<ai+1} - {a}) \<and> a \<le> ai \<and> ai < n)" + + +subsection \<open>Algorithm 5: Data refinement of \<open>B\<close>\<close> + +lemma Gale_Shapley5: +"VARS A B M ai a a' + [ai = 0 \<and> A = replicate n 0 \<and> length B = n \<and> M = replicate n False] + WHILE ai < n + INV { invar1 A B M ai } + VAR { z = n - ai} + DO a := ai; + WHILE M ! match A a + INV { invar2 A B M ai a \<and> z = n-ai } + VAR {var A {<ai}} + DO a' := B ! match A a; + IF P\<^sub>b ! match A a' \<turnstile> a < a' + THEN B[match A a] := a; A[a'] := A!a'+1; a := a' + ELSE A[a] := A!a+1 + FI + OD; + B[match A a] := a; M[match A a] := True; ai := ai+1 + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case (* outer invar holds initially *) + by(auto simp: stable_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def opti\<^sub>a_def \<alpha>_def cong: conj_cong) +next + case 2 (* outer invar and b ibplies inner invar *) + thus ?case by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) +next + case (4 z A B M ai a) (* inner invar' and not b ibplies outer invar *) + note inv = 4[THEN conjunct1, unfolded invar2_def] + note invAM = inv[THEN conjunct1,THEN conjunct1] + note aai = inv[THEN conjunct1, THEN conjunct2, THEN conjunct2] + show ?case + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 + have *: "{<Suc ai} = insert a ({<Suc ai} - {a})" using aai by (simp add: insert_absorb) + have **: "inj_on (match A) {<Suc ai} = (inj_on (match A) ({<Suc ai} - {a}) \<and> match A a \<notin> match A ` ({<Suc ai} - {a}))" + by (metis "*" Diff_idemp inj_on_insert) + have nm: "match A a \<notin> match A ` ({<Suc ai} - {a})" using 4 unfolding invar2_def ran_def + apply (clarsimp simp: set_eq_iff) by (metis) + have invAM': "invAM A {<ai+1}" + using invAM_match[OF invAM, of a] aai nm by (simp add: ** insert_absorb) + show ?case using 4 invAM' by (simp add: \<alpha>update1 match_less_n insert_absorb nth_list_update) + next + case 2 thus ?case using 4 by auto + qed +next + case 5 (* outer invar and not b ibplies post *) + thus ?case using pref_match_stable unfolding invAM_def invar1_def by(metis le_neq_implies_less) +next + case (3 z v A B M ai a) (* preservation of inner invar *) + let ?M = "{<ai+1} - {a}" + have invAM: "invAM A ?M" and m: "matching A ?M" and A: "wf A" and M: "?M \<subseteq> {<n}" + and pref_match: "pref_match A ?M" and matched: "M ! match A a" + and v: "var A {<ai} = v" and as: "a \<le> ai \<and> ai < n" and invAB: "invAB2 A B M ?M" + using 3 by auto + note invar = 3[THEN conjunct1, THEN conjunct1, unfolded invar2_def] + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + let ?a = "B ! match A a" + have a: "a < n \<and> a \<notin> ?M" using invar by auto + have a': "?a \<in> ?M \<and> match A ?a = match A a" + using invAB match_less_n[OF A] a matched by (metis \<alpha>_Some ranI) + have "?M \<noteq> {<n}" and "?a < n" using M a a' atLeast0LessThan by auto + have card: "card {<ai} = card ?M" using as by simp + have *: "{<ai + 1} - {a} - {?a} \<union> {a} = {<ai + 1} - {?a}" using invar a' by auto + show ?case + proof (simp only: mem_Collect_eq prod.case, goal_cases) + case 1 + show ?case + proof ((rule;rule;rule), goal_cases) + case unstab: 1 + have inj_dom: "inj_on (\<alpha> B M) (dom (\<alpha> B M))" by (metis (mono_tags) domD inj_onI invAB) + have invAB': "invAB (A[B ! match A a := A ! ?a + 1]) (\<alpha> (B[match A a := a]) M) ({<ai + 1} - {?a})" + using invAB_swap[OF invAB[THEN conjunct1] a a' inj_dom] * match_less_n[OF A] a matched invAB + by(simp add:\<alpha>update2) + show ?case using invAM_swap[OF invAM a a' unstab] invAB' invar a' + unfolding * by (simp add: insert_absorb \<alpha>update2) + + case 2 + show ?case using v var_next[OF m M \<open>?M \<noteq> {<n}\<close> pref_match1 \<open>?a < n\<close>] card + by (metis var_def Suc_eq_plus1) + next + case stab: 3 + have *: "\<forall>b. b < n \<and> M!b \<longrightarrow> a \<noteq> B!b" by (metis invAB ranI \<alpha>_Some a) + show ?case using invAM_next[OF invAM a a' stab] invar * by (simp add: match_def) + + case 4 + show ?case using v var_next[OF m M \<open>?M \<noteq> {<n}\<close> pref_match1, of a] a card + by (metis Suc_eq_plus1 var_def) + qed + qed +qed + +lemma inner_to_outer: +assumes inv: "invar2 A B M ai a \<and> b = match A a" and not_b: "\<not> M ! b" +shows "invar1 A (B[b := a]) (M[b := True]) (ai+1)" +proof - + note invAM = inv[unfolded invar2_def, THEN conjunct1,THEN conjunct1] + have *: "{<Suc ai} = insert a ({<Suc ai} - {a})" using inv by (simp add: insert_absorb) + have **: "inj_on (match A) {<Suc ai} = (inj_on (match A) ({<Suc ai} - {a}) \<and> match A a \<notin> match A ` ({<Suc ai} - {a}))" + by (metis "*" Diff_idemp inj_on_insert) + have nm: "match A a \<notin> match A ` ({<Suc ai} - {a})" using inv not_b unfolding invar2_def ran_def + apply (clarsimp simp: set_eq_iff) by (metis) + have invAM': "invAM A {<ai+1}" + using invAM_match[OF invAM, of a] inv nm by (simp add: ** insert_absorb) + show ?thesis using inv not_b invAM' match_less_n by (clarsimp simp: \<alpha>update1 insert_absorb nth_list_update) +qed + +lemma inner_pres: +assumes R: "\<forall>b<n. \<forall>a1<n. \<forall>a2<n. R ! b ! a1 < R ! b ! a2 \<longleftrightarrow> P\<^sub>b ! b \<turnstile> a1 < a2" and + inv: "invar2 A B M ai a" and m: "M ! b" and v: "var A {<ai} = v" + and after: "A1 = A[B ! b := A ! (B ! b) + 1]" "A2 = A[a := A ! a + 1]" + "a' = B!b" "r = R ! match A a'" "b = match A a" +shows "(r ! a < r ! a' \<longrightarrow> invar2 A1 (B[b:=a]) M ai a' \<and> var A1 {<ai} < v) \<and> + (\<not> r ! a < r ! a' \<longrightarrow> invar2 A2 B M ai a \<and> var A2 {<ai} < v)" +proof - + let ?M = "{<ai+1} - {a}" + note [simp] = after + note inv' = inv[unfolded invar2_def] + have A: "wf A" and M: "?M \<subseteq> {<n}" and invAM: "invAM A ?M" and invAB: "invAB A (\<alpha> B M) ?M" + and mat: "matching A ?M" and pref_match: "pref_match A ?M" + and as: "a \<le> ai \<and> ai < n" using inv' by auto + note pref_match' = pref_match[THEN pref_match'_iff[OF A, THEN iffD2]] + hence pref_match1: "\<forall>a<n. preferred A a \<subseteq> match A ` ?M" unfolding pref_match'_def by blast + let ?a = "B ! match A a" + have a: "a < n \<and> a \<notin> ?M" using inv by auto + have a': "?a \<in> ?M \<and> match A ?a = match A a" + using invAB match_less_n[OF A] a m inv by (metis \<alpha>_Some ranI \<open>b = _\<close>) + have "?M \<noteq> {<n}" and "?a < n" using M a a' atLeast0LessThan by auto + have card: "card {<ai} = card ?M" using as by simp + show ?thesis + proof ((rule;rule;rule), goal_cases) + have *: "{<ai + 1} - {a} - {?a} \<union> {a} = {<ai + 1} - {?a}" using inv a' by auto + case 1 + hence unstab: "P\<^sub>b ! match A a' \<turnstile> a < a'" + using R a a' as P\<^sub>b_set P\<^sub>a_set match_less_n[OF A] n_def length_P\<^sub>b R by (simp) + have inj_dom: "inj_on (\<alpha> B M) (dom (\<alpha> B M))" by (metis (mono_tags) domD inj_onI invAB) + have invAB': "invAB A1 (\<alpha> (B[match A a := a]) M) ({<ai + 1} - {?a})" + using invAB_swap[OF invAB a a' inj_dom] * match_less_n[OF A] a m + by (simp add: \<alpha>update2 inv') + show ?case using invAM_swap[OF invAM a a'] unstab invAB' inv a' + unfolding * by (simp add: insert_absorb \<alpha>update2) + next + case 2 + show ?case using v var_next[OF mat M \<open>?M \<noteq> {<n}\<close> pref_match1 \<open>?a < n\<close>] card assms(5,9) + by (metis Suc_eq_plus1 var_def) + next + have *: "\<forall>b. b < n \<and> M!b \<longrightarrow> a \<noteq> B!b" by (metis invAB ranI \<alpha>_Some a) + case 3 + hence unstab: "\<not> P\<^sub>b ! match A a' \<turnstile> a < a'" + using R a a' as P\<^sub>b_set P\<^sub>a_set match_less_n[OF A] n_def length_P\<^sub>b + by (simp add: ranking_iff_pref) + then show ?case using invAM_next[OF invAM a a'] 3 inv * by (simp add: match_def) + next + case 4 + show ?case using v var_next[OF mat M \<open>?M \<noteq> {<n}\<close> pref_match1, of a] a card assms(6) + by (metis Suc_eq_plus1 var_def) + qed +qed + + +subsection \<open>Algorithm 6: replace \<open>P\<^sub>b\<close> by ranking \<open>R\<close>\<close> + +lemma Gale_Shapley6: +assumes "R = map ranking P\<^sub>b" +shows +"VARS A B M ai a a' b r + [ai = 0 \<and> A = replicate n 0 \<and> length B = n \<and> M = replicate n False] + WHILE ai < n + INV { invar1 A B M ai } + VAR {z = n - ai} + DO a := ai; b := match A a; + WHILE M ! b + INV { invar2 A B M ai a \<and> b = match A a \<and> z = n-ai } + VAR {var A {<ai}} + DO a' := B ! b; r := R ! match A a'; + IF r ! a < r ! a' + THEN B[b] := a; A[a'] := A!a'+1; a := a' + ELSE A[a] := A!a+1 + FI; + b := match A a + OD; + B[b] := a; M[b] := True; ai := ai+1 + OD + [matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A]" +proof (vcg_tc, goal_cases) + case 1 thus ?case (* outer invar holds initially *) + by(auto simp: stable_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def opti\<^sub>a_def \<alpha>_def cong: conj_cong) +next + case 2 (* outer invar and b ibplies inner invar *) + thus ?case by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) +next + case 3 (* preservation of inner invar *) + have R: "\<forall>b<n. \<forall>a1<n. \<forall>a2<n. R ! b ! a1 < R ! b ! a2 \<longleftrightarrow> P\<^sub>b ! b \<turnstile> a1 < a2" + by (simp add: P\<^sub>b_set \<open>R = _\<close> length_P\<^sub>b ranking_iff_pref) + show ?case + proof (simp only: mem_Collect_eq prod.case, goal_cases) + case 1 show ?case using inner_pres[OF R _ _ refl refl refl] 3 by blast + qed +next + case 4 (* inner invar' and not b ibplies outer invar *) + show ?case + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using 4 inner_to_outer by blast + next + case 2 thus ?case using 4 by auto + qed +next + case 5 (* outer invar and not b ibplies post *) + thus ?case using pref_match_stable unfolding invAM_def invar1_def by(metis le_neq_implies_less) +qed + +end + + +subsection \<open>Functional implementation\<close> + +definition +"gs_inner P\<^sub>a R M = + while (\<lambda>(A,B,a,b). M!b) + (\<lambda>(A,B,a,b). + let a' = B ! b; + r = R ! (P\<^sub>a ! a' ! (A ! a')) in + let (A, B, a) = + if r ! a < r ! a' + then (A[a' := A!a' + 1], B[b := a], a') + else (A[a := A!a + 1], B, a) + in (A, B, a, P\<^sub>a ! a ! (A ! a)))" + +definition +"gs n P\<^sub>a R = + while (\<lambda>(A,B,M,ai). ai < n) + (\<lambda>(A,B,M,ai). + let (A,B,a,b) = gs_inner P\<^sub>a R M (A, B, ai, P\<^sub>a ! ai ! (A ! ai)) + in (A, B[b:=a], M[b:=True], ai+1)) + (replicate n 0, replicate n 0, replicate n False,0)" + +context Pref +begin + +lemma gs_inner: +assumes "R = map ranking P\<^sub>b" +assumes "invar2 A B M ai a" "b = match A a" +shows "gs_inner P\<^sub>a R M (A, B, a, b) = (A',B',a',b') \<longrightarrow> invar1 A' (B'[b' := a']) (M[b' := True]) (ai+1)" +unfolding gs_inner_def +proof(rule while_rule2[where P = "\<lambda>(A,B,a,b). invar2 A B M ai a \<and> b = match A a" + and r = "measure (%(A, B, a, b). Pref.var P\<^sub>a A {<ai})"], goal_cases) + case 1 + show ?case using assms unfolding var_def by simp +next + case inv: (2 s) + obtain A B a b where s: "s = (A, B, a, b)" + using prod_cases4 by blast + have R: "\<forall>b<n. \<forall>a1<n. \<forall>a2<n. R ! b ! a1 < R ! b ! a2 \<longleftrightarrow> P\<^sub>b ! b \<turnstile> a1 < a2" + by (simp add: P\<^sub>b_set \<open>R = _\<close> length_P\<^sub>b ranking_iff_pref) + show ?case + proof(rule, goal_cases) + case 1 show ?case + using inv apply(simp only: s prod.case Let_def split: if_split) + using inner_pres[OF R _ _ refl refl refl refl refl, of A B M ai a b] + unfolding invar2_def match_def by presburger + case 2 show ?case + using inv apply(simp only: s prod.case Let_def in_measure split: if_split) + using inner_pres[OF R _ _ refl refl refl refl refl, of A B M ai a b] + unfolding invar2_def match_def by presburger + qed +next + case 3 + show ?case + proof (rule, goal_cases) + case 1 show ?case by(rule inner_to_outer[OF 3[unfolded 1 prod.case]]) + qed +next + case 4 + show ?case by simp +qed + +lemma gs: assumes "R = map ranking P\<^sub>b" +shows "gs n P\<^sub>a R = (A,BMai) \<longrightarrow> matching A {<n} \<and> stable A {<n} \<and> opti\<^sub>a A" +unfolding gs_def +proof(rule while_rule2[where P = "\<lambda>(A,B,M,ai). invar1 A B M ai" + and r = "measure(\<lambda>(A,B,M,ai). n - ai)"], goal_cases) + case 1 show ?case + by(auto simp: stable_def pref_match_def P\<^sub>a_set card_distinct match_def index_nth_id prefers_def opti\<^sub>a_def \<alpha>_def cong: conj_cong) +next + case (2 s) + obtain A B M ai where s: "s = (A, B, M, ai)" + using prod_cases4 by blast + have 1: "invar2 A B M ai ai" using 2 s + by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) + show ?case using 2 s gs_inner[OF \<open>R = _ \<close> 1] by (auto simp: match_def simp del: invar1_def split: prod.split) +next + case 3 + thus ?case using pref_match_stable by auto +next + case 4 + show ?case by simp +qed + +end + + +subsection \<open>Executable functional Code\<close> + +definition +"Gale_Shapley P\<^sub>a P\<^sub>b = (if Pref P\<^sub>a P\<^sub>b then Some (fst (gs (length P\<^sub>a) P\<^sub>a (map ranking P\<^sub>b))) else None)" + +theorem gs: "\<lbrakk> Pref P\<^sub>a P\<^sub>b; n = length P\<^sub>a \<rbrakk> \<Longrightarrow> + \<exists>A. Gale_Shapley P\<^sub>a P\<^sub>b = Some(A) \<and> Pref.matching P\<^sub>a A {<n} \<and> + Pref.stable P\<^sub>a P\<^sub>b A {<n} \<and> Pref.opti\<^sub>a P\<^sub>a P\<^sub>b A" +unfolding Gale_Shapley_def using Pref.gs +by (metis fst_conv surj_pair) + +declare Pref_def [code] + +text \<open>Two examples from Gusfield and Irving:\<close> + +lemma "Gale_Shapley + [[3,0,1,2], [1,2,0,3], [1,3,2,0], [2,0,3,1]] + [[3,0,2,1], [0,2,1,3], [0,1,2,3], [3,0,2,1]] + = Some[0,1,0,1]" +by eval + +lemma "Gale_Shapley + [[4,6,0,1,5,7,3,2], [1,2,6,4,3,0,7,5], [7,4,0,3,5,1,2,6], [2,1,6,3,0,5,7,4], + [6,1,4,0,2,5,7,3], [0,5,6,4,7,3,1,2], [1,4,6,5,2,3,7,0], [2,7,3,4,6,1,5,0]] + [[4,2,6,5,0,1,7,3], [7,5,2,4,6,1,0,3], [0,4,5,1,3,7,6,2], [7,6,2,1,3,0,4,5], + [5,3,6,2,7,0,1,4], [1,7,4,2,3,5,6,0], [6,4,1,0,7,5,3,2], [6,3,0,4,1,2,5,7]] + = Some [0, 1, 0, 5, 0, 0, 0, 2]" +by eval + +end \ No newline at end of file diff --git a/thys/Gale_Shapley/Gale_Shapley2.thy b/thys/Gale_Shapley/Gale_Shapley2.thy new file mode 100644 --- /dev/null +++ b/thys/Gale_Shapley/Gale_Shapley2.thy @@ -0,0 +1,253 @@ +(* +Stepwise refinement of the Gale-Shapley algorithm down to executable code. + +Part 2: Refinement from lists to arrays, + resulting in a linear (in the input size, which is n^2) time algorithm + +Author: Tobias Nipkow +*) + +theory Gale_Shapley2 +imports Gale_Shapley1 "Collections.Diff_Array" +begin + +abbreviation "array \<equiv> new_array" +notation array_get (infixl "!!" 100) +notation array_set ("_[_ ::= _]" [1000,0,0] 900) +abbreviation "list \<equiv> list_of_array" + +lemma list_array: "list (array x n) = replicate n x" +by (simp add: new_array_def) + +lemma array_get: "a !! i = list a ! i" +by (cases a) simp + +context Pref +begin + +subsection \<open>Algorithm 7: Arrays\<close> + +definition "match_array A a = P\<^sub>a ! a ! (A !! a)" + +lemma match_array: "match_array A a = match (list A) a" +by(cases A) (simp add: match_array_def match_def) + +lemmas array_abs = match_array array_list_of_set array_get + +lemma Gale_Shapley7: +assumes "R = map ranking P\<^sub>b" +shows +"VARS A B M ai a a' b r + [ai = 0 \<and> A = array 0 n \<and> B = array 0 n \<and> M = array False n] + WHILE ai < n + INV { invar1 (list A) (list B) (list M) ai } + VAR {z = n - ai} + DO a := ai; b := match_array A a; + WHILE M !! b + INV { invar2 (list A) (list B) (list M) ai a \<and> b = match_array A a \<and> z = n-ai } + VAR {var (list A) {<ai}} + DO a' := B !! b; r := R ! match_array A a'; + IF r ! a < r ! a' + THEN B := B[b ::= a]; A := A[a' ::= A !! a' + 1]; a := a' + ELSE A := A[a ::= A !! a + 1] + FI; + b := match_array A a + OD; + B := B[b ::= a]; M := M[b ::= True]; ai := ai+1 + OD + [matching (list A) {<n} \<and> stable (list A) {<n} \<and> opti\<^sub>a (list A)]" +proof (vcg_tc, goal_cases) + case 1 thus ?case (* outer invar holds initially *) + by(auto simp: pref_match_def P\<^sub>a_set card_distinct match_def list_array index_nth_id prefers_def opti\<^sub>a_def \<alpha>_def cong: conj_cong) +next + case 2 (* outer invar and b implies inner invar *) + thus ?case by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) +next + case 3 (* preservation of inner invar *) + have R: "\<forall>b<n. \<forall>a1<n. \<forall>a2<n. R ! b ! a1 < R ! b ! a2 \<longleftrightarrow> P\<^sub>b ! b \<turnstile> a1 < a2" + by (simp add: P\<^sub>b_set \<open>R = _\<close> length_P\<^sub>b ranking_iff_pref) + show ?case + proof (simp only: mem_Collect_eq prod.case, goal_cases) + case 1 show ?case using inner_pres[OF R _ _ refl refl refl] 3 + unfolding array_abs by blast + qed +next + case 4 (* inner invar' and not b implies outer invar *) + show ?case + proof (simp only: mem_Collect_eq prod.case, rule conjI, goal_cases) + case 1 show ?case using 4 inner_to_outer unfolding array_abs by blast + next + case 2 thus ?case using 4 by auto + qed +next + case 5 (* outer invar and not b ibplies post *) + thus ?case using pref_match_stable unfolding invAM_def invar1_def by(metis le_neq_implies_less) +qed + +end + + +subsection \<open>Executable functional Code\<close> + +definition gs_inner where +"gs_inner P\<^sub>a R M = + while (\<lambda>(A,B,a,b). M !! b) + (\<lambda>(A,B,a,b). + let a' = B !! b; + r = R !! (P\<^sub>a !! a' !! (A !! a')) in + let (A, B, a) = + if r !! a < r !! a' + then (A[a' ::= A !! a' + 1], B[b ::= a], a') + else (A[a ::= A !! a + 1], B, a) + in (A, B, a, P\<^sub>a !! a !! (A !! a)))" + +definition gs where +"gs n P\<^sub>a R = + while (\<lambda>(A,B,M,ai). ai < n) + (\<lambda>(A,B,M,ai). + let (A,B,a,b) = gs_inner P\<^sub>a R M (A, B, ai, P\<^sub>a !! ai !! (A !! ai)) + in (A, B[b ::= a], M[b::=True], ai+1)) + (array 0 n, array 0 n, array False n, 0)" + + +definition "pref_array = array_of_list o map array_of_list" + +lemma list_list_pref_array: "i < length Pa \<Longrightarrow> list (list (pref_array Pa) ! i) = Pa ! i" +by(simp add: pref_array_def) + +fun rk_of_pref :: "nat \<Rightarrow> nat array \<Rightarrow> nat list \<Rightarrow> nat array" where +"rk_of_pref r rs (n#ns) = (rk_of_pref (r+1) rs ns)[n ::= r]" | +"rk_of_pref r rs [] = rs" + +definition rank_array1 :: "nat list \<Rightarrow> nat array" where +"rank_array1 P = rk_of_pref 0 (array 0 (length P)) P" + +definition rank_array :: "nat list list \<Rightarrow> nat array array" where +"rank_array = array_of_list o map rank_array1" + +lemma length_rk_of_pref[simp]: "array_length(rk_of_pref v vs P) = array_length vs" +by(induction P arbitrary: v)(auto) + +lemma nth_rk_of_pref: + "\<lbrakk> length P \<le> array_length rs; i \<in> set P; distinct P; set P \<subseteq> {<array_length rs} \<rbrakk> + \<Longrightarrow> rk_of_pref r rs P !! i = index P i + r" +by(induction P arbitrary: r i) (auto simp add: array_get_array_set_other) + +lemma rank_array1_iff_pref: "\<lbrakk> set P = {<length P}; i < length P; j < length P \<rbrakk> + \<Longrightarrow> rank_array1 P !! i < rank_array1 P !! j \<longleftrightarrow> P \<turnstile> i < j" +by(simp add: rank_array1_def prefers_def nth_rk_of_pref card_distinct) + +definition Gale_Shapley where +"Gale_Shapley P\<^sub>a P\<^sub>b = + (if Pref P\<^sub>a P\<^sub>b + then Some (fst (gs (length P\<^sub>a) (pref_array P\<^sub>a) (rank_array P\<^sub>b))) + else None)" + +(*export_code Gale_Shapley_array in SML*) + +context Pref +begin + +lemma gs_inner: +assumes "R = rank_array P\<^sub>b" +assumes "invar2 (list A) (list B) (list M) ai a" "b = match_array A a" +shows "gs_inner (pref_array P\<^sub>a) R M (A, B, a, b) = (A',B',a',b') + \<longrightarrow> invar1 (list A') ((list B')[b' := a']) ((list M)[b' := True]) (ai+1)" +unfolding gs_inner_def +proof(rule while_rule2[where + P = "\<lambda>(A,B,a,b). invar2 (list A) (list B) (list M) ai a \<and> b = match_array A a" + and r = "measure (\<lambda>(A, B, a, b). Pref.var P\<^sub>a (list A) {<ai})"], goal_cases) + case 1 + show ?case using assms unfolding var_def by simp +next + case inv: (2 s) + obtain A B a b where s: "s = (A, B, a, b)" + using prod_cases4 by blast + show ?case + proof(rule, goal_cases) + case 1 + have *: "a < n" using s inv(1)[unfolded invar2_def] by (auto) + hence 2: "list A ! a < n" using s inv(1)[unfolded invar2_def] + apply simp using "*" wf_less_n by presburger + hence "match (list A) a < n" + by (metis "*" P\<^sub>a_set atLeast0LessThan lessThan_iff match_def nth_mem) + from this have **: "list B ! match (list A) a < n" using s inv[unfolded invar2_def] + apply (simp add: array_abs ran_def) using atLeast0LessThan by blast + have R: "\<forall>b<n. \<forall>a1<n. \<forall>a2<n. map list (list R) ! b ! a1 < map list (list R) ! b ! a2 \<longleftrightarrow> P\<^sub>b ! b \<turnstile> a1 < a2" + using rank_array1_iff_pref by(simp add: \<open>R = _\<close> length_P\<^sub>b array_get P\<^sub>b_set rank_array_def) + have ***: "match (list A) (list B ! b) < length (list R)" using s inv(1)[unfolded invar2_def] + using ** by(simp add: \<open>R = _\<close> rank_array_def match_array match_less_n length_P\<^sub>b) + show ?case + using inv apply(simp only: s prod.case Let_def split: if_split) + using inner_pres[OF R _ _ refl refl refl refl refl, of "list A" "list B" "list M" ai a b] + unfolding invar2_def array_abs + list_list_pref_array[OF **[unfolded n_def]] list_list_pref_array[OF *[unfolded n_def]] nth_map[OF ***] + unfolding match_def by presburger + case 2 show ?case + using inv apply(simp only: s prod.case Let_def in_measure split: if_split) + using inner_pres[OF R _ _ refl refl refl refl refl, of "list A" "list B" "list M" ai a b] + unfolding invar2_def array_abs + list_list_pref_array[OF **[unfolded n_def]] list_list_pref_array[OF *[unfolded n_def]] nth_map[OF ***] + unfolding match_def by presburger + qed +next + case 3 + show ?case + proof (rule, goal_cases) + case 1 show ?case by(rule inner_to_outer[OF 3[unfolded 1 prod.case array_abs]]) + qed +next + case 4 + show ?case by simp +qed + +lemma gs: assumes "R = rank_array P\<^sub>b" +shows "gs n (pref_array P\<^sub>a) R = (A,B,M,ai) \<longrightarrow> matching (list A) {<n} \<and> stable (list A) {<n} \<and> opti\<^sub>a (list A)" +unfolding gs_def +proof(rule while_rule2[where P = "\<lambda>(A,B,M,ai). invar1 (list A) (list B) (list M) ai" + and r = "measure(\<lambda>(A,B,M,ai). n - ai)"], goal_cases) + case 1 show ?case + by(auto simp: pref_match_def P\<^sub>a_set card_distinct match_def list_array index_nth_id prefers_def opti\<^sub>a_def \<alpha>_def cong: conj_cong) +next + case (2 s) + obtain A B M ai where s: "s = (A, B, M, ai)" + using prod_cases4 by blast + have 1: "invar2 (list A) (list B) (list M) ai ai" using 2 s + by (auto simp: atLeastLessThanSuc_atLeastAtMost simp flip: atLeastLessThan_eq_atLeastAtMost_diff) + hence "ai < n" by(simp) + show ?case using 2 s gs_inner[OF \<open>R = _ \<close> 1] + by (auto simp: array_abs match_def list_list_pref_array[OF \<open>ai < n\<close>[unfolded n_def]] + simp del: invar1_def split: prod.split) +next + case 3 + thus ?case using pref_match_stable by auto +next + case 4 + show ?case by simp +qed + +end + +theorem gs: "\<lbrakk> Pref P\<^sub>a P\<^sub>b; n = length P\<^sub>a \<rbrakk> \<Longrightarrow> + \<exists>A. Gale_Shapley P\<^sub>a P\<^sub>b = Some A + \<and> Pref.matching P\<^sub>a (list A) {<n} \<and> Pref.stable P\<^sub>a P\<^sub>b (list A) {<n} \<and> Pref.opti\<^sub>a P\<^sub>a P\<^sub>b (list A)" +unfolding Gale_Shapley_def using Pref.gs +by (metis fst_conv surj_pair) + + +text \<open>Two examples from Gusfield and Irving:\<close> + +lemma "list_of_array (the (Gale_Shapley + [[3,0,1,2], [1,2,0,3], [1,3,2,0], [2,0,3,1]] [[3,0,2,1], [0,2,1,3], [0,1,2,3], [3,0,2,1]])) + = [0,1,0,1]" +by eval + +lemma "list_of_array (the (Gale_Shapley + [[4,6,0,1,5,7,3,2], [1,2,6,4,3,0,7,5], [7,4,0,3,5,1,2,6], [2,1,6,3,0,5,7,4], + [6,1,4,0,2,5,7,3], [0,5,6,4,7,3,1,2], [1,4,6,5,2,3,7,0], [2,7,3,4,6,1,5,0]] + [[4,2,6,5,0,1,7,3], [7,5,2,4,6,1,0,3], [0,4,5,1,3,7,6,2], [7,6,2,1,3,0,4,5], + [5,3,6,2,7,0,1,4], [1,7,4,2,3,5,6,0], [6,4,1,0,7,5,3,2], [6,3,0,4,1,2,5,7]])) + = [0, 1, 0, 5, 0, 0, 0, 2]" +by eval + +end \ No newline at end of file diff --git a/thys/Gale_Shapley/ROOT b/thys/Gale_Shapley/ROOT new file mode 100644 --- /dev/null +++ b/thys/Gale_Shapley/ROOT @@ -0,0 +1,14 @@ +chapter AFP + +session Gale_Shapley (AFP) = HOL + + options [timeout = 600] + sessions + "HOL-Library" + "HOL-Hoare" + "List-Index" + Collections + theories + "Gale_Shapley2" + document_files + "root.tex" + "root.bib" diff --git a/thys/Gale_Shapley/document/root.bib b/thys/Gale_Shapley/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Gale_Shapley/document/root.bib @@ -0,0 +1,57 @@ +@article{Baker91, +author = {Baker, Henry G.}, +title = {Shallow Binding Makes Functional Arrays Fast}, +year = {1991}, +publisher = {Association for Computing Machinery}, +address = {New York, NY, USA}, +volume = {26}, +number = {8}, +url = {https://doi.org/10.1145/122598.122614}, +journal = {SIGPLAN Not.}, +month = {aug}, +pages = {145-147}, +} + +@inproceedings{ConchonF07, + author = {Sylvain Conchon and + Jean{-}Christophe Filli{\^{a}}tre}, + editor = {Claudio V. Russo and + Derek Dreyer}, + title = {A persistent union-find data structure}, + booktitle = {Proceedings of the {ACM} Workshop on ML, 2007, Freiburg, Germany, + October 5, 2007}, + pages = {37--46}, + publisher = {{ACM}}, + year = {2007}, + url = {https://doi.org/10.1145/1292535.1292541}, +} + +@article{GaleS62, + author = {D. Gale and + L. S. Shapley}, + title = {College Admissions and the Stability of Marriage}, + journal = {Am. Math. Mon.}, + volume = {69}, + number = {1}, + pages = {9--15}, + year = {1962}, +} + +@book{GusfieldI89, + author = {Dan Gusfield and + Robert W. Irving}, + title = {The Stable marriage problem - structure and algorithms}, + series = {Foundations of computing series}, + publisher = {{MIT} Press}, + year = {1989} +} + +@article{Collections-AFP, + author = {Peter Lammich}, + title = {Collections Framework}, + journal = {Archive of Formal Proofs}, + month = nov, + year = 2009, + note = {\url{https://isa-afp.org/entries/Collections.html}, + Formal proof development}, +} diff --git a/thys/Gale_Shapley/document/root.tex b/thys/Gale_Shapley/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Gale_Shapley/document/root.tex @@ -0,0 +1,59 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[T1]{fontenc} +\usepackage{isabelle,isabellesym} +\usepackage{amssymb} +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + + +\begin{document} + +\title{Gale-Shapley Algorithm} +\author{Tobias Nipkow\\Department of Informatics\\Technical University of Munich} +\maketitle + +\begin{abstract} + This is a stepwise refinement and proof of the Gale-Shapley stable + matching (or marriage) algorithm down to executable code. Both a + purely functional implementation based on lists and a + functional implementation based on efficient arrays (provided + by the Collections entry in the AFP) are developed. The latter + implementation runs in time $O(n^2)$ where $n$ is the cardinality of + the two sets to be matched. +\end{abstract} + +\section{Introduction} + +The Gale-Shapley algorithm \cite{GaleS62,GusfieldI89} for stable +matchings (or marriages) matches two sets of the same cardinality $n$, +where each element has a complete list of preferences (a linear order) +of the elements of the other set. + +The refinement process is carried out largely on the level of a simple +imperative language. In every refinement step the whole algorithm is +stated and proved. Most of the proof is abstrtacted into general +lemmas that are used in multiple proofs. Except for one bigger step, +each algorithm proof is obtained from the previous one by incremental changes. +In the end, two executable functional algorithms are obtained: +a purely functional one based on lists and a functional one based on a +persistent imperative implementation of arrays (provided by the AFP entry +Collections Framework \cite{Collections-AFP} based on \cite{Baker91} +(see also \cite{ConchonF07})). +The latter algorithm has linear complexity, i.e. $O(n^2)$. + +We prove that each of the algorithm computes a stable matching that is +optimal for one of the two sets. + +\newpage + +% include generated text of all theories +\input{session} + +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} diff --git a/thys/Hyperdual/AnalyticTestFunction.thy b/thys/Hyperdual/AnalyticTestFunction.thy new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/AnalyticTestFunction.thy @@ -0,0 +1,441 @@ +(* Title: AnalyticTestFunction.thy + Authors: Filip Smola and Jacques D. Fleuriot, University of Edinburgh, 2019-2021 +*) + +theory AnalyticTestFunction + imports HyperdualFunctionExtension "HOL-Decision_Procs.Approximation" +begin + +subsection\<open>Analytic Test Function\<close> +text\<open> + We investigate the analytic test function used by Fike and Alonso in their + 2011 paper~@{cite "fike_alonso-2011"} as a relatively non-trivial example. + The function is defined as: @{term "\<lambda>x. exp x / (sqrt (sin x ^ 3 + cos x ^ 3))"}. +\<close> +definition fa_test :: "real \<Rightarrow> real" + where "fa_test x = exp x / (sqrt (sin x ^ 3 + cos x ^ 3))" + +text\<open> + We define the same composition of functions but using the relevant hyperdual versions. + Note that we implicitly use the facts that hyperdual extensions of plus, times and inverse are the + same operations on hyperduals. +\<close> +definition hyp_fa_test :: "real hyperdual \<Rightarrow> real hyperdual" + where "hyp_fa_test x = ((*h* exp) x) / ((*h* sqrt) (((*h* sin) x) ^ 3 + ((*h* cos) x) ^ 3))" + +text\<open>We prove lemmas useful to show when this function is well defined.\<close> +lemma sin_cube_plus_cos_cube: + "sin x ^ 3 + cos x ^ 3 = 1/2 * (sin x + cos x) * (2 - sin (2 * x))" + for x :: "'a::{real_normed_field,banach}" +proof - + have "sin x ^ 3 + cos x ^ 3 = (sin x + cos x) * (cos x ^ 2 - cos x * sin x + sin x ^ 2)" + by (smt (z3) add.commute combine_common_factor diff_add_cancel distrib_left + mult.commute mult.left_commute power2_eq_square power3_eq_cube) + also have "\<dots> = (sin x + cos x) * (1 - cos x * sin x)" + by simp + finally show ?thesis + by (smt (z3) mult.commute mult.left_neutral mult_2 nonzero_mult_div_cancel_left + right_diff_distrib' sin_add times_divide_eq_left zero_neq_numeral) +qed + +lemma sin_cube_plus_cos_cube_gt_zero_iff: + "(sin x ^ 3 + cos x ^ 3 > 0) = (sin x + cos x > 0)" + for x ::real + by (smt (verit, best) cos_zero power3_eq_cube power_zero_numeral sin_cube_plus_cos_cube + sin_le_one sin_zero zero_less_mult_iff) + +lemma sin_plus_cos_eq_45: + "sin x + cos x = sqrt 2 * sin (x + pi/4)" + apply (simp add: sin_add sin_45 cos_45 ) + by (simp add: field_simps) + +lemma sin_cube_plus_cos_cube_gt_zero_iff': + "(sin x ^ 3 + cos x ^ 3 > 0) = (sin (x + pi/4) > 0)" + by (smt (verit, best) mult_pos_pos real_sqrt_gt_0_iff + sin_cube_plus_cos_cube_gt_zero_iff sin_plus_cos_eq_45 zero_less_mult_pos) + +lemma sin_less_zero_pi: + "\<lbrakk>- pi < x; x < 0\<rbrakk> \<Longrightarrow> sin x < 0" + by (metis add.inverse_inverse add.inverse_neutral neg_less_iff_less sin_gt_zero sin_minus) + +lemma sin_45_positive_intervals: + "(sin (x + pi/4) > 0) = (x \<in> (\<Union>n::int. {-pi/4 + 2*pi*n <..< 3*pi/4 + 2*pi*n}))" +proof (standard ; (elim UnionE rangeE | -)) + obtain y :: real and n :: int + where "x = y + 2*pi*n" and "- pi \<le> y" and "y \<le> pi" + using sincos_principal_value sin_cos_eq_iff less_eq_real_def by metis + note yn = this + + assume "0 < sin (x + pi / 4)" + then have a: "0 < sin (y + pi / 4)" + using yn by (metis sin_add sin_cos_eq_iff) + then have "y \<in> {- pi / 4<..<3 * pi / 4}" + proof (unfold greaterThanLessThan_iff, safe) + show "- pi / 4 < y" + proof (rule ccontr) + assume "\<not> - pi / 4 < y" + then have "y < - pi / 4 \<or> y = - pi / 4" + by (simp add: not_less le_less) + then show False + using a sin_less_zero_pi[where x = "y + pi/4"] yn sin_zero + by force + qed + show "y < 3 * pi / 4" + proof (rule ccontr) + assume "\<not> y < 3 * pi / 4" + then have "pi \<le> y + pi/4" + by (simp add: not_less) + then show False + using a sin_le_zero yn pi_ge_two by fastforce + qed + qed + then have "x \<in> {- pi / 4 + 2*pi*n<..<3 * pi / 4 + 2*pi*n}" + using yn greaterThanLessThan_iff by simp + then show "x \<in> (\<Union>n::int. {- pi / 4 + 2*pi*n<..<3 * pi / 4 + 2*pi*n})" + by blast +next + fix X and n :: int + assume "x \<in> X" + and "X = {- pi / 4 + 2*pi*n<..<3 * pi / 4 + 2*pi*n}" + then have "x \<in> {- pi / 4 + 2*pi*n<..<3 * pi / 4 + 2*pi*n}" + by simp + then obtain y :: real and n :: int + where "x = y + 2*pi*n" and "- pi / 4 < y" and "y < 3 * pi / 4" + by (smt (z3) greaterThanLessThan_iff) + note yn = this + + have "0 < sin (y + pi / 4)" + using sin_gt_zero yn by force + then show "0 < sin (x + pi / 4)" + using yn sin_cos_eq_iff[of "x + pi / 4" "y + pi / 4"] by simp +qed + +text\<open>When the function is well defined our hyperdual definition is equal to the hyperdual extension.\<close> +lemma hypext_fa_test: + assumes "Base x \<in> (\<Union>n::int. {-pi/4 + 2*pi*n <..< 3*pi/4 + 2*pi*n})" + shows "(*h* fa_test) x = hyp_fa_test x" +proof - + have inverse_sqrt_valid: "0 < sin (Base x) ^ 3 + cos (Base x) ^ 3" + using assms sin_45_positive_intervals sin_cube_plus_cos_cube_gt_zero_iff' by force + + have "\<And>f. (\<lambda>x. (sin x) ^ 3) twice_field_differentiable_at Base x" + and "\<And>f. (\<lambda>x. (cos x) ^ 3) twice_field_differentiable_at Base x" + by (simp_all add: twice_field_differentiable_at_compose[OF _ twice_field_differentiable_at_power]) + then have "(*h* (\<lambda>x. sin x ^ 3 + cos x ^ 3)) x = (*h* sin) x ^ 3 + (*h* cos) x ^ 3" + and d_sincos: "(\<lambda>x. sin x ^ 3 + cos x ^ 3) twice_field_differentiable_at Base x" + using hypext_fun_add[of "\<lambda>x. sin x ^ 3" x "\<lambda>x. cos x ^ 3"] + by (simp_all add: hypext_fun_power twice_field_differentiable_at_add) + then have "(*h* (\<lambda>x. sqrt (sin x ^ 3 + cos x ^ 3))) x = (*h* sqrt) ((*h* sin) x ^ 3 + (*h* cos) x ^ 3)" + using inverse_sqrt_valid hypext_compose[of "\<lambda>x. sin x ^ 3 + cos x ^ 3" x] by simp + moreover have d_sqrt: "(\<lambda>x. sqrt (sin x ^ 3 + cos x ^ 3)) twice_field_differentiable_at Base x" + using inverse_sqrt_valid d_sincos twice_field_differentiable_at_compose twice_field_differentiable_at_sqrt + by blast + ultimately have "(*h* (\<lambda>x. inverse (sqrt (sin x ^ 3 + cos x ^ 3)))) x = inverse ((*h* sqrt) ((*h* sin) x ^ 3 + (*h* cos) x ^ 3))" + using inverse_sqrt_valid hypext_fun_inverse[of "\<lambda>x. sqrt (sin x ^ 3 + cos x ^ 3)" x] + by simp + moreover have "(\<lambda>x. inverse (sqrt (sin x ^ 3 + cos x ^ 3))) twice_field_differentiable_at Base x" + using inverse_sqrt_valid d_sqrt real_sqrt_eq_zero_cancel_iff + twice_field_differentiable_at_compose twice_field_differentiable_at_inverse + less_numeral_extra(3) + by force + ultimately have + "(*h* (\<lambda>x. exp x * inverse (sqrt (sin x ^ 3 + cos x ^ 3)))) x = + (*h* exp) x * inverse ((*h* sqrt) ((*h* sin) x ^ 3 + (*h* cos) x ^ 3))" + by (simp add: hypext_fun_mult) + then have + "(*h* (\<lambda>x. exp x / sqrt (sin x ^ 3 + cos x ^ 3))) x = + (*h* exp) x / (*h* sqrt) ((*h* sin) x ^ 3 + (*h* cos) x ^ 3)" + by (simp add: inverse_eq_divide hyp_divide_inverse) + then show ?thesis + unfolding fa_test_def hyp_fa_test_def . +qed + +text\<open> + We can show that our hyperdual extension gives (approximately) the same values as those found by + Fike and Alonso when evaluated at @{term "1.5"}. +\<close> +lemma + assumes "x = hyp_fa_test (\<beta> 1.5)" + shows "\<bar>Base x - 4.4978\<bar> \<le> 0.00005" + and "\<bar>Eps1 x - 4.0534\<bar> \<le> 0.00005" + and "\<bar>Eps12 x - 9.4631\<bar> \<le> 0.00005" +proof - + show "\<bar>Base x - 4.4978\<bar> \<le> 0.00005" + by (simp add: assms hyp_fa_test_def, approximation 20) + have d: "0 < sin (3/2 :: real) ^ 3 + cos (3/2 :: real) ^ 3" + using sin_cube_plus_cos_cube_gt_zero_iff' sin_gt_zero pos_add_strict pi_gt3 by force + show "\<bar>Eps1 x - 4.0534\<bar> \<le> 0.00005" + by (simp add: assms hyp_fa_test_def d, approximation 22) + show "\<bar>Eps12 x - 9.4631\<bar> \<le> 0.00005" + by (simp add: assms hyp_fa_test_def d, approximation 24) +qed + +text\<open>A number of additional lemmas that will be required to prove the derivatives:\<close> +lemma hypext_sqrt_hyperdual_parts: + "a > 0 \<Longrightarrow> (*h* sqrt) (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = + sqrt a *\<^sub>H ba + (b * inverse (sqrt a) / 2) *\<^sub>H e1 + (c * inverse (sqrt a) / 2) *\<^sub>H e2 + + (d * inverse (sqrt a) / 2 - b * c * inverse (sqrt a ^ 3) / 4) *\<^sub>H e12" + by (metis Hyperdual_eq hypext_sqrt_Hyperdual) + +lemma cos_multiple: "cos (n * x) = 2 * cos x * cos ((n - 1) * x) - cos ((n - 2) * x)" + for x :: "'a :: {banach,real_normed_field}" +proof - + have "cos ((n - 1) * x + x) + cos ((n - 1) * x - x) = 2 * cos ((n - 1) * x) * cos x" + by (simp add: cos_add cos_diff) + then show ?thesis + by (simp add: left_diff_distrib' eq_diff_eq) +qed + +lemma sin_multiple: "sin (n * x) = 2 * cos x * sin ((n - 1) * x) - sin ((n - 2) * x)" + for x :: "'a :: {banach,real_normed_field}" +proof - + have "sin ((n - 1) * x + x) + sin ((n - 1) * x - x) = 2 * cos x * sin ((n - 1) * x)" + by (simp add: sin_add sin_diff) + then show ?thesis + by (simp add: left_diff_distrib' eq_diff_eq) +qed + +lemma power5: + fixes z :: "'a :: monoid_mult" + shows "z ^ 5 = z * z * z * z * z" + by (simp add: mult.assoc power2_eq_square power_numeral_odd) + +lemma power6: + fixes z :: "'a :: monoid_mult" + shows "z ^ 6 = z * z * z * z * z * z" + by (simp add: mult.assoc power3_eq_cube power_numeral_even) + +text\<open> + We find the derivatives of @{const fa_test} by applying a Wengert list approach, as done by Fike + and Alonso, to make the same composition but in hyperduals. + We know that this is equal to the hyperdual extension which in turn gives us the derivatives. +\<close> +lemma Wengert_autodiff_fa_test: + assumes "x \<in> (\<Union>n::int. {-pi/4 + 2*pi*n <..< 3*pi/4 + 2*pi*n})" + shows "First (autodiff fa_test x) = + (exp x * (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x))) / + (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)" + and "Second (autodiff fa_test x) = + (exp x * (130 - 12 * cos (2 * x) + + 30 * cos (4 * x) + 12 * cos (6 * x) - + 111 * sin (2 * x) + + 48 * sin (4 * x) + 5 * sin (6 * x))) / + (64 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)" +proof - + have s3_c3_gt_zero: "(sin x) ^ 3 + (cos x) ^ 3 > 0" + using assms sin_45_positive_intervals sin_cube_plus_cos_cube_gt_zero_iff' sin_gt_zero + by force + \<comment> \<open>Work out @{const hyp_fa_test} as Wengert list of basic operations\<close> + let ?w0 = "\<beta> x" + have w0: "?w0 = x *\<^sub>H ba + 1 *\<^sub>H e1 + 1 *\<^sub>H e2 + 0 *\<^sub>H e12" + by (simp add: Hyperdual_eq hyperdualx_def) + + let ?w1 = "(*h* exp) ?w0" + have w1: "?w1 = exp x *\<^sub>H ba + exp x *\<^sub>H e1 + exp x *\<^sub>H e2 + exp x *\<^sub>H e12" + using hypext_exp_extract by blast + + let ?w2 = "(*h* sin) ?w0" + have w2: "?w2 = sin x *\<^sub>H ba + cos x *\<^sub>H e1 + cos x *\<^sub>H e2 + - sin x *\<^sub>H e12" + by (simp add: hypext_sin_extract of_comp_minus scaleH_times) + + let ?w3 = "(*h* (\<lambda>x. x ^ 3)) ?w2" + have w3: "?w3 = (sin x) ^ 3 *\<^sub>H ba + (3 * cos x * (sin x)\<^sup>2) *\<^sub>H e1 + (3 * cos x * (sin x)\<^sup>2) *\<^sub>H e2 + - (3/4 * (sin x - 3 * sin (3 * x))) *\<^sub>H e12" + by (simp add: w2 hypext_power_Hyperdual_parts power2_eq_square cos_times_cos sin_times_sin + sin_times_cos distrib_left right_diff_distrib' divide_simps) + + let ?w4 = "(*h* cos) ?w0" + have w4: "?w4 = cos x *\<^sub>H ba + - sin x *\<^sub>H e1 + - sin x *\<^sub>H e2 + - cos x *\<^sub>H e12" + by (simp add: hypext_cos_extract of_comp_minus scaleH_times) + + let ?w5 = "(*h* (\<lambda>x. x ^ 3)) ?w4" + have w5: "?w5 = (cos x) ^ 3 *\<^sub>H ba + - (3 * sin x * (cos x)\<^sup>2) *\<^sub>H e1 + - (3 * sin x * (cos x)\<^sup>2) *\<^sub>H e2 + - (3/4 * (cos x + 3 * cos (3 * x))) *\<^sub>H e12" + by (simp add: w4 hypext_power_Hyperdual_parts sin_times_sin right_diff_distrib' cos_times_cos + power2_eq_square distrib_left sin_times_cos divide_simps) + + let ?w6 = "?w3 + ?w5" + have sqrt_pos: "Base ?w6 > 0" + using s3_c3_gt_zero by auto + have w6: "?w6 = (sin x ^ 3 + cos x ^ 3) *\<^sub>H ba + + (3 * cos x * sin x * (sin x - cos x)) *\<^sub>H e1 + + (3 * cos x * sin x * (sin x - cos x)) *\<^sub>H e2 + + - (3/4 * (sin x + cos x + 3 * cos (3 * x) - 3 * sin (3 * x))) *\<^sub>H e12" + by (auto simp add: w3 w5 add_hyperdual_parts power2_eq_square right_diff_distrib' divide_simps) + + let ?w7 = "inverse ((*h* sqrt) ?w6)" + have w7: "?w7 = inverse(sqrt(sin x ^ 3 + cos x ^ 3)) *\<^sub>H ba + + - ((3 * cos x * sin x * (sin x - cos x))/(2 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e1 + + - ((3 * cos x * sin x * (sin x - cos x))/(2 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e2 + + ((3 * (30 + 2 * cos (4 * x) - 41 * sin (2 * x) + 3 * sin (6 * x)))/(64 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)) *\<^sub>H e12" + \<comment> \<open>Apply the functions in two steps, then simplify the result to match\<close> + proof - + let ?w7a = "(*h* sqrt) ?w6" + have w7a: "?w7a = + sqrt (sin x ^ 3 + cos x ^ 3) *\<^sub>H ba + + ((3 * (cos x * (sin x * (sin x - cos x)))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / 2) *\<^sub>H e1 + + ((3 * (cos x * (sin x * (sin x - cos x)))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / 2) *\<^sub>H e2 + + (- ((3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / 8) + + - 9 * (cos x * (sin x * ((sin x - cos x) * (cos x * (sin x * (sin x - cos x)))))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) / 4) *\<^sub>H e12" + unfolding w6 + using sqrt_pos by (simp add: hypext_sqrt_hyperdual_parts mult.assoc) + + let ?w7b = "inverse ?w7a" + have "?w7b = + (1 / sqrt (sin x ^ 3 + cos x ^ 3)) *\<^sub>H ba + + - (3 * (cos x * (sin x * (sin x - cos x))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / (2 * (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2)) *\<^sub>H e1 + + - (3 * (cos x * (sin x * (sin x - cos x))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / (2 * (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2)) *\<^sub>H e2 + + (9 * (cos x * (cos x * (sin x * (sin x * ((sin x - cos x) * ((sin x - cos x) * (inverse (sqrt (sin x ^ 3 + cos x ^ 3)) * inverse (sqrt (sin x ^ 3 + cos x ^ 3))))))))) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) - + (- ((3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) / 8) - + 9 * (cos x * (sin x * ((sin x - cos x) * (cos x * (sin x * (sin x - cos x)))))) * inverse (sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) / 4) / + (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2) *\<^sub>H e12" + \<comment> \<open>Push the inverse in\<close> + by (simp add: w7a inverse_hyperdual_parts) + then have w7b: "?w7b = + (inverse (sqrt (sin x ^ 3 + cos x ^ 3))) *\<^sub>H ba + + - (3 * cos x * sin x * (sin x - cos x) / (2 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e1 + + - (3 * cos x * sin x * (sin x - cos x) / (2 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e2 + + (9 * cos x * cos x * sin x * sin x * ((sin x - cos x) * (sin x - cos x) / ((sqrt (sin x ^ 3 + cos x ^ 3)) ^ 2)) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) - + (- ((3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3))) - + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) + / (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2) *\<^sub>H e12" + \<comment> \<open>Simplify powers and parents\<close> + by (simp add: power2_eq_square power3_eq_cube field_simps) + + have + "9 * cos x * cos x * sin x * sin x * ((sin x - cos x) * (sin x - cos x)) / ((sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2 * (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) - + (- ((3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3))) - + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) / + (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2 = + (90 + 6 * cos (4 * x) - 123 * sin (2 * x) + 9 * sin (6 * x)) / (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5)" + \<comment> \<open>Equate the last component's coefficients\<close> + proof - + have + "9 * cos x * cos x * sin x * sin x * ((sin x - cos x) * (sin x - cos x)) / ((sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2 * (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) - + (- ((3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3))) - + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) / + (sqrt (sin x ^ 3 + cos x ^ 3))\<^sup>2 = + 9 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) + + ( (3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3)) + + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)) / + (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 2" + by (simp add: divide_simps) + also have "... = + 9 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) + + ( (3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3) + + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 2))" + by (simp add: add_divide_distrib power2_eq_square power3_eq_cube mult.commute mult.left_commute) + also have "... = + 9 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) + + ( (3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3) + + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5))" + by (simp add: mult.commute mult.left_commute) + also have "... = + 9 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) + + ( (3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) * (sin x ^ 3 + cos x ^ 3) / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5) + + 9 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x) / (4 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5))" + proof - + have "(sin x ^ 3 + cos x ^ 3) * inverse ((sqrt (sin x ^ 3 + cos x ^ 3)) ^ 2) = 1" + using s3_c3_gt_zero by auto + then have + "1 / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3) = + (sin x ^ 3 + cos x ^ 3) / ((sqrt (sin x ^ 3 + cos x ^ 3)) ^ 2) / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)" + by (simp add: field_simps) + then have + "1 / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3) = + (sin x ^ 3 + cos x ^ 3) / (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)" + by auto + then show ?thesis + by (metis (mono_tags, lifting) divide_real_def inverse_eq_divide times_divide_eq_right) + qed + also have "... = + ( 288 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) + + (3 * sin x + 3 * cos x + 9 * cos (3 * x) - 9 * sin (3 * x)) * (sin x ^ 3 + cos x ^ 3) * 8 + + 144 * cos x * sin x * (sin x - cos x) * cos x * sin x * (sin x - cos x)) + / (64 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)" + by (simp add: divide_simps) + also have "... = + ( 432 * cos x * cos x * sin x * sin x * (sin x - cos x) * (sin x - cos x) + + (24 * sin x + 24 * cos x + 72 * cos (3 * x) - 72 * sin (3 * x)) * (sin x ^ 3 + cos x ^ 3)) + / (64 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)" + by (simp add: divide_simps) + finally show ?thesis + \<comment> \<open>Having matched the denominators, prove the numerators equal\<close> + by (simp, force intro: disjI2 simp add: power2_eq_square power4_eq_xxxx power3_eq_cube cos_times_sin + sin_times_cos cos_times_cos sin_times_sin right_diff_distrib power6 power5 + distrib_left distrib_right left_diff_distrib divide_simps) + qed + then show ?thesis + \<comment> \<open>Put it all together\<close> + by (simp add: w7b) + qed + + let ?w8 = "?w1 * ?w7" + have w8: "?w8 = + ((exp x)/(sqrt(sin x ^ 3 + cos x ^ 3))) *\<^sub>H ba + + ((exp x * (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x)))/(8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e1 + + ((exp x * (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x)))/(8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)) *\<^sub>H e2 + + ((exp x * (130 - 12 * cos (2 * x) + 30 * cos (4 * x) + 12 * cos (6 * x) - 111 * sin (2 * x) + 48 * sin (4 * x) + + 5 * sin (6 * x)))/(64 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 5)) *\<^sub>H e12" + proof (auto simp add: w7 w1 times_hyperdual_parts) + show "exp x * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) = exp x / sqrt (sin x ^ 3 + cos x ^ 3)" + by (simp add: divide_inverse) + + have sqrt_sc3: "sqrt (sin x ^ 3 + cos x ^ 3) ^ 3 = (sin x ^ 3 + cos x ^ 3) * sqrt (sin x ^ 3 + cos x ^ 3)" + using s3_c3_gt_zero + by (simp add: power3_eq_cube) + then have "inverse (sqrt (sin x ^ 3 + cos x ^ 3)) - + (3 * cos x * sin x * (sin x - cos x)) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) = + (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)" + using sqrt_pos + apply (simp add: right_diff_distrib' sin_times_sin cos_times_cos sin_times_cos cos_times_sin power3_eq_cube left_diff_distrib' divide_simps) + by (simp add: distrib_right cos_times_cos) + then show " exp x * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) - + exp x * (3 * cos x * sin x * (sin x - cos x)) / (2 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3) = + exp x * (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x)) / (8 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 3)" + by (simp add: algebra_simps) + + have "sqrt (sin x ^ 3 + cos x ^ 3) ^ 8 = (sin x ^ 3 + cos x ^ 3) ^ 4" + using s3_c3_gt_zero + by (smt mult_2 numeral_Bit0 power2_eq_square power_even_eq real_sqrt_mult_self) + moreover have "sqrt (sin x ^ 3 + cos x ^ 3) ^ 5 = (sin x ^ 3 + cos x ^ 3) ^ 2 * sqrt (sin x ^ 3 + cos x ^ 3)" + by (simp add: mult.assoc power2_eq_square power5) + ultimately + have "(90 + 6 * cos (4 * x) - 123 * sin (2 * x) + 9 * sin (6 * x)) / (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) - + 3 * (cos x * ((sin x * (sin x - cos x)))) / sqrt (sin x ^ 3 + cos x ^ 3) ^ 3 + + inverse (sqrt (sin x ^ 3 + cos x ^ 3)) = + (130 - 12 * cos (2 * x) + 30 * cos (4 * x) + 12 * cos (6 * x) - 111 * sin (2 * x) + 48 * sin (4 * x) + 5 * sin (6 * x)) / + (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5)" + using sqrt_pos + apply (simp add: sqrt_sc3 power2_eq_square divide_simps) + by (simp add: distrib_right distrib_left power3_eq_cube sin_times_sin sin_times_cos + cos_times_cos cos_times_sin right_diff_distrib' left_diff_distrib' divide_simps) + moreover have "\<forall>r a b c. (a::real) * b - c * (a * r) = a * (b - c * r)" + by (simp add: right_diff_distrib) + ultimately show "exp x * (90 + 6 * cos (4 * x) - 123 * sin (2 * x) + 9 * sin (6 * x)) / (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5) - + 3 * (cos x * (exp x * (sin x * (sin x - cos x)))) / sqrt (sin x ^ 3 + cos x ^ 3) ^ 3 + + exp x * inverse (sqrt (sin x ^ 3 + cos x ^ 3)) = + exp x * + (130 - 12 * cos (2 * x) + 30 * cos (4 * x) + 12 * cos (6 * x) - 111 * sin (2 * x) + 48 * sin (4 * x) + 5 * sin (6 * x)) / + (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5)" + by (metis (mono_tags, opaque_lifting) distrib_left mult.left_commute times_divide_eq_right) + qed + + \<comment> \<open>Check that we have indeed computed the hyperdual extension of our analytic test function \<close> + moreover have w8_eq_hyp_fa_test: "?w8 = (*h* fa_test) (\<beta> x)" + using assms + by (simp add: hyp_divide_inverse hyp_fa_test_def hypext_fa_test hypext_power) + + \<comment> \<open>Now simply show that "extraction" of first and second derivatives are as expected\<close> + ultimately + show "First (autodiff fa_test x) = + (exp x * (3 * cos x + 5 * cos (3 * x) + 9 * sin x + sin (3 * x))) / + (8 * (sqrt (sin x ^ 3 + cos x ^ 3)) ^ 3)" + and + "Second (autodiff fa_test x) = + exp x * (130 - 12 * cos (2 * x) + + 30 * cos (4 * x) + 12 * cos (6 * x) - + 111 * sin (2 * x) + 48 * sin (4 * x) + 5 * sin (6 * x)) / + (64 * sqrt (sin x ^ 3 + cos x ^ 3) ^ 5)" + by (metis autodiff_sel hyperdual_comb_sel)+ +qed + +end diff --git a/thys/Hyperdual/Hyperdual.thy b/thys/Hyperdual/Hyperdual.thy new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/Hyperdual.thy @@ -0,0 +1,1454 @@ +(* Title: Hyperdual.thy + Authors: Filip Smola and Jacques D. Fleuriot, University of Edinburgh, 2019-2021 +*) + +theory Hyperdual + imports "HOL-Analysis.Analysis" +begin + +section\<open>Hyperdual Numbers\<close> +text\<open> + Let \<open>\<tau>\<close> be some type. + Second-order hyperdual numbers over \<open>\<tau>\<close> take the form \<open>a\<^sub>1 + a\<^sub>2\<epsilon>\<^sub>1 + a\<^sub>3\<epsilon>\<^sub>2 + a\<^sub>4\<epsilon>\<^sub>1\<epsilon>\<^sub>2\<close> where all + \<open>a\<^sub>i :: \<tau>\<close>, and \<open>\<epsilon>\<^sub>1\<close> and \<open>\<epsilon>\<^sub>2\<close> are non-zero but nilpotent infinitesimals: \<open>\<epsilon>\<^sub>1\<^sup>2 = \<epsilon>\<^sub>2\<^sup>2 = (\<epsilon>\<^sub>1\<epsilon>\<^sub>2)\<^sup>2 = 0\<close>. + + We define second-order hyperdual numbers as a coinductive data type with four components: the base + component, two first-order hyperdual components and one second-order hyperdual component. +\<close> +codatatype 'a hyperdual = Hyperdual (Base: 'a) (Eps1: 'a) (Eps2: 'a) (Eps12: 'a) + +text\<open>Two hyperduals are equal iff all their components are equal.\<close> +lemma hyperdual_eq_iff [iff]: + "x = y \<longleftrightarrow> ((Base x = Base y) \<and> (Eps1 x = Eps1 y) \<and> (Eps2 x = Eps2 y) \<and> (Eps12 x = Eps12 y))" + using hyperdual.expand by auto + +lemma hyperdual_eqI: + assumes "Base x = Base y" + and "Eps1 x = Eps1 y" + and "Eps2 x = Eps2 y" + and "Eps12 x = Eps12 y" + shows "x = y" + by (simp add: assms) + +text\<open> + The embedding from the component type to hyperduals requires the component type to have a zero + element. +\<close> +definition of_comp :: "('a :: zero) \<Rightarrow> 'a hyperdual" + where "of_comp a = Hyperdual a 0 0 0" + +lemma of_comp_simps [simp]: + "Base (of_comp a) = a" + "Eps1 (of_comp a) = 0" + "Eps2 (of_comp a) = 0" + "Eps12 (of_comp a) = 0" + by (simp_all add: of_comp_def) + +subsection \<open>Addition and Subtraction\<close> + +text\<open>We define hyperdual addition, subtraction and unary minus pointwise, and zero by embedding.\<close> +(* Define addition using component addition *) +instantiation hyperdual :: (plus) plus +begin + +primcorec plus_hyperdual + where + "Base (x + y) = Base x + Base y" + | "Eps1 (x + y) = Eps1 x + Eps1 y" + | "Eps2 (x + y) = Eps2 x + Eps2 y" + | "Eps12 (x + y) = Eps12 x + Eps12 y" + +instance by standard +end + +(* Define zero by embedding component zero *) +instantiation hyperdual :: (zero) zero +begin + +definition zero_hyperdual + where "0 = of_comp 0" + +instance by standard +end + +lemma zero_hyperdual_simps [simp]: + "Base 0 = 0" + "Eps1 0 = 0" + "Eps2 0 = 0" + "Eps12 0 = 0" + "Hyperdual 0 0 0 0 = 0" + by (simp_all add: zero_hyperdual_def) + +(* Define minus using component minus *) +instantiation hyperdual :: (uminus) uminus +begin + +primcorec uminus_hyperdual + where + "Base (-x) = - Base x" + | "Eps1 (-x) = - Eps1 x" + | "Eps2 (-x) = - Eps2 x" + | "Eps12 (-x) = - Eps12 x" + +instance by standard +end + +(* Define subtraction using component subtraction *) +instantiation hyperdual :: (minus) minus +begin + +primcorec minus_hyperdual + where + "Base (x - y) = Base x - Base y" + | "Eps1 (x - y) = Eps1 x - Eps1 y" + | "Eps2 (x - y) = Eps2 x - Eps2 y" + | "Eps12 (x - y) = Eps12 x - Eps12 y" + +instance by standard +end + +text\<open>If the components form a commutative group under addition then so do the hyperduals.\<close> +instance hyperdual :: (semigroup_add) semigroup_add + by standard (simp add: add.assoc) + +instance hyperdual :: (monoid_add) monoid_add + by standard simp_all + +instance hyperdual :: (ab_semigroup_add) ab_semigroup_add + by standard (simp_all add: add.commute) + +instance hyperdual :: (comm_monoid_add) comm_monoid_add + by standard simp + +instance hyperdual :: (group_add) group_add + by standard simp_all + +instance hyperdual :: (ab_group_add) ab_group_add + by standard simp_all + +lemma of_comp_add: + fixes a b :: "'a :: monoid_add" + shows "of_comp (a + b) = of_comp a + of_comp b" + by simp + +lemma + fixes a b :: "'a :: group_add" + shows of_comp_minus: "of_comp (- a) = - of_comp a" + and of_comp_diff: "of_comp (a - b) = of_comp a - of_comp b" + by simp_all + +subsection \<open>Multiplication and Scaling\<close> + +text\<open> + Multiplication of hyperduals is defined by distributing the expressions and using the nilpotence + of \<open>\<epsilon>\<^sub>1\<close> and \<open>\<epsilon>\<^sub>2\<close>, resulting in the definition used here. + The hyperdual one is again defined by embedding. +\<close> +(* Define one by embedding the component one, which also requires it to have zero *) +instantiation hyperdual :: ("{one, zero}") one +begin + +definition one_hyperdual + where "1 = of_comp 1" + +instance by standard +end + +lemma one_hyperdual_simps [simp]: + "Base 1 = 1" + "Eps1 1 = 0" + "Eps2 1 = 0" + "Eps12 1 = 0" + "Hyperdual 1 0 0 0 = 1" + by (simp_all add: one_hyperdual_def) + +(* Define multiplication using component multiplication and addition *) +instantiation hyperdual :: ("{times, plus}") times +begin + +primcorec times_hyperdual + where + "Base (x * y) = Base x * Base y" + | "Eps1 (x * y) = (Base x * Eps1 y) + (Eps1 x * Base y)" + | "Eps2 (x * y) = (Base x * Eps2 y) + (Eps2 x * Base y)" + | "Eps12 (x * y) = (Base x * Eps12 y) + (Eps1 x * Eps2 y) + (Eps2 x * Eps1 y) + (Eps12 x * Base y)" + +instance by standard +end + +text\<open>If the components form a ring then so do the hyperduals.\<close> +instance hyperdual :: (semiring) semiring + by standard (simp_all add: mult.assoc distrib_left distrib_right add.assoc add.left_commute) + +instance hyperdual :: ("{monoid_add, mult_zero}") mult_zero + by standard simp_all + +instance hyperdual :: (ring) ring + by standard + +instance hyperdual :: (comm_ring) comm_ring + by standard (simp_all add: mult.commute distrib_left) + +instance hyperdual :: (ring_1) ring_1 + by standard simp_all + +instance hyperdual :: (comm_ring_1) comm_ring_1 + by standard simp + +lemma of_comp_times: + fixes a b :: "'a :: semiring_0" + shows "of_comp (a * b) = of_comp a * of_comp b" + by (simp add: of_comp_def times_hyperdual.code) + +text\<open>Hyperdual scaling is multiplying each component by a factor from the component type.\<close> +(* Named scaleH for hyperdual like scaleR is for real *) +primcorec scaleH :: "('a :: times) \<Rightarrow> 'a hyperdual \<Rightarrow> 'a hyperdual" (infixr "*\<^sub>H" 75) + where + "Base (f *\<^sub>H x) = f * Base x" + | "Eps1 (f *\<^sub>H x) = f * Eps1 x" + | "Eps2 (f *\<^sub>H x) = f * Eps2 x" + | "Eps12 (f *\<^sub>H x) = f * Eps12 x" + +lemma scaleH_times: + fixes f :: "'a :: {monoid_add, mult_zero}" + shows "f *\<^sub>H x = of_comp f * x" + by simp + +lemma scaleH_add: + fixes a :: "'a :: semiring" + shows "(a + a') *\<^sub>H b = a *\<^sub>H b + a' *\<^sub>H b" + and "a *\<^sub>H (b + b') = a *\<^sub>H b + a *\<^sub>H b'" + by (simp_all add: distrib_left distrib_right) + +lemma scaleH_diff: + fixes a :: "'a :: ring" + shows "(a - a') *\<^sub>H b = a *\<^sub>H b - a' *\<^sub>H b" + and "a *\<^sub>H (b - b') = a *\<^sub>H b - a *\<^sub>H b'" + by (auto simp add: left_diff_distrib right_diff_distrib scaleH_times of_comp_diff) + +lemma scaleH_mult: + fixes a :: "'a :: semigroup_mult" + shows "(a * a') *\<^sub>H b = a *\<^sub>H a' *\<^sub>H b" + by (simp add: mult.assoc) + +lemma scaleH_one [simp]: + fixes b :: "('a :: monoid_mult) hyperdual" + shows "1 *\<^sub>H b = b" + by simp + +lemma scaleH_zero [simp]: + fixes b :: "('a :: {mult_zero, times}) hyperdual" + shows "0 *\<^sub>H b = 0" + by simp + +lemma + fixes b :: "('a :: ring_1) hyperdual" + shows scaleH_minus [simp]:"- 1 *\<^sub>H b = - b" + and scaleH_minus_left: "- (a *\<^sub>H b) = - a *\<^sub>H b" + and scaleH_minus_right: "- (a *\<^sub>H b) = a *\<^sub>H - b" + by simp_all + +text\<open>Induction rule for natural numbers that takes 0 and 1 as base cases.\<close> +lemma nat_induct01Suc[case_names 0 1 Suc]: + assumes "P 0" + and "P 1" + and "\<And>n. n > 0 \<Longrightarrow> P n \<Longrightarrow> P (Suc n)" + shows "P n" + by (metis One_nat_def assms nat_induct neq0_conv) + +lemma hyperdual_power: + fixes x :: "('a :: comm_ring_1) hyperdual" + shows "x ^ n = Hyperdual ((Base x) ^ n) + (Eps1 x * of_nat n * (Base x) ^ (n - 1)) + (Eps2 x * of_nat n * (Base x) ^ (n - 1)) + (Eps12 x * of_nat n * (Base x) ^ (n - 1) + Eps1 x * Eps2 x * of_nat n * of_nat (n - 1) * (Base x) ^ (n - 2))" +proof (induction n rule: nat_induct01Suc) + case 0 + show ?case + by simp +next + case 1 + show ?case + by simp +next + case hyp: (Suc n) + show ?case + proof (simp add: hyp, intro conjI) + show "Base x * (Eps1 x * of_nat n * Base x ^ (n - Suc 0)) + Eps1 x * Base x ^ n = Eps1 x * (1 + of_nat n) * Base x ^ n" + and "Base x * (Eps2 x * of_nat n * Base x ^ (n - Suc 0)) + Eps2 x * Base x ^ n = Eps2 x * (1 + of_nat n) * Base x ^ n" + by (simp_all add: distrib_left distrib_right power_eq_if) + show + "2 * (Eps1 x * (Eps2 x * (of_nat n * Base x ^ (n - Suc 0)))) + + Base x * (Eps12 x * of_nat n * Base x ^ (n - Suc 0) + Eps1 x * Eps2 x * of_nat n * of_nat (n - Suc 0) * Base x ^ (n - 2)) + + Eps12 x * Base x ^ n = + Eps12 x * (1 + of_nat n) * Base x ^ n + Eps1 x * Eps2 x * (1 + of_nat n) * of_nat n * Base x ^ (n - Suc 0)" + proof - + have + "2 * (Eps1 x * (Eps2 x * (of_nat n * Base x ^ (n - Suc 0)))) + + Base x * (Eps12 x * of_nat n * Base x ^ (n - Suc 0) + Eps1 x * Eps2 x * of_nat n * of_nat (n - Suc 0) * Base x ^ (n - 2)) + + Eps12 x * Base x ^ n = + 2 * Eps1 x * Eps2 x * of_nat n * Base x ^ (n - Suc 0) + + Eps12 x * of_nat (n + 1) * Base x ^ n + Eps1 x * Eps2 x * of_nat n * of_nat (n - Suc 0) * Base x ^ (n - Suc 0)" + by (simp add: field_simps power_eq_if) + also have "... = Eps12 x * of_nat (n + 1) * Base x ^ n + of_nat (n - 1 + 2) * Eps1 x * Eps2 x * of_nat n * Base x ^ (n - Suc 0)" + by (simp add: distrib_left mult.commute) + finally show ?thesis + by (simp add: hyp.hyps) + qed + qed +qed + +lemma hyperdual_power_simps [simp]: + shows "Base ((x :: 'a :: comm_ring_1 hyperdual) ^ n) = Base x ^ n" + and "Eps1 ((x :: 'a :: comm_ring_1 hyperdual) ^ n) = Eps1 x * of_nat n * (Base x) ^ (n - 1)" + and "Eps2 ((x :: 'a :: comm_ring_1 hyperdual) ^ n) = Eps2 x * of_nat n * (Base x) ^ (n - 1)" + and "Eps12 ((x :: 'a :: comm_ring_1 hyperdual) ^ n) = + (Eps12 x * of_nat n * (Base x) ^ (n - 1) + Eps1 x * Eps2 x * of_nat n * of_nat (n - 1) * (Base x) ^ (n - 2))" + by (simp_all add: hyperdual_power) + +text\<open>Squaring the hyperdual one behaves as expected from the reals.\<close> +(* Commutativity required to reorder times definition expressions, division algebra required for + base component's x * x = 1 \<longrightarrow> x = 1 \<or> x = -1 *) +lemma hyperdual_square_eq_1_iff [iff]: + fixes x :: "('a :: {real_div_algebra, comm_ring}) hyperdual" + shows "x * x = 1 \<longleftrightarrow> x = 1 \<or> x = - 1" +proof + assume a: "x * x = 1" + + have base: "Base x * Base x = 1" + using a by simp + moreover have e1: "Eps1 x = 0" + proof - + have "Base x * Eps1 x = - (Base x * Eps1 x)" + using mult.commute[of "Base x"] add_eq_0_iff[of "Base x * Eps1 x"] times_hyperdual.simps(2)[of x x] + by (simp add: a) + then have "Base x * Base x * Eps1 x = - Base x * Base x * Eps1 x" + using mult_left_cancel[of "Base x"] base by fastforce + then show ?thesis + using base mult_right_cancel[of "Eps1 x" "Base x * Base x" "- Base x * Base x"] one_neq_neg_one + by auto + qed + moreover have e2: "Eps2 x = 0" + proof - + have "Base x * Eps2 x = - (Base x * Eps2 x)" + using a mult.commute[of "Base x" "Eps2 x"] add_eq_0_iff[of "Base x * Eps2 x"] times_hyperdual.simps(3)[of x x] + by simp + then have "Base x * Base x * Eps2 x = - Base x * Base x * Eps2 x" + using mult_left_cancel[of "Base x"] base by fastforce + then show ?thesis + using base mult_right_cancel[of "Eps2 x" "Base x * Base x" "- Base x * Base x"] one_neq_neg_one + by auto + qed + moreover have "Eps12 x = 0" + proof - + have "Base x * Eps12 x = - (Base x * Eps12 x)" + using a e1 e2 mult.commute[of "Base x" "Eps12 x"] add_eq_0_iff[of "Base x * Eps12 x"] times_hyperdual.simps(4)[of x x] + by simp + then have "Base x * Base x * Eps12 x = - Base x * Base x * Eps12 x" + using mult_left_cancel[of "Base x"] base by fastforce + then show ?thesis + using base mult_right_cancel[of "Eps12 x" "Base x * Base x" "- Base x * Base x"] one_neq_neg_one + by auto + qed + ultimately show "x = 1 \<or> x = - 1" + using square_eq_1_iff[of "Base x"] by simp +next + assume "x = 1 \<or> x = - 1" + then show "x * x = 1" + by (simp, safe, simp_all) +qed + +subsubsection\<open>Properties of Zero Divisors\<close> + +text\<open>Unlike the reals, hyperdual numbers may have non-trivial divisors of zero as we show below.\<close> + +text\<open> + First, if the components have no non-trivial zero divisors then that behaviour is preserved on the + base component. +\<close> +lemma divisors_base_zero: + fixes a b :: "('a :: ring_no_zero_divisors) hyperdual" + assumes "Base (a * b) = 0" + shows "Base a = 0 \<or> Base b = 0" + using assms by auto +lemma hyp_base_mult_eq_0_iff [iff]: + fixes a b :: "('a :: ring_no_zero_divisors) hyperdual" + shows "Base (a * b) = 0 \<longleftrightarrow> Base a = 0 \<or> Base b = 0" + by simp + +text\<open> + However, the conditions are relaxed on the full hyperdual numbers. + This is due to some terms vanishing in the multiplication and thus not constraining the result. +\<close> +lemma divisors_hyperdual_zero [iff]: + fixes a b :: "('a :: ring_no_zero_divisors) hyperdual" + shows "a * b = 0 \<longleftrightarrow> (a = 0 \<or> b = 0 \<or> (Base a = 0 \<and> Base b = 0 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b))" +proof + assume mult: "a * b = 0" + then have split: "Base a = 0 \<or> Base b = 0" + by simp + show "a = 0 \<or> b = 0 \<or> Base a = 0 \<and> Base b = 0 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b" + proof (cases "Base a = 0") + case aT: True + then show ?thesis + proof (cases "Base b = 0") + \<comment> \<open>@{term "Base a = 0 \<and> Base b = 0"}\<close> + case bT: True + then have "Eps12 (a * b) = Eps1 a * Eps2 b + Eps2 a * Eps1 b" + by (simp add: aT) + then show ?thesis + by (simp add: aT bT mult eq_neg_iff_add_eq_0) + next + \<comment> \<open>@{term "Base a = 0 \<and> Base b \<noteq> 0"}\<close> + case bF: False + then have e1: "Eps1 a = 0" + proof - + have "Eps1 (a * b) = Eps1 a * Base b" + by (simp add: aT) + then show ?thesis + by (simp add: bF mult) + qed + moreover have e2: "Eps2 a = 0" + proof - + have "Eps2 (a * b) = Eps2 a * Base b" + by (simp add: aT) + then show ?thesis + by (simp add: bF mult) + qed + moreover have "Eps12 a = 0" + proof - + have "Eps12 (a * b) = Eps1 a * Eps2 b + Eps2 a * Eps1 b" + by (simp add: e1 e2 mult) + then show ?thesis + by (simp add: aT bF) + qed + ultimately show ?thesis + by (simp add: aT) + qed + next + case aF: False + then show ?thesis + proof (cases "Base b = 0") + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b = 0"}\<close> + case bT: True + then have e1: "Eps1 b = 0" + proof - + have "Eps1 (a * b) = Base a * Eps1 b" + by (simp add: bT) + then show ?thesis + by (simp add: aF mult) + qed + moreover have e2: "Eps2 b = 0" + proof - + have "Eps2 (a * b) = Base a * Eps2 b" + by (simp add: bT) + then show ?thesis + by (simp add: aF mult) + qed + moreover have "Eps12 b = 0" + proof - + have "Eps12 (a * b) = Eps1 a * Eps2 b + Eps2 a * Eps1 b" + by (simp add: e1 e2 mult) + then show ?thesis + by (simp add: bT aF) + qed + ultimately show ?thesis + by (simp add: bT) + next + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b \<noteq> 0"}\<close> + case bF: False + then have "False" + using split aF by blast + then show ?thesis + by simp + qed + qed +next + show "a = 0 \<or> b = 0 \<or> Base a = 0 \<and> Base b = 0 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b \<Longrightarrow> a * b = 0" + by (simp, auto) +qed + +subsubsection\<open>Multiplication Cancellation\<close> + +text\<open> + Similarly to zero divisors, multiplication cancellation rules for hyperduals are not exactly the + same as those for reals. +\<close> + +text\<open> + First, cancelling a common factor has a relaxed condition compared to reals. + It only requires the common factor to have base component zero, instead of requiring the whole + number to be zero. +\<close> +lemma hyp_mult_left_cancel [iff]: + fixes a b c :: "('a :: ring_no_zero_divisors) hyperdual" + assumes baseC: "Base c \<noteq> 0" + shows "c * a = c * b \<longleftrightarrow> a = b" +proof + assume mult: "c * a = c * b" + show "a = b" + proof (simp, safe) + show base: "Base a = Base b" + using mult mult_cancel_left baseC by simp_all + show "Eps1 a = Eps1 b" + and "Eps2 a = Eps2 b" + using mult base mult_cancel_left baseC by simp_all + then show "Eps12 a = Eps12 b" + using mult base mult_cancel_left baseC by simp_all + qed +next + show "a = b \<Longrightarrow> c * a = c * b" + by simp +qed + +lemma hyp_mult_right_cancel [iff]: + fixes a b c :: "('a :: ring_no_zero_divisors) hyperdual" + assumes baseC: "Base c \<noteq> 0" + shows "a * c = b * c \<longleftrightarrow> a = b" +proof + assume mult: "a * c = b * c" + show "a = b" + proof (simp, safe) + show base: "Base a = Base b" + using mult mult_cancel_left baseC by simp_all + show "Eps1 a = Eps1 b" + and "Eps2 a = Eps2 b" + using mult base mult_cancel_left baseC by simp_all + then show "Eps12 a = Eps12 b" + using mult base mult_cancel_left baseC by simp_all + qed +next + show "a = b \<Longrightarrow> a * c = b * c" + by simp +qed + +text\<open> + Next, when a factor absorbs another there are again relaxed conditions compared to reals. + For reals, either the absorbing factor is zero or the absorbed is the unit. + However, with hyperduals there are more possibilities again due to terms vanishing during the + multiplication. +\<close> +lemma hyp_mult_cancel_right1 [iff]: + fixes a b :: "('a :: ring_1_no_zero_divisors) hyperdual" + shows "a = b * a \<longleftrightarrow> a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 b * Eps2 a = - Eps2 b * Eps1 a)" +proof + assume mult: "a = b * a" + show "a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 b * Eps2 a = - Eps2 b * Eps1 a)" + proof (cases "Base a = 0") + case aT: True + then show ?thesis + proof (cases "Base b = 1") + \<comment> \<open>@{term "Base a = 0 \<and> Base b = 1"}\<close> + case bT: True + then show ?thesis + using aT mult add_cancel_right_right add_eq_0_iff[of "Eps1 b * Eps2 a"] times_hyperdual.simps(4)[of b a] + by simp + next + \<comment> \<open>@{term "Base a = 0 \<and> Base b \<noteq> 1"}\<close> + case bF: False + then show ?thesis + using aT mult by (simp, auto) + qed + next + case aF: False + then show ?thesis + proof (cases "Base b = 1") + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b = 1"}\<close> + case bT: True + then show ?thesis + using aF mult by (simp, auto) + next + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b \<noteq> 1"}\<close> + case bF: False + then show ?thesis + using aF mult by simp + qed + qed +next + have "a = 0 \<Longrightarrow> a = b * a" + and "b = 1 \<Longrightarrow> a = b * a" + by simp_all + moreover have "Base a = 0 \<and> Base b = 1 \<and> Eps1 b * Eps2 a = - Eps2 b * Eps1 a \<Longrightarrow> a = b * a" + by simp + ultimately show "a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 b * Eps2 a = - Eps2 b * Eps1 a) \<Longrightarrow> a = b * a" + by blast +qed +lemma hyp_mult_cancel_right2 [iff]: + fixes a b :: "('a :: ring_1_no_zero_divisors) hyperdual" + shows "b * a = a \<longleftrightarrow> a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 b * Eps2 a = - Eps2 b * Eps1 a)" + using hyp_mult_cancel_right1 by smt + +lemma hyp_mult_cancel_left1 [iff]: + fixes a b :: "('a :: ring_1_no_zero_divisors) hyperdual" + shows "a = a * b \<longleftrightarrow> a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b)" +proof + assume mult: "a = a * b" + show "a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b)" + proof (cases "Base a = 0") + case aT: True + then show ?thesis + proof (cases "Base b = 1") + \<comment> \<open>@{term "Base a = 0 \<and> Base b = 1"}\<close> + case bT: True + then show ?thesis + using aT mult add_cancel_right_right add_eq_0_iff[of "Eps1 a * Eps2 b"] times_hyperdual.simps(4)[of a b] + by simp + next + \<comment> \<open>@{term "Base a = 0 \<and> Base b \<noteq> 1"}\<close> + case bF: False + then show ?thesis + using aT mult by (simp, auto) + qed + next + case aF: False + then show ?thesis + proof (cases "Base b = 1") + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b = 1"}\<close> + case bT: True + then show ?thesis + using aF mult by (simp, auto) + next + \<comment> \<open>@{term "Base a \<noteq> 0 \<and> Base b \<noteq> 1"}\<close> + case bF: False + then show ?thesis + using aF mult by simp + qed + qed +next + have "a = 0 \<Longrightarrow> a = a * b" + and "b = 1 \<Longrightarrow> a = a * b" + by simp_all + moreover have "Base a = 0 \<and> Base b = 1 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b \<Longrightarrow> a = a * b" + by simp + ultimately show "a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b) \<Longrightarrow> a = a * b" + by blast +qed +lemma hyp_mult_cancel_left2 [iff]: + fixes a b :: "('a :: ring_1_no_zero_divisors) hyperdual" + shows "a * b = a \<longleftrightarrow> a = 0 \<or> b = 1 \<or> (Base a = 0 \<and> Base b = 1 \<and> Eps1 a * Eps2 b = - Eps2 a * Eps1 b)" + using hyp_mult_cancel_left1 by smt + +subsection\<open>Multiplicative Inverse and Division\<close> + +text\<open> + If the components form a ring with a multiplicative inverse then so do the hyperduals. + The hyperdual inverse of @{term a} is defined as the solution to @{term "a * x = 1"}. + Hyperdual division is then multiplication by divisor's inverse. + + Each component of the inverse has as denominator a power of the base component. + Therefore this inverse is only well defined for hyperdual numbers with non-zero base components. +\<close> +instantiation hyperdual :: ("{inverse, ring_1}") inverse +begin + +primcorec inverse_hyperdual + where + "Base (inverse a) = 1 / Base a" + | "Eps1 (inverse a) = - Eps1 a / (Base a)^2" + | "Eps2 (inverse a) = - Eps2 a / (Base a)^2" + | "Eps12 (inverse a) = 2 * (Eps1 a * Eps2 a / (Base a)^3) - Eps12 a / (Base a)^2" + +primcorec divide_hyperdual + where + "Base (divide a b) = Base a / Base b" + | "Eps1 (divide a b) = (Eps1 a * Base b - Base a * Eps1 b) / ((Base b)^2)" + | "Eps2 (divide a b) = (Eps2 a * Base b - Base a * Eps2 b) / ((Base b)^2)" + | "Eps12 (divide a b) = (2 * Base a * Eps1 b * Eps2 b - + Base a * Base b * Eps12 b - + Eps1 a * Base b * Eps2 b - + Eps2 a * Base b * Eps1 b + + Eps12 a * ((Base b)^2)) / ((Base b)^3)" +instance + by standard +end + +text\<open> + Because hyperduals have non-trivial zero divisors, they do not form a division ring and so we + can't use the @{class division_ring} type class to establish properties of hyperdual division. + However, if the components form a division ring as well as a commutative ring, we can prove some + similar facts about hyperdual division inspired by @{class division_ring}. +\<close> + +text\<open>Inverse is multiplicative inverse from both sides.\<close> +lemma + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base a \<noteq> 0" + shows hyp_left_inverse [simp]: "inverse a * a = 1" + and hyp_right_inverse [simp]: "a * inverse a = 1" + by (simp_all add: assms power2_eq_square power3_eq_cube field_simps) + +text\<open>Division is multiplication by inverse.\<close> +lemma hyp_divide_inverse: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a / b = a * inverse b" + by (cases "Base b = 0" ; simp add: field_simps power2_eq_square power3_eq_cube) + +text\<open>Hyperdual inverse is zero when not well defined.\<close> +lemma zero_base_zero_inverse: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base a = 0" + shows "inverse a = 0" + by (simp add: assms) + +lemma zero_inverse_zero_base: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "inverse a = 0" + shows "Base a = 0" + using assms right_inverse hyp_left_inverse by force + +lemma hyp_inverse_zero: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(inverse a = 0) = (Base a = 0)" + using zero_base_zero_inverse[of a] zero_inverse_zero_base[of a] by blast + +text\<open>Inverse preserves invertibility.\<close> +lemma hyp_invertible_inverse: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(Base a = 0) = (Base (inverse a) = 0)" + by (safe, simp_all add: divide_inverse) + +text\<open>Inverse is the only number that satisfies the defining equation.\<close> +lemma hyp_inverse_unique: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "a * b = 1" + shows "b = inverse a" +proof - + have "Base a \<noteq> 0" + using assms one_hyperdual_def of_comp_simps zero_neq_one hyp_base_mult_eq_0_iff by smt + then show ?thesis + by (metis assms hyp_right_inverse mult.left_commute mult.right_neutral) +qed + +text\<open>Multiplicative inverse commutes with additive inverse.\<close> +lemma hyp_minus_inverse_comm: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "inverse (- a) = - inverse a" +proof (cases "Base a = 0") + case True + then show ?thesis + by (simp add: zero_base_zero_inverse) +next + case False + then show ?thesis + by (simp, simp add: nonzero_minus_divide_right) +qed + +text\<open> + Inverse is an involution (only) where well defined. + Counter-example for non-invertible is @{term "Hyperdual 0 0 0 0"} with inverse + @{term "Hyperdual 0 0 0 0"} which then inverts to @{term "Hyperdual 0 0 0 0"}. +\<close> +lemma hyp_inverse_involution: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base a \<noteq> 0" + shows "inverse (inverse a) = a" + by (metis assms hyp_inverse_unique hyp_right_inverse mult.commute) + +lemma inverse_inverse_neq_Ex: + "\<exists>a :: ('a :: {inverse, comm_ring_1, division_ring}) hyperdual . inverse (inverse a) \<noteq> a" +proof - + have "\<exists>a :: 'a hyperdual . Base a = 0 \<and> a \<noteq> 0" + by (metis (full_types) hyperdual.sel(1) hyperdual.sel(4) zero_neq_one) + moreover have "\<And>a :: 'a hyperdual . (Base a = 0 \<and> a \<noteq> 0) \<Longrightarrow> (inverse (inverse a) \<noteq> a)" + using hyp_inverse_zero hyp_invertible_inverse by smt + ultimately show ?thesis + by blast +qed + +text\<open> + Inverses of equal invertible numbers are equal. + This includes the other direction by inverse preserving invertibility and being an involution. + + From a different point of view, inverse is injective on invertible numbers. + The other direction for is again by inverse preserving invertibility and being an involution. +\<close> +lemma hyp_inverse_injection: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base a \<noteq> 0" + and "Base b \<noteq> 0" + shows "(inverse a = inverse b) = (a = b)" + by (metis assms hyp_inverse_involution) + +text\<open>One is its own inverse.\<close> +lemma hyp_inverse_1 [simp]: + "inverse (1 :: ('a :: {inverse, comm_ring_1, division_ring}) hyperdual) = 1" + using hyp_inverse_unique mult.left_neutral by metis + +text\<open>Inverse distributes over multiplication (even when not well defined).\<close> +lemma hyp_inverse_mult_distrib: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "inverse (a * b) = inverse b * inverse a" +proof (cases "Base a = 0 \<or> Base b = 0") + case True + then show ?thesis + by (metis hyp_base_mult_eq_0_iff mult_zero_left mult_zero_right zero_base_zero_inverse) +next + case False + then have "a * (b * inverse b) * inverse a = 1" + by simp + then have "a * b * (inverse b * inverse a) = 1" + by (simp only: mult.assoc) + thus ?thesis + using hyp_inverse_unique[of "a * b" "(inverse b * inverse a)"] by simp +qed + +text\<open>We derive expressions for addition and subtraction of inverses.\<close> +lemma hyp_inverse_add: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base a \<noteq> 0" + and "Base b \<noteq> 0" + shows "inverse a + inverse b = inverse a * (a + b) * inverse b" + by (simp add: assms distrib_left mult.commute semiring_normalization_rules(18) add.commute) + +lemma hyp_inverse_diff: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes a: "Base a \<noteq> 0" + and b: "Base b \<noteq> 0" + shows "inverse a - inverse b = inverse a * (b - a) * inverse b" +proof - + have x: "inverse a - inverse b = inverse b * (inverse a * b - 1)" + by (simp add: b mult.left_commute right_diff_distrib') + show ?thesis + by (simp add: x a mult.commute right_diff_distrib') +qed + +text\<open>Division is one only when dividing by self.\<close> +lemma hyp_divide_self: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base b \<noteq> 0" + shows "a / b = 1 \<longleftrightarrow> a = b" + by (metis assms hyp_divide_inverse hyp_inverse_unique hyp_right_inverse mult.commute) + +text\<open>Taking inverse is the same as division of one, even when not invertible.\<close> +lemma hyp_inverse_divide_1 [divide_simps]: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "inverse a = 1 / a" + by (simp add: hyp_divide_inverse) + +text\<open>Division distributes over addition and subtraction.\<close> +lemma hyp_add_divide_distrib: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(a + b) / c = a/c + b/c" + by (simp add: distrib_right hyp_divide_inverse) + +lemma hyp_diff_divide_distrib: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(a - b) / c = a / c - b / c" + by (simp add: left_diff_distrib hyp_divide_inverse) + +text\<open>Multiplication associates with division.\<close> +lemma hyp_times_divide_assoc [simp]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a * (b / c) = (a * b) / c" + by (simp add: hyp_divide_inverse mult.assoc) + +text\<open>Additive inverse commutes with division, because it is multiplication by inverse.\<close> +lemma hyp_divide_minus_left [simp]: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(-a) / b = - (a / b)" + by (simp add: hyp_divide_inverse) + +lemma hyp_divide_minus_right [simp]: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a / (-b) = - (a / b)" + by (simp add: hyp_divide_inverse hyp_minus_inverse_comm) + +text\<open>Additive inverses on both sides of division cancel out.\<close> +lemma hyp_minus_divide_minus: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(-a) / (-b) = a / b" + by simp + +text\<open>We can multiply both sides of equations by an invertible denominator.\<close> +lemma hyp_denominator_eliminate [divide_simps]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base c \<noteq> 0" + shows "a = b / c \<longleftrightarrow> a * c = b" + by (metis assms hyp_divide_self hyp_times_divide_assoc mult.commute mult.right_neutral) + +text\<open>We can move addition and subtraction to a common denominator in the following ways:\<close> +lemma hyp_add_divide_eq_iff: + fixes x y z :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base z \<noteq> 0" + shows "x + y / z = (x * z + y) / z" + by (metis assms hyp_add_divide_distrib hyp_denominator_eliminate) + +text\<open>Result of division by non-invertible number is not invertible.\<close> +lemma hyp_divide_base_zero [simp]: + fixes a b :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + assumes "Base b = 0" + shows "Base (a / b) = 0" + by (simp add: assms) + +text\<open>Division of self is 1 when invertible, 0 otherwise.\<close> +lemma hyp_divide_self_if [simp]: + fixes a :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a / a = (if Base a = 0 then 0 else 1)" + by (metis hyp_divide_inverse zero_base_zero_inverse hyp_divide_self mult_zero_right) + +text\<open>Repeated division is division by product of the denominators.\<close> +lemma hyp_denominators_merge: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "(a / b) / c = a / (c * b)" + using hyp_inverse_mult_distrib[of c b] + by (simp add: hyp_divide_inverse mult.assoc) + +text\<open>Finally, we derive general simplifications for division with addition and subtraction.\<close> +lemma hyp_add_divide_eq_if_simps [divide_simps]: + fixes a b z :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a + b / z = (if Base z = 0 then a else (a * z + b) / z)" + and "a / z + b = (if Base z = 0 then b else (a + b * z) / z)" + and "- (a / z) + b = (if Base z = 0 then b else (-a + b * z) / z)" + and "a - b / z = (if Base z = 0 then a else (a * z - b) / z)" + and "a / z - b = (if Base z = 0 then -b else (a - b * z) / z)" + and "- (a / z) - b = (if Base z = 0 then -b else (- a - b * z) / z)" + by (simp_all add: algebra_simps hyp_add_divide_eq_iff hyp_divide_inverse zero_base_zero_inverse) + +lemma hyp_divide_eq_eq [divide_simps]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "b / c = a \<longleftrightarrow> (if Base c \<noteq> 0 then b = a * c else a = 0)" + by (metis hyp_divide_inverse hyp_denominator_eliminate mult_not_zero zero_base_zero_inverse) + +lemma hyp_eq_divide_eq [divide_simps]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a = b / c \<longleftrightarrow> (if Base c \<noteq> 0 then a * c = b else a = 0)" + by (metis hyp_divide_eq_eq) + +lemma hyp_minus_divide_eq_eq [divide_simps]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "- (b / c) = a \<longleftrightarrow> (if Base c \<noteq> 0 then - b = a * c else a = 0)" + by (metis hyp_divide_minus_left hyp_eq_divide_eq) + +lemma hyp_eq_minus_divide_eq [divide_simps]: + fixes a b c :: "('a :: {inverse, comm_ring_1, division_ring}) hyperdual" + shows "a = - (b / c) \<longleftrightarrow> (if Base c \<noteq> 0 then a * c = - b else a = 0)" + by (metis hyp_minus_divide_eq_eq) + +subsection \<open>Real Scaling, Real Vector and Real Algebra\<close> + +text\<open> + If the components can be scaled by real numbers then so can the hyperduals. + We define the scaling pointwise. +\<close> +instantiation hyperdual :: (scaleR) scaleR +begin + +primcorec scaleR_hyperdual + where + "Base (f *\<^sub>R x) = f *\<^sub>R Base x" + | "Eps1 (f *\<^sub>R x) = f *\<^sub>R Eps1 x" + | "Eps2 (f *\<^sub>R x) = f *\<^sub>R Eps2 x" + | "Eps12 (f *\<^sub>R x) = f *\<^sub>R Eps12 x" + +instance + by standard +end + +text\<open>If the components form a real vector space then so do the hyperduals.\<close> +instance hyperdual :: (real_vector) real_vector + by standard (simp_all add: algebra_simps) + +text\<open>If the components form a real algebra then so do the hyperduals\<close> +instance hyperdual :: (real_algebra_1) real_algebra_1 + by standard (simp_all add: algebra_simps) + +text\<open> + If the components are reals then @{const of_real} matches our embedding @{const of_comp}, and + @{const scaleR} matches our scalar product @{const scaleH}. +\<close> +lemma "of_real = of_comp" + by (standard, simp add: of_real_def) + +lemma scaleR_eq_scale: + "(*\<^sub>R) = (*\<^sub>H)" + by (standard, standard, simp) + +text\<open>Hyperdual scalar product @{const scaleH} is compatible with @{const scaleR}.\<close> +lemma scaleH_scaleR: + fixes a :: "'a :: real_algebra_1" + and b :: "'a hyperdual" + shows "(f *\<^sub>R a) *\<^sub>H b = f *\<^sub>R a *\<^sub>H b" + and "a *\<^sub>H f *\<^sub>R b = f *\<^sub>R a *\<^sub>H b" + by simp_all + +subsection\<open>Real Inner Product and Real-Normed Vector Space\<close> + +text\<open> + We now take a closer look at hyperduals as a real vector space. + + If the components form a real inner product space then we can define one on the hyperduals as the + sum of componentwise inner products. + The norm is then defined as the square root of that inner product. + We define signum, distance, uniformity and openness similarly as they are defined for complex + numbers. +\<close> +instantiation hyperdual :: (real_inner) real_inner +begin + +definition inner_hyperdual :: "'a hyperdual \<Rightarrow> 'a hyperdual \<Rightarrow> real" + where "x \<bullet> y = Base x \<bullet> Base y + Eps1 x \<bullet> Eps1 y + Eps2 x \<bullet> Eps2 y + Eps12 x \<bullet> Eps12 y" + +definition norm_hyperdual :: "'a hyperdual \<Rightarrow> real" + where "norm_hyperdual x = sqrt (x \<bullet> x)" + +definition sgn_hyperdual :: "'a hyperdual \<Rightarrow> 'a hyperdual" + where "sgn_hyperdual x = x /\<^sub>R norm x" + +definition dist_hyperdual :: "'a hyperdual \<Rightarrow> 'a hyperdual \<Rightarrow> real" + where "dist_hyperdual a b = norm(a - b)" + +definition uniformity_hyperdual :: "('a hyperdual \<times> 'a hyperdual) filter" + where "uniformity_hyperdual = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})" + +definition open_hyperdual :: "('a hyperdual) set \<Rightarrow> bool" + where "open_hyperdual U \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)" + +instance +proof + fix x y z :: "'a hyperdual" + fix U :: "('a hyperdual) set" + fix r :: real + + show "dist x y = norm (x - y)" + by (simp add: dist_hyperdual_def) + show "sgn x = x /\<^sub>R norm x" + by (simp add: sgn_hyperdual_def) + show "uniformity = (INF e\<in>{0<..}. principal {(x :: 'a hyperdual, y). dist x y < e})" + using uniformity_hyperdual_def by blast + show "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> U)" + using open_hyperdual_def by blast + show "x \<bullet> y = y \<bullet> x" + by (simp add: inner_hyperdual_def inner_commute) + show "(x + y) \<bullet> z = x \<bullet> z + y \<bullet> z" + and "r *\<^sub>R x \<bullet> y = r * (x \<bullet> y)" + and "0 \<le> x \<bullet> x" + and "norm x = sqrt (x \<bullet> x)" + by (simp_all add: inner_hyperdual_def norm_hyperdual_def algebra_simps) + show "(x \<bullet> x = 0) = (x = 0)" + proof + assume "x \<bullet> x = 0" + then have "Base x \<bullet> Base x + Eps1 x \<bullet> Eps1 x + Eps2 x \<bullet> Eps2 x + Eps12 x \<bullet> Eps12 x = 0" + by (simp add: inner_hyperdual_def) + then have "Base x = 0 \<and> Eps1 x = 0 \<and> Eps2 x = 0 \<and> Eps12 x = 0" + using inner_gt_zero_iff inner_ge_zero add_nonneg_nonneg + by smt + then show "x = 0" + by simp + next + assume "x = 0" + then show "x \<bullet> x = 0" + by (simp add: inner_hyperdual_def) + qed +qed +end + +text\<open> + We then show that with this norm hyperduals with components that form a real normed algebra do not + themselves form a normed algebra, by counter-example to the assumption that class adds. +\<close> +(* Components must be real_inner for hyperduals to have a norm *) +(* Components must be real_normed_algebra_1 to know |1| = 1, because we need some element with known + norm of its square. Otherwise we would need the precise definition of the norm. *) +lemma not_normed_algebra: + shows "\<not>(\<forall>x y :: ('a :: {real_normed_algebra_1, real_inner}) hyperdual . norm (x * y) \<le> norm x * norm y)" +proof - + have "norm (Hyperdual (1 :: 'a) 1 1 1) = 2" + by (simp add: norm_hyperdual_def inner_hyperdual_def dot_square_norm) + moreover have "(Hyperdual (1 :: 'a) 1 1 1) * (Hyperdual 1 1 1 1) = Hyperdual 1 2 2 4" + by (simp add: hyperdual.expand) + moreover have "norm (Hyperdual (1 :: 'a) 2 2 4) > 4" + by (simp add: norm_hyperdual_def inner_hyperdual_def dot_square_norm) + ultimately have "\<exists>x y :: 'a hyperdual . norm (x * y) > norm x * norm y" + by (smt power2_eq_square real_sqrt_four real_sqrt_pow2) + then show ?thesis + by (simp add: not_le) +qed + +subsection\<open>Euclidean Space\<close> + +text\<open> + Next we define a basis for the space, consisting of four elements one for each component with \<open>1\<close> + in the relevant component and \<open>0\<close> elsewhere. +\<close> +definition ba :: "('a :: zero_neq_one) hyperdual" + where "ba = Hyperdual 1 0 0 0" +definition e1 :: "('a :: zero_neq_one) hyperdual" + where "e1 = Hyperdual 0 1 0 0" +definition e2 :: "('a :: zero_neq_one) hyperdual" + where "e2 = Hyperdual 0 0 1 0" +definition e12 :: "('a :: zero_neq_one) hyperdual" + where "e12 = Hyperdual 0 0 0 1" + +lemmas hyperdual_bases = ba_def e1_def e2_def e12_def + +text\<open> + Using the constructor @{const Hyperdual} is equivalent to using the linear combination with + coefficients the relevant arguments. +\<close> +lemma Hyperdual_eq: + fixes a b c d :: "'a :: ring_1" + shows "Hyperdual a b c d = a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12" + by (simp add: hyperdual_bases) + +text\<open>Projecting from the combination returns the relevant coefficient:\<close> +lemma hyperdual_comb_sel [simp]: + fixes a b c d :: "'a :: ring_1" + shows "Base (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = a" + and "Eps1 (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = b" + and "Eps2 (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = c" + and "Eps12 (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = d" + using Hyperdual_eq hyperdual.sel by metis+ + +text\<open>Any hyperdual number is a linear combination of these four basis elements.\<close> +lemma hyperdual_linear_comb: + fixes x :: "('a :: ring_1) hyperdual" + obtains a b c d :: 'a where "x = a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12" + using hyperdual.exhaust Hyperdual_eq by metis + +text\<open> + The linear combination expressing any hyperdual number has as coefficients the projections of + that number onto the relevant basis element. +\<close> +lemma hyperdual_eq: + fixes x :: "('a :: ring_1) hyperdual" + shows "x = Base x *\<^sub>H ba + Eps1 x *\<^sub>H e1 + Eps2 x *\<^sub>H e2 + Eps12 x *\<^sub>H e12" + using Hyperdual_eq hyperdual.collapse by smt + +text\<open>Equality of hyperduals as linear combinations is equality of corresponding components.\<close> +lemma hyperdual_eq_parts_cancel [simp]: + fixes a b c d :: "'a :: ring_1" + shows "(a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12 = a' *\<^sub>H ba + b' *\<^sub>H e1 + c' *\<^sub>H e2 + d' *\<^sub>H e12) \<equiv> + (a = a' \<and> b = b' \<and> c = c' \<and> d = d')" + by (smt Hyperdual_eq hyperdual.inject) + +lemma scaleH_cancel [simp]: + fixes a b :: "'a :: ring_1" + shows "(a *\<^sub>H ba = b *\<^sub>H ba) \<equiv> (a = b)" + and "(a *\<^sub>H e1 = b *\<^sub>H e1) \<equiv> (a = b)" + and "(a *\<^sub>H e2 = b *\<^sub>H e2) \<equiv> (a = b)" + and "(a *\<^sub>H e12 = b *\<^sub>H e12) \<equiv> (a = b)" + by (auto simp add: hyperdual_bases)+ + +text\<open>We can now also show that the multiplication we use indeed has the hyperdual units nilpotent.\<close> +(* The components must have multiplication and addition for this to be defined and have an absorbing + zero to prove it. *) +lemma epsilon_squares [simp]: + "(e1 :: ('a :: ring_1) hyperdual) * e1 = 0" + "(e2 :: ('a :: ring_1) hyperdual) * e2 = 0" + "(e12 :: ('a :: ring_1) hyperdual) * e12 = 0" + by (simp_all add: hyperdual_bases) + +text\<open>However none of the hyperdual units is zero.\<close> +lemma hyperdual_bases_nonzero [simp]: + "ba \<noteq> 0" + "e1 \<noteq> 0" + "e2 \<noteq> 0" + "e12 \<noteq> 0" + by (simp_all add: hyperdual_bases) + +text\<open>Hyperdual units are orthogonal.\<close> +lemma hyperdual_bases_ortho [simp]: + "(ba :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e1 = 0" + "(ba :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e2 = 0" + "(ba :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e12 = 0" + "(e1 :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e2 = 0" + "(e1 :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e12 = 0" + "(e2 :: ('a :: {real_inner,zero_neq_one}) hyperdual) \<bullet> e12 = 0" + by (simp_all add: hyperdual_bases inner_hyperdual_def) + +text\<open>Hyperdual units of norm equal to 1.\<close> +lemma hyperdual_bases_norm [simp]: + "(ba :: ('a :: {real_inner,real_normed_algebra_1}) hyperdual) \<bullet> ba = 1" + "(e1 :: ('a :: {real_inner,real_normed_algebra_1}) hyperdual) \<bullet> e1 = 1" + "(e2 :: ('a :: {real_inner,real_normed_algebra_1}) hyperdual) \<bullet> e2 = 1" + "(e12 :: ('a :: {real_inner,real_normed_algebra_1}) hyperdual) \<bullet> e12 = 1" + by (simp_all add: hyperdual_bases inner_hyperdual_def norm_eq_1[symmetric]) + +text\<open>We can also express earlier operations in terms of the linear combination.\<close> +lemma add_hyperdual_parts: + fixes a b c d :: "'a :: ring_1" + shows "(a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) + (a' *\<^sub>H ba + b' *\<^sub>H e1 + c' *\<^sub>H e2 + d' *\<^sub>H e12) = + (a + a') *\<^sub>H ba + (b + b') *\<^sub>H e1 + (c + c') *\<^sub>H e2 + (d + d') *\<^sub>H e12" + by (simp add: scaleH_add(1)) + +lemma times_hyperdual_parts: + fixes a b c d :: "'a :: ring_1" + shows "(a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) * (a' *\<^sub>H ba + b' *\<^sub>H e1 + c' *\<^sub>H e2 + d' *\<^sub>H e12) = + (a * a') *\<^sub>H ba + (a * b' + b * a') *\<^sub>H e1 + (a * c' + c * a') *\<^sub>H e2 + (a * d' + b * c' + c * b' + d * a') *\<^sub>H e12" + by (simp add: hyperdual_bases) + +lemma inverse_hyperdual_parts: + fixes a b c d :: "'a :: {inverse,ring_1}" + shows "inverse (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = + (1 / a) *\<^sub>H ba + (- b / a ^ 2) *\<^sub>H e1 + (- c / a ^ 2) *\<^sub>H e2 + (2 * (b * c / a ^ 3) - d / a ^ 2) *\<^sub>H e12" + by (simp add: hyperdual_bases) + +text\<open> + Next we show that hyperduals form a euclidean space with the help of the basis we defined earlier + and the above inner product if the component is an instance of @{class euclidean_space} and + @{class real_algebra_1}. + The basis of this space is each of the basis elements we defined scaled by each of the basis + elements of the component type, representing the expansion of the space for each component of the + hyperdual numbers. +\<close> +instantiation hyperdual :: ("{euclidean_space, real_algebra_1}") euclidean_space +begin + +definition Basis_hyperdual :: "('a hyperdual) set" + where "Basis = (\<Union>i\<in>{ba,e1,e2,e12}. (\<lambda>u. u *\<^sub>H i) ` Basis)" + +instance +proof + fix x y z :: "'a hyperdual" + show "(Basis :: ('a hyperdual) set) \<noteq> {}" + and "finite (Basis :: ('a hyperdual) set)" + by (simp_all add: Basis_hyperdual_def) + show "x \<in> Basis \<Longrightarrow> y \<in> Basis \<Longrightarrow> x \<bullet> y = (if x = y then 1 else 0)" + unfolding Basis_hyperdual_def inner_hyperdual_def hyperdual_bases + by (auto dest: inner_not_same_Basis) + show "(\<forall>u\<in>Basis. x \<bullet> u = 0) = (x = 0)" + by (auto simp add: Basis_hyperdual_def ball_Un inner_hyperdual_def hyperdual_bases euclidean_all_zero_iff) +qed +end + +subsection\<open>Bounded Linear Projections\<close> + +text\<open>Now we can show that each projection to a basis element is a bounded linear map.\<close> +lemma bounded_linear_Base: "bounded_linear Base" +proof + show "\<And>b1 b2. Base (b1 + b2) = Base b1 + Base b2" + by simp + show "\<And>r b. Base (r *\<^sub>R b) = r *\<^sub>R Base b" + by simp + have "\<forall>x. norm (Base x) \<le> norm x" + by (simp add: inner_hyperdual_def norm_eq_sqrt_inner) + then show "\<exists>K. \<forall>x. norm (Base x) \<le> norm x * K" + by (metis mult.commute mult.left_neutral) +qed +lemma bounded_linear_Eps1: "bounded_linear Eps1" +proof + show "\<And>b1 b2. Eps1 (b1 + b2) = Eps1 b1 + Eps1 b2" + by simp + show "\<And>r b. Eps1 (r *\<^sub>R b) = r *\<^sub>R Eps1 b" + by simp + have "\<forall>x. norm (Eps1 x) \<le> norm x" + by (simp add: inner_hyperdual_def norm_eq_sqrt_inner) + then show "\<exists>K. \<forall>x. norm (Eps1 x) \<le> norm x * K" + by (metis mult.commute mult.left_neutral) +qed +lemma bounded_linear_Eps2: "bounded_linear Eps2" +proof + show "\<And>b1 b2. Eps2 (b1 + b2) = Eps2 b1 + Eps2 b2" + by simp + show "\<And>r b. Eps2 (r *\<^sub>R b) = r *\<^sub>R Eps2 b" + by simp + have "\<forall>x. norm (Eps2 x) \<le> norm x" + by (simp add: inner_hyperdual_def norm_eq_sqrt_inner) + then show "\<exists>K. \<forall>x. norm (Eps2 x) \<le> norm x * K" + by (metis mult.commute mult.left_neutral) +qed +lemma bounded_linear_Eps12: "bounded_linear Eps12" +proof + show "\<And>b1 b2. Eps12 (b1 + b2) = Eps12 b1 + Eps12 b2" + by simp + show "\<And>r b. Eps12 (r *\<^sub>R b) = r *\<^sub>R Eps12 b" + by simp + have "\<forall>x. norm (Eps12 x) \<le> norm x" + by (simp add: inner_hyperdual_def norm_eq_sqrt_inner) + then show "\<exists>K. \<forall>x. norm (Eps12 x) \<le> norm x * K" + by (metis mult.commute mult.left_neutral) +qed + +text\<open> + This bounded linearity gives us a range of useful theorems about limits, convergence and + derivatives of these projections. +\<close> +lemmas tendsto_Base = bounded_linear.tendsto[OF bounded_linear_Base] +lemmas tendsto_Eps1 = bounded_linear.tendsto[OF bounded_linear_Eps1] +lemmas tendsto_Eps2 = bounded_linear.tendsto[OF bounded_linear_Eps2] +lemmas tendsto_Eps12 = bounded_linear.tendsto[OF bounded_linear_Eps12] + +lemmas has_derivative_Base = bounded_linear.has_derivative[OF bounded_linear_Base] +lemmas has_derivative_Eps1 = bounded_linear.has_derivative[OF bounded_linear_Eps1] +lemmas has_derivative_Eps2 = bounded_linear.has_derivative[OF bounded_linear_Eps2] +lemmas has_derivative_Eps12 = bounded_linear.has_derivative[OF bounded_linear_Eps12] + +subsection\<open>Convergence\<close> +lemma inner_mult_le_mult_inner: + fixes a b :: "'a :: {real_inner,real_normed_algebra}" + shows "((a * b) \<bullet> (a * b)) \<le> (a \<bullet> a) * (b \<bullet> b)" + by (metis real_sqrt_le_iff norm_eq_sqrt_inner real_sqrt_mult norm_mult_ineq) + +lemma bounded_bilinear_scaleH: + "bounded_bilinear ((*\<^sub>H) :: ('a :: {real_normed_algebra_1, real_inner}) \<Rightarrow> 'a hyperdual \<Rightarrow> 'a hyperdual)" +proof (auto simp add: bounded_bilinear_def scaleH_add scaleH_scaleR del:exI intro!:exI) + fix a :: 'a + and b :: "'a hyperdual" + have "norm (a *\<^sub>H b) = sqrt ((a * Base b) \<bullet> (a * Base b) + (a * Eps1 b) \<bullet> (a * Eps1 b) + (a * Eps2 b) \<bullet> (a * Eps2 b) + (a * Eps12 b) \<bullet> (a * Eps12 b))" + by (simp add: norm_eq_sqrt_inner inner_hyperdual_def) + moreover have "norm a * norm b = sqrt (a \<bullet> a * (Base b \<bullet> Base b + Eps1 b \<bullet> Eps1 b + Eps2 b \<bullet> Eps2 b + Eps12 b \<bullet> Eps12 b))" + by (simp add: norm_eq_sqrt_inner inner_hyperdual_def real_sqrt_mult) + moreover have "sqrt ((a * Base b) \<bullet> (a * Base b) + (a * Eps1 b) \<bullet> (a * Eps1 b) + (a * Eps2 b) \<bullet> (a * Eps2 b) + (a * Eps12 b) \<bullet> (a * Eps12 b)) \<le> + sqrt (a \<bullet> a * (Base b \<bullet> Base b + Eps1 b \<bullet> Eps1 b + Eps2 b \<bullet> Eps2 b + Eps12 b \<bullet> Eps12 b))" + by (simp add: distrib_left add_mono inner_mult_le_mult_inner) + ultimately show "norm (a *\<^sub>H b) \<le> norm a * norm b * 1" + by simp +qed + +lemmas tendsto_scaleH = bounded_bilinear.tendsto[OF bounded_bilinear_scaleH] + +text\<open> + We describe how limits behave for general hyperdual-valued functions. + + First we prove that we can go from convergence of the four component functions to the convergence + of the hyperdual-valued function whose components they define. +\<close> +lemma tendsto_Hyperdual: + fixes f :: "'a \<Rightarrow> ('b :: {real_normed_algebra_1, real_inner})" + assumes "(f \<longlongrightarrow> a) F" + and "(g \<longlongrightarrow> b) F" + and "(h \<longlongrightarrow> c) F" + and "(i \<longlongrightarrow> d) F" + shows "((\<lambda>x. Hyperdual (f x) (g x) (h x) (i x)) \<longlongrightarrow> Hyperdual a b c d) F" +proof - + have "((\<lambda>x. (f x) *\<^sub>H ba) \<longlongrightarrow> a *\<^sub>H ba) F" + "((\<lambda>x. (g x) *\<^sub>H e1) \<longlongrightarrow> b *\<^sub>H e1) F" + "((\<lambda>x. (h x) *\<^sub>H e2) \<longlongrightarrow> c *\<^sub>H e2) F" + "((\<lambda>x. (i x) *\<^sub>H e12) \<longlongrightarrow> d *\<^sub>H e12) F" + by (rule tendsto_scaleH[OF _ tendsto_const], rule assms)+ + then have "((\<lambda>x. (f x) *\<^sub>H ba + (g x) *\<^sub>H e1 + (h x) *\<^sub>H e2 + (i x) *\<^sub>H e12) \<longlongrightarrow> + a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) F" + by (rule tendsto_add[OF tendsto_add[OF tendsto_add]] ; assumption) + then show ?thesis + by (simp add: Hyperdual_eq) +qed + +text\<open> + Next we complete the equivalence by proving the other direction, from convergence of a + hyperdual-valued function to the convergence of the projected component functions. +\<close> +lemma tendsto_hyperdual_iff: + fixes f :: "'a \<Rightarrow> ('b :: {real_normed_algebra_1, real_inner}) hyperdual" + shows "(f \<longlongrightarrow> x) F \<longleftrightarrow> + ((\<lambda>x. Base (f x)) \<longlongrightarrow> Base x) F \<and> + ((\<lambda>x. Eps1 (f x)) \<longlongrightarrow> Eps1 x) F \<and> + ((\<lambda>x. Eps2 (f x)) \<longlongrightarrow> Eps2 x) F \<and> + ((\<lambda>x. Eps12 (f x)) \<longlongrightarrow> Eps12 x) F" +proof safe + assume "(f \<longlongrightarrow> x) F" + then show "((\<lambda>x. Base (f x)) \<longlongrightarrow> Base x) F" + and "((\<lambda>x. Eps1 (f x)) \<longlongrightarrow> Eps1 x) F" + and "((\<lambda>x. Eps2 (f x)) \<longlongrightarrow> Eps2 x) F" + and "((\<lambda>x. Eps12 (f x)) \<longlongrightarrow> Eps12 x) F" + by (simp_all add: tendsto_Base tendsto_Eps1 tendsto_Eps2 tendsto_Eps12) +next + assume "((\<lambda>x. Base (f x)) \<longlongrightarrow> Base x) F" + and "((\<lambda>x. Eps1 (f x)) \<longlongrightarrow> Eps1 x) F" + and "((\<lambda>x. Eps2 (f x)) \<longlongrightarrow> Eps2 x) F" + and "((\<lambda>x. Eps12 (f x)) \<longlongrightarrow> Eps12 x) F" + then show "(f \<longlongrightarrow> x) F" + using tendsto_Hyperdual[of "\<lambda>x. Base (f x)" "Base x" F "\<lambda>x. Eps1 (f x)" "Eps1 x" "\<lambda>x. Eps2 (f x)" "Eps2 x" "\<lambda>x. Eps12 (f x)" "Eps12 x"] + by simp +qed + +subsection\<open>Derivatives\<close> + +text\<open> + We describe how derivatives of hyperdual-valued functions behave. + Due to hyperdual numbers not forming a normed field, the derivative relation we must use is the + general Fréchet derivative @{const has_derivative}. + + The left to right implication of the following equivalence is easily proved by the known + derivative behaviour of the projections. + The other direction is more difficult, because we have to construct the two requirements of the + @{const has_derivative} relation, the limit and the bounded linearity of the derivative. + While the limit is simple to construct from the component functions by previous lemma, the bounded + linearity is more involved. +\<close> +(* The derivative of a hyperdual function is composed of the derivatives of its coefficient functions *) +lemma has_derivative_hyperdual_iff: + fixes f :: "('a :: real_normed_vector) \<Rightarrow> ('b :: {real_normed_algebra_1, real_inner}) hyperdual" + shows "(f has_derivative Df) F \<longleftrightarrow> + ((\<lambda>x. Base (f x)) has_derivative (\<lambda>x. Base (Df x))) F \<and> + ((\<lambda>x. Eps1 (f x)) has_derivative (\<lambda>x. Eps1 (Df x))) F \<and> + ((\<lambda>x. Eps2 (f x)) has_derivative (\<lambda>x. Eps2 (Df x))) F \<and> + ((\<lambda>x. Eps12 (f x)) has_derivative (\<lambda>x. Eps12 (Df x))) F" +proof safe + \<comment> \<open>Left to Right\<close> + assume assm: "(f has_derivative Df) F" + show "((\<lambda>x. Base (f x)) has_derivative (\<lambda>x. Base (Df x))) F" + using assm has_derivative_Base by blast + show "((\<lambda>x. Eps1 (f x)) has_derivative (\<lambda>x. Eps1 (Df x))) F" + using assm has_derivative_Eps1 by blast + show "((\<lambda>x. Eps2 (f x)) has_derivative (\<lambda>x. Eps2 (Df x))) F" + using assm has_derivative_Eps2 by blast + show "((\<lambda>x. Eps12 (f x)) has_derivative (\<lambda>x. Eps12 (Df x))) F" + using assm has_derivative_Eps12 by blast +next + \<comment> \<open>Right to Left\<close> + assume assm: + "((\<lambda>x. Base (f x)) has_derivative (\<lambda>x. Base (Df x))) F" + "((\<lambda>x. Eps1 (f x)) has_derivative (\<lambda>x. Eps1 (Df x))) F" + "((\<lambda>x. Eps2 (f x)) has_derivative (\<lambda>x. Eps2 (Df x))) F" + "((\<lambda>x. Eps12 (f x)) has_derivative (\<lambda>x. Eps12 (Df x))) F" + + \<comment> \<open>First prove the limit from component function limits\<close> + have "((\<lambda>y. Base (((f y - f (Lim F (\<lambda>x. x))) - Df (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x)))) \<longlongrightarrow> Base 0) F" + using assm has_derivative_def[of "(\<lambda>x. Base (f x))" "(\<lambda>x. Base (Df x))" F] by simp + moreover have "((\<lambda>y. Eps1 (((f y - f (Lim F (\<lambda>x. x))) - Df (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x)))) \<longlongrightarrow> Base 0) F" + using assm has_derivative_def[of "(\<lambda>x. Eps1 (f x))" "(\<lambda>x. Eps1 (Df x))" F] by simp + moreover have "((\<lambda>y. Eps2 (((f y - f (Lim F (\<lambda>x. x))) - Df (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x)))) \<longlongrightarrow> Base 0) F" + using assm has_derivative_def[of "(\<lambda>x. Eps2 (f x))" "(\<lambda>x. Eps2 (Df x))" F] by simp + moreover have "((\<lambda>y. Eps12 (((f y - f (Lim F (\<lambda>x. x))) - Df (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x)))) \<longlongrightarrow> Base 0) F" + using assm has_derivative_def[of "(\<lambda>x. Eps12 (f x))" "(\<lambda>x. Eps12 (Df x))" F] by simp + ultimately have "((\<lambda>y. ((f y - f (Lim F (\<lambda>x. x))) - Df (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x))) \<longlongrightarrow> 0) F" + by (simp add: tendsto_hyperdual_iff) + + \<comment> \<open>Next prove bounded linearity of the composed derivative by proving each of that class' + assumptions from bounded linearity of the component derivatives\<close> + moreover have "bounded_linear Df" + proof + have bl: + "bounded_linear (\<lambda>x. Base (Df x))" + "bounded_linear (\<lambda>x. Eps1 (Df x))" + "bounded_linear (\<lambda>x. Eps2 (Df x))" + "bounded_linear (\<lambda>x. Eps12 (Df x))" + using assm has_derivative_def by blast+ + then have "linear (\<lambda>x. Base (Df x))" + and "linear (\<lambda>x. Eps1 (Df x))" + and "linear (\<lambda>x. Eps2 (Df x))" + and "linear (\<lambda>x. Eps12 (Df x))" + using bounded_linear.linear by blast+ + then show "\<And>x y. Df (x + y) = Df x + Df y" + and "\<And>x y. Df (x *\<^sub>R y) = x *\<^sub>R Df y" + using plus_hyperdual.code scaleR_hyperdual.code by (simp_all add: linear_iff) + + show "\<exists>K. \<forall>x. norm (Df x) \<le> norm x * K" + proof - + obtain k_re k_eps1 k_eps2 k_eps12 + where "\<forall>x. (norm (Base (Df x)))^2 \<le> (norm x * k_re)^2" + and "\<forall>x. (norm (Eps1 (Df x)))^2 \<le> (norm x * k_eps1)^2" + and "\<forall>x. (norm (Eps2 (Df x)))^2 \<le> (norm x * k_eps2)^2" + and "\<forall>x. (norm (Eps12 (Df x)))^2 \<le> (norm x * k_eps12)^2" + using bl bounded_linear.bounded norm_ge_zero power_mono by metis + moreover have "\<forall>x. (norm (Df x))^2 = (norm (Base (Df x)))^2 + (norm (Eps1 (Df x)))^2 + (norm (Eps2 (Df x)))^2 + (norm (Eps12 (Df x)))^2" + using inner_hyperdual_def power2_norm_eq_inner by metis + ultimately have "\<forall>x. (norm (Df x))^2 \<le> (norm x * k_re)^2 + (norm x * k_eps1)^2 + (norm x * k_eps2)^2 + (norm x * k_eps12)^2" + by smt + then have "\<forall>x. (norm (Df x))^2 \<le> (norm x)^2 * (k_re^2 + k_eps1^2 + k_eps2^2 + k_eps12^2)" + by (simp add: distrib_left power_mult_distrib) + then have final: "\<forall>x. norm (Df x) \<le> norm x * sqrt(k_re^2 + k_eps1^2 + k_eps2^2 + k_eps12^2)" + using real_le_rsqrt real_sqrt_mult real_sqrt_pow2 by fastforce + then show "\<exists>K. \<forall>x. norm (Df x) \<le> norm x * K" + by blast + qed + qed + \<comment> \<open>Finally put the two together to finish the proof\<close> + ultimately show "(f has_derivative Df) F" + by (simp add: has_derivative_def) +qed + +text\<open>Stop automatically unfolding hyperduals into components outside this theory:\<close> +lemmas [iff del] = hyperdual_eq_iff + +end diff --git a/thys/Hyperdual/HyperdualFunctionExtension.thy b/thys/Hyperdual/HyperdualFunctionExtension.thy new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/HyperdualFunctionExtension.thy @@ -0,0 +1,647 @@ +(* Title: HyperdualFunctionExtension.thy + Authors: Jacques D. Fleuriot and Filip Smola, University of Edinburgh, 2021 +*) + +section \<open>Hyperdual Extension of Functions\<close> + +theory HyperdualFunctionExtension + imports Hyperdual TwiceFieldDifferentiable +begin + +text\<open>The following is an important fact in the derivation of the hyperdual extension.\<close> +lemma + fixes x :: "('a :: comm_ring_1) hyperdual" and n :: nat + assumes "Base x = 0" + shows "x ^ (n + 3) = 0" +proof (induct n) + case 0 + then show ?case + using assms hyperdual_power[of x 3] by simp +next + case (Suc n) + then show ?case + using assms power_Suc[of x "n + 3"] mult_zero_right add_Suc by simp +qed + +text\<open>We define the extension of a function to the hyperdual numbers.\<close> +primcorec hypext :: "(('a :: real_normed_field) \<Rightarrow> 'a) \<Rightarrow> 'a hyperdual \<Rightarrow> 'a hyperdual" (\<open>*h* _\<close> [80] 80) + where + "Base ((*h* f) x) = f (Base x)" + | "Eps1 ((*h* f) x) = Eps1 x * deriv f (Base x)" + | "Eps2 ((*h* f) x) = Eps2 x * deriv f (Base x)" + | "Eps12 ((*h* f) x) = Eps12 x * deriv f (Base x) + Eps1 x * Eps2 x * deriv (deriv f) (Base x)" + +text\<open>This has the expected behaviour when expressed in terms of the units.\<close> +lemma hypext_Hyperdual_eq: + "(*h* f) (Hyperdual a b c d) = + Hyperdual (f a) (b * deriv f a) (c * deriv f a) (d * deriv f a + b * c * deriv (deriv f) a)" + by (simp add: hypext.code) + +lemma hypext_Hyperdual_eq_parts: + "(*h* f) (Hyperdual a b c d) = + f a *\<^sub>H ba + (b * deriv f a) *\<^sub>H e1 + (c * deriv f a) *\<^sub>H e2 + + (d * deriv f a + b * c * deriv (deriv f) a) *\<^sub>H e12 " + by (metis Hyperdual_eq hypext_Hyperdual_eq) + +text\<open> + The extension can be used to extract the function value, and first and second derivatives at x + when applied to @{term "x *\<^sub>H re + e1 + e2 + 0 *\<^sub>H e12"}, which we denote by @{term "\<beta> x"}. +\<close> +definition hyperdualx :: "('a :: real_normed_field) \<Rightarrow> 'a hyperdual" ("\<beta>") + where "\<beta> x = (Hyperdual x 1 1 0)" + +lemma hyperdualx_sel [simp]: + shows "Base (\<beta> x) = x" + and "Eps1 (\<beta> x) = 1" + and "Eps2 (\<beta> x) = 1" + and "Eps12 (\<beta> x) = 0" + by (simp_all add: hyperdualx_def) + +lemma hypext_extract_eq: + "(*h* f) (\<beta> x) = f x *\<^sub>H ba + deriv f x *\<^sub>H e1 + deriv f x *\<^sub>H e2 + deriv (deriv f) x *\<^sub>H e12" + by (simp add: hypext_Hyperdual_eq_parts hyperdualx_def) + +lemma Base_hypext: + "Base ((*h* f) (\<beta> x)) = f x" + by (simp add: hyperdualx_def) + +lemma Eps1_hypext: + "Eps1 ((*h* f) (\<beta> x)) = deriv f x" + by (simp add: hyperdualx_def) + +lemma Eps2_hypext: + "Eps2 ((*h* f) (\<beta> x)) = deriv f x" + by (simp add: hyperdualx_def) + +lemma Eps12_hypext: + "Eps12 ((*h* f) (\<beta> x)) = deriv (deriv f) x" + by (simp add: hyperdualx_def) + +subsubsection\<open>Convenience Interface\<close> + +text\<open>Define a datatype to hold the function value, and the first and second derivative values.\<close> +datatype ('a :: real_normed_field) derivs = Derivs (Value: 'a) (First: 'a) (Second: 'a) + +text\<open> + Then we convert a hyperdual number to derivative values by extracting the base component, one of + the first-order components, and the second-order component. +\<close> +fun hyperdual_to_derivs :: "('a :: real_normed_field) hyperdual \<Rightarrow> 'a derivs" + where "hyperdual_to_derivs x = Derivs (Base x) (Eps1 x) (Eps12 x)" + +text\<open> + Finally we define way of converting any compatible function into one that yields the value and the + derivatives. +\<close> +fun autodiff :: "('a :: real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a derivs" + where "autodiff f = (\<lambda>x. hyperdual_to_derivs ((*h* f) (\<beta> x)))" + +lemma autodiff_sel: + "Value (autodiff f x) = Base ((*h* f) (\<beta> x))" + "First (autodiff f x) = Eps1 ((*h* f) (\<beta> x))" + "Second (autodiff f x) = Eps12 ((*h* f) (\<beta> x))" + by simp_all + +text\<open>The result contains the expected values.\<close> +lemma autodiff_extract_value: + "Value (autodiff f x) = f x" + by (simp del: hypext.simps add: Base_hypext) + +lemma autodiff_extract_first: + "First (autodiff f x) = deriv f x" + by (simp del: hypext.simps add: Eps1_hypext) + +lemma autodiff_extract_second: + "Second (autodiff f x) = deriv (deriv f) x" + by (simp del: hypext.simps add: Eps12_hypext) + +text\<open> + The derivative components of the result are actual derivatives if the function is sufficiently + differentiable on that argument. +\<close> +lemma autodiff_first_derivative: + assumes "f field_differentiable (at x)" + shows "(f has_field_derivative First (autodiff f x)) (at x)" + by (simp add: autodiff_extract_first DERIV_deriv_iff_field_differentiable assms) + +lemma autodiff_second_derivative: + assumes "f twice_field_differentiable_at x" + shows "((deriv f) has_field_derivative Second (autodiff f x)) (at x)" + by (simp add: autodiff_extract_second DERIV_deriv_iff_field_differentiable assms deriv_field_differentiable_at) + +subsubsection\<open>Composition\<close> + +text\<open>Composition of hyperdual extensions is the hyperdual extension of composition:\<close> +lemma hypext_compose: + assumes "f twice_field_differentiable_at (Base x)" + and "g twice_field_differentiable_at (f (Base x))" + shows "(*h* (\<lambda>x. g (f x))) x = (*h* g) ((*h* f) x)" +proof (simp add: hyperdual_eq_iff, intro conjI disjI2) + show goal1: "deriv (\<lambda>x. g (f x)) (Base x) = deriv f (Base x) * deriv g (f (Base x))" + proof - + have "deriv (\<lambda>x. g (f x)) (Base x) = deriv (g \<circ> f) (Base x)" + by (simp add: comp_def) + also have "... = deriv g (f (Base x)) * deriv f (Base x)" + using assms by (simp add: deriv_chain once_field_differentiable_at) + finally show ?thesis + by (simp add: mult.commute deriv_chain) + qed + then show "deriv (\<lambda>x. g (f x)) (Base x) = deriv f (Base x) * deriv g (f (Base x))" . + + have first_diff: "(\<lambda>x. deriv g (f x)) field_differentiable at (Base x)" + by (metis DERIV_chain2 assms deriv_field_differentiable_at field_differentiable_def once_field_differentiable_at) + + have "deriv (deriv g \<circ> f) (Base x) = deriv (deriv g) (f (Base x)) * deriv f (Base x)" + using deriv_chain assms once_field_differentiable_at deriv_field_differentiable_at + by blast + then have deriv_deriv_comp: "deriv (\<lambda>x. deriv g (f x)) (Base x) = deriv (deriv g) (f (Base x)) * deriv f (Base x)" + by (simp add: comp_def) + + have "deriv (deriv (\<lambda>x. g (f x))) (Base x) = deriv ((\<lambda>x. deriv f x * deriv g (f x))) (Base x)" + using assms eventually_deriv_compose'[of f "Base x" g] + by (simp add: mult.commute deriv_cong_ev) + also have "... = deriv f (Base x) * deriv (\<lambda>x. deriv g (f x)) (Base x) + deriv (deriv f) (Base x) * deriv g (f (Base x))" + using assms(1) first_diff by (simp add: deriv_field_differentiable_at) + also have "... = deriv f (Base x) * deriv (deriv g) (f (Base x)) * deriv f (Base x) + deriv (deriv f) (Base x) * deriv g (f (Base x))" + using deriv_deriv_comp by simp + finally show "Eps12 x * deriv (\<lambda>x. g (f x)) (Base x) + Eps1 x * Eps2 x * deriv (deriv (\<lambda>x. g (f x))) (Base x) = + (Eps12 x * deriv f (Base x) + Eps1 x * Eps2 x * deriv (deriv f) (Base x)) * deriv g (f (Base x)) + + Eps1 x * deriv f (Base x) * (Eps2 x * deriv f (Base x)) * deriv (deriv g) (f (Base x))" + by (simp add: goal1 field_simps) +qed + +subsection\<open>Concrete Instances\<close> + +subsubsection\<open>Constant\<close> + +text\<open>Component embedding is an extension of the constant function.\<close> +lemma hypext_const [simp]: + "(*h* (\<lambda>x. a)) x = of_comp a" + by (simp add: of_comp_def hyperdual_eq_iff) + +lemma "autodiff (\<lambda>x. a) = (\<lambda>x. Derivs a 0 0)" + by simp + +subsubsection\<open>Identity\<close> + +text\<open>Identity is an extension of the component identity.\<close> +lemma hypext_ident: + "(*h* (\<lambda>x. x)) x = x" + by (simp add: hyperdual_eq_iff) + +subsubsection\<open>Component Scalar Multiplication\<close> + +text\<open>Component scaling is an extension of component constant multiplication:\<close> +lemma hypext_scaleH: + "(*h* (\<lambda>x. k * x)) x = k *\<^sub>H x" + by (simp add: hyperdual_eq_iff) + +lemma hypext_fun_scaleH: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. k * f x)) x = k *\<^sub>H (*h* f) x" + using assms by (simp add: hypext_compose hypext_scaleH) + +text\<open>Unary minus is just an instance of constant multiplication:\<close> +lemma hypext_uminus: + "(*h* uminus) x = - x" + using hypext_scaleH[of "-1" x] by simp + +subsubsection\<open>Real Scalar Multiplication\<close> + +text\<open>Real scaling is an extension of component real scaling:\<close> +lemma hypext_scaleR: + "(*h* (\<lambda>x. k *\<^sub>R x)) x = k *\<^sub>R x" + by (auto simp add: hyperdual_eq_iff) + +lemma hypext_fun_scaleR: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. k *\<^sub>R f x)) x = k *\<^sub>R (*h* f) x" + using assms by (simp add: hypext_compose hypext_scaleR) + +subsubsection\<open>Addition\<close> + +text\<open>Addition of hyperdual extensions is a hyperdual extension of addition of functions.\<close> +lemma hypext_fun_add: + assumes "f twice_field_differentiable_at (Base x)" + and "g twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. f x + g x)) x = (*h* f) x + (*h* g) x" +proof (simp add: hyperdual_eq_iff distrib_left[symmetric], intro conjI disjI2) + show goal1: "deriv (\<lambda>x. f x + g x) (Base x) = deriv f (Base x) + deriv g (Base x)" + by (simp add: assms once_field_differentiable_at distrib_left) + then show "deriv (\<lambda>x. f x + g x) (Base x) = deriv f (Base x) + deriv g (Base x)" . + + have "deriv (deriv (\<lambda>x. f x + g x)) (Base x) = deriv (\<lambda>w. deriv f w + deriv g w) (Base x)" + by (simp add: assms deriv_cong_ev eventually_deriv_add) + moreover have "Eps12 x * deriv f (Base x) + Eps12 x * deriv g (Base x) = Eps12 x * deriv (\<lambda>x. f x + g x) (Base x)" + by (metis distrib_left goal1) + ultimately show "Eps12 x * deriv (\<lambda>x. f x + g x) (Base x) + + Eps1 x * Eps2 x * deriv (deriv (\<lambda>x. f x + g x)) (Base x) = + Eps12 x * deriv f (Base x) + Eps1 x * Eps2 x * deriv (deriv f) (Base x) + + (Eps12 x * deriv g (Base x) + Eps1 x * Eps2 x * deriv (deriv g) (Base x))" + using deriv_add[OF deriv_field_differentiable_at deriv_field_differentiable_at, OF assms] + by (simp add: distrib_left add.left_commute) +qed + +lemma hypext_cadd [simp]: + "(*h* (\<lambda>x. x + a)) x = x + of_comp a" + by (auto simp add: hyperdual_eq_iff of_comp_def) + +lemma hypext_fun_cadd: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. f x + a)) x = (*h* f) x + of_comp a" + using assms hypext_compose[of f x "\<lambda>x. x + a"] by simp + +subsubsection\<open>Component Linear Function\<close> + +text\<open>Hyperdual linear function is an extension of the component linear function:\<close> +lemma hypext_linear: + "(*h* (\<lambda>x. k * x + a)) x = k *\<^sub>H x + of_comp a" + using hypext_fun_add[of "(*) k" x "\<lambda>x. a"] + by (simp add: hypext_scaleH) + +lemma hypext_fun_linear: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. k * f x + a)) x = k *\<^sub>H (*h* f) x + of_comp a" + using assms hypext_compose[of f x "\<lambda>x. k * x + a"] by (simp add: hypext_linear) + +subsubsection\<open>Real Linear Function\<close> + +text\<open>We have the same for real scaling instead of component multiplication:\<close> +lemma hypext_linearR: + "(*h* (\<lambda>x. k *\<^sub>R x + a)) x = k *\<^sub>R x + of_comp a" + using hypext_fun_add[of "(*\<^sub>R) k" x "\<lambda>x. a"] + by (simp add: hypext_scaleR) + +lemma hypext_fun_linearR: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. k *\<^sub>R f x + a)) x = k *\<^sub>R (*h* f) x + of_comp a" + using assms hypext_compose[of f x "\<lambda>x. k *\<^sub>R x + a"] by (simp add: hypext_linearR) + +subsubsection\<open>Multiplication\<close> + +text\<open>Extension of multiplication is multiplication of the functions' extensions.\<close> +lemma hypext_fun_mult: + assumes "f twice_field_differentiable_at (Base x)" + and "g twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>z. f z * g z)) x = (*h* f) x * (*h* g) x" +proof (simp add: hyperdual_eq_iff distrib_left[symmetric], intro conjI) + show "Eps1 x * deriv (\<lambda>z. f z * g z) (Base x) = + f (Base x) * (Eps1 x * deriv g (Base x)) + Eps1 x * deriv f (Base x) * g (Base x)" + and "Eps2 x * deriv (\<lambda>z. f z * g z) (Base x) = + f (Base x) * (Eps2 x * deriv g (Base x)) + Eps2 x * deriv f (Base x) * g (Base x)" + using assms by (simp_all add: once_field_differentiable_at distrib_left) + + have + "deriv (deriv (\<lambda>z. f z * g z)) (Base x) = + f (Base x) * deriv (deriv g) (Base x) + 2 * deriv f (Base x) * deriv g (Base x) + deriv (deriv f) (Base x) * g (Base x)" + proof - + have "deriv (deriv (\<lambda>z. f z * g z)) (Base x) = deriv (\<lambda>z. f z * deriv g z + deriv f z * g z) (Base x)" + using assms by (simp add: eventually_deriv_mult deriv_cong_ev) + also have "... = (\<lambda>z. f z * deriv (deriv g) z + deriv f z * deriv g z + deriv f z * deriv g z + deriv (deriv f) z * g z) (Base x)" + by (simp add: assms deriv_field_differentiable_at field_differentiable_mult once_field_differentiable_at) + finally show ?thesis + by simp + qed + then show + "Eps12 x * deriv (\<lambda>z. f z * g z) (Base x) + Eps1 x * Eps2 x * deriv (deriv (\<lambda>z. f z * g z)) (Base x) = + 2 * (Eps1 x * (Eps2 x * (deriv f (Base x) * deriv g (Base x)))) + + f (Base x) * (Eps12 x * deriv g (Base x) + Eps1 x * Eps2 x * deriv (deriv g) (Base x)) + + (Eps12 x * deriv f (Base x) + Eps1 x * Eps2 x * deriv (deriv f) (Base x)) * g (Base x)" + using assms by (simp add: once_field_differentiable_at field_simps) +qed + +subsubsection\<open>Sine and Cosine\<close> + +text\<open>The extended sin and cos at an arbitrary hyperdual.\<close> + +lemma hypext_sin_Hyperdual: + "(*h* sin) (Hyperdual a b c d) = sin a *\<^sub>H ba + (b *cos a) *\<^sub>H e1 + (c * cos a) *\<^sub>H e2 + (d * cos a - b * c * sin a) *\<^sub>H e12 " + by (simp add: hypext_Hyperdual_eq_parts) + +lemma hypext_cos_Hyperdual: + "(*h* cos) (Hyperdual a b c d) = cos a *\<^sub>H ba - (b * sin a) *\<^sub>H e1 - (c * sin a) *\<^sub>H e2 - (d * sin a + b * c * cos a) *\<^sub>H e12 " +proof - + have "of_comp (- (d * sin a) - b * c * cos a) * e12 = - (of_comp (d * sin a + b * c * cos a) * e12)" + by (metis add_uminus_conv_diff minus_add_distrib mult_minus_left of_comp_minus) + then show ?thesis + by (simp add: hypext_Hyperdual_eq_parts of_comp_minus scaleH_times) +qed + +lemma Eps1_hypext_sin [simp]: + "Eps1 ((*h* sin) x) = Eps1 x * cos (Base x)" + by simp + +lemma Eps2_hypext_sin [simp]: + "Eps2 ((*h* sin) x) = Eps2 x * cos (Base x)" + by simp + +lemma Eps12_hypext_sin [simp]: + "Eps12 ((*h* sin) x) = Eps12 x * cos (Base x) - Eps1 x * Eps2 x * sin (Base x)" + by simp + +lemma hypext_sin_e1 [simp]: + "(*h* sin) (x * e1) = e1 * x" + by (simp add: e1_def hyperdual_eq_iff one_hyperdual_def) + +lemma hypext_sin_e2 [simp]: + "(*h* sin) (x * e2) = e2 * x" + by (simp add: e2_def hyperdual_eq_iff one_hyperdual_def) + +lemma hypext_sin_e12 [simp]: + "(*h* sin) (x * e12) = e12 * x" + by (simp add: e12_def hyperdual_eq_iff one_hyperdual_def) + +lemma hypext_cos_e1 [simp]: + "(*h* cos) (x * e1) = 1" + by (simp add: e1_def hyperdual_eq_iff one_hyperdual_def) + +lemma hypext_cos_e2 [simp]: + "(*h* cos) (x * e2) = 1" + by (simp add: e2_def hyperdual_eq_iff one_hyperdual_def) + +lemma hypext_cos_e12 [simp]: + "(*h* cos) (x * e12) = 1" + by (simp add: e12_def hyperdual_eq_iff one_hyperdual_def) + +text\<open>The extended sin and cos at @{term "\<beta> x"}.\<close> + +lemma hypext_sin_extract: + "(*h* sin) (\<beta> x) = sin x *\<^sub>H ba + cos x *\<^sub>H e1 + cos x *\<^sub>H e2 - sin x *\<^sub>H e12" + by (simp add: hypext_sin_Hyperdual of_comp_minus scaleH_times hyperdualx_def) + +lemma hypext_cos_extract: + "(*h* cos) (\<beta> x) = cos x *\<^sub>H ba - sin x *\<^sub>H e1 - sin x *\<^sub>H e2 - cos x *\<^sub>H e12" + by (simp add: hypext_cos_Hyperdual hyperdualx_def) + +text\<open>Extracting the extended sin components at @{term "\<beta> x"}.\<close> + +lemma Base_hypext_sin_extract [simp]: + "Base ((*h* sin) (\<beta> x)) = sin x" + by (rule Base_hypext) + +lemma Eps2_hypext_sin_extract [simp]: + "Eps2 ((*h* sin) (\<beta> x)) = cos x" + using Eps2_hypext[of sin] by simp + +lemma Eps12_hypext_sin_extract [simp]: + "Eps12 ((*h* sin) (\<beta> x)) = - sin x" + using Eps12_hypext[of sin] by simp + +text\<open>Extracting the extended cos components at @{term "\<beta> x"}.\<close> + +lemma Base_hypext_cos_extract [simp]: + "Base ((*h* cos) (\<beta> x)) = cos x" + by (rule Base_hypext) + +lemma Eps2_hypext_cos_extract [simp]: + "Eps2 ((*h* cos) (\<beta> x)) = - sin x" + using Eps2_hypext[of cos] by simp + +lemma Eps12_hypext_cos_extract [simp]: + "Eps12 ((*h* cos) (\<beta> x)) = - cos x" + using Eps12_hypext[of cos] by simp + +text\<open>We get one of the key trigonometric properties for the extensions of sin and cos.\<close> + +lemma "((*h* sin) x)\<^sup>2 + ((*h* cos) x)\<^sup>2 = 1" + by (simp add: hyperdual_eq_iff one_hyperdual_def power2_eq_square field_simps) + +(* example *) +lemma "(*h* sin) x + (*h* cos) x = (*h* (\<lambda>x. sin x + cos x)) x" + by (simp add: hypext_fun_add) + +subsubsection\<open>Exponential\<close> + +text\<open>The exponential function extension behaves as expected.\<close> + +lemma hypext_exp_Hyperdual: + "(*h* exp) (Hyperdual a b c d) = + exp a *\<^sub>H ba + (b * exp a) *\<^sub>H e1 + (c * exp a) *\<^sub>H e2 + (d * exp a + b * c * exp a) *\<^sub>H e12" + by (simp add: hypext_Hyperdual_eq_parts) + +lemma hypext_exp_extract: + "(*h* exp) (\<beta> x) = exp x *\<^sub>H ba + exp x *\<^sub>H e1 + exp x *\<^sub>H e2 + exp x *\<^sub>H e12" + by (simp add: hypext_extract_eq) + +lemma hypext_exp_e1 [simp]: + "(*h* exp) (x * e1) = 1 + e1 * x" + by (simp add: e1_def hyperdual_eq_iff) + +lemma hypext_exp_e2 [simp]: + "(*h* exp) (x * e2) = 1 + e2 * x" + by (simp add: e2_def hyperdual_eq_iff) + +lemma hypext_exp_e12 [simp]: + "(*h* exp) (x * e12) = 1 + e12 * x" + by (simp add: e12_def hyperdual_eq_iff) + +text\<open>Extracting the parts for the exponential function extension.\<close> + +lemma Eps1_hypext_exp_extract [simp]: + "Eps1 ((*h* exp) (\<beta> x)) = exp x" + using Eps1_hypext[of exp] by simp + +lemma Eps2_hypext_exp_extract [simp]: + "Eps2 ((*h* exp) (\<beta> x)) = exp x" + using Eps2_hypext[of exp] by simp + +lemma Eps12_hypext_exp_extract [simp]: + "Eps12 ((*h* exp) (\<beta> x)) = exp x" + using Eps12_hypext[of exp] by simp + +subsubsection\<open>Square Root\<close> +text\<open>Square root function extension.\<close> + +lemma hypext_sqrt_Hyperdual_Hyperdual: + assumes "a > 0" + shows "(*h* sqrt) (Hyperdual a b c d) = + Hyperdual (sqrt a) (b * inverse (sqrt a) / 2) (c * inverse (sqrt a) / 2) + (d * inverse (sqrt a) / 2 - b * c * inverse (sqrt a ^ 3) / 4)" + by (simp add: assms hypext_Hyperdual_eq) + +lemma hypext_sqrt_Hyperdual: + "a > 0 \<Longrightarrow> (*h* sqrt) (Hyperdual a b c d) = + sqrt a *\<^sub>H ba + (b * inverse (sqrt a) / 2) *\<^sub>H e1 + (c * inverse (sqrt a) / 2) *\<^sub>H e2 + + (d * inverse (sqrt a) / 2 - b * c * inverse (sqrt a ^ 3) / 4) *\<^sub>H e12" + by (auto simp add: hypext_Hyperdual_eq_parts) + +lemma hypext_sqrt_extract: + "x > 0 \<Longrightarrow> (*h* sqrt) (\<beta> x) = sqrt x *\<^sub>H ba + (inverse (sqrt x) / 2) *\<^sub>H e1 + + (inverse (sqrt x) / 2) *\<^sub>H e2 - (inverse (sqrt x ^ 3) / 4) *\<^sub>H e12" + by (simp add: hypext_sqrt_Hyperdual hyperdualx_def of_comp_minus scaleH_times) + +text\<open>Extracting the parts for the square root extension.\<close> + +lemma Eps1_hypext_sqrt_extract [simp]: + "x > 0 \<Longrightarrow> Eps1 ((*h* sqrt) (\<beta> x)) = inverse (sqrt x) / 2" + using Eps1_hypext[of sqrt] by simp + +lemma Eps2_hypext_sqrt_extract [simp]: + "x > 0 \<Longrightarrow> Eps2 ((*h* sqrt) (\<beta> x)) = inverse (sqrt x) / 2" + using Eps2_hypext[of sqrt] by simp + +lemma Eps12_hypext_sqrt_extract [simp]: + "x > 0 \<Longrightarrow> Eps12 ((*h* sqrt) (\<beta> x)) = - (inverse (sqrt x ^ 3) / 4)" + using Eps12_hypext[of sqrt] by simp + +(* example *) +lemma "Base x > 0 \<Longrightarrow> (*h* sin) x + (*h* sqrt) x = (*h* (\<lambda>x. sin x + sqrt x)) x" + by (simp add: hypext_fun_add) + +subsubsection\<open>Natural Power\<close> + +lemma hypext_power: + "(*h* (\<lambda>x. x ^ n)) x = x ^ n" + by (simp add: hyperdual_eq_iff hyperdual_power) + +lemma hypext_fun_power: + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. (f x) ^ n)) x = ((*h* f) x) ^ n" + using assms hypext_compose[of f x "\<lambda>x. x ^ n"] by (simp add: hypext_power) + +lemma hypext_power_Hyperdual: + "(*h* (\<lambda>x. x ^ n)) (Hyperdual a b c d) = + a ^ n *\<^sub>H ba + (of_nat n * b * a ^ (n - 1)) *\<^sub>H e1 + (of_nat n * c * a ^ (n - 1)) *\<^sub>H e2 + + (d * (of_nat n * a ^ (n - 1)) + b * c * (of_nat n * of_nat (n - 1) * a ^ (n - 2))) *\<^sub>H e12" + by (simp add: hypext_Hyperdual_eq_parts algebra_simps) + +lemma hypext_power_Hyperdual_parts: + "(*h* (\<lambda>x. x ^ n)) (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = + a ^ n *\<^sub>H ba + (of_nat n * b * a ^ (n - 1)) *\<^sub>H e1 + (of_nat n * c * a ^ (n - 1)) *\<^sub>H e2 + + (d * (of_nat n * a ^ (n - 1)) + b * c * (of_nat n * of_nat (n - 1) * a ^ (n - 2))) *\<^sub>H e12" + by (simp add: Hyperdual_eq [symmetric] hypext_power_Hyperdual) + +lemma hypext_power_extract: + "(*h* (\<lambda>x. x ^ n)) (\<beta> x) = + x ^ n *\<^sub>H ba + (of_nat n * x ^ (n - 1)) *\<^sub>H e1 + (of_nat n * x ^ (n - 1)) *\<^sub>H e2 + + (of_nat n * of_nat (n - 1) * x ^ (n - 2)) *\<^sub>H e12" + by (simp add: hypext_extract_eq) + +lemma Eps1_hypext_power [simp]: + "Eps1 ((*h* (\<lambda>x. x ^ n)) x) = of_nat n * Eps1 x * (Base x) ^ (n - 1)" + by simp + +lemma Eps2_hypext_power [simp]: + "Eps2 ((*h* (\<lambda>x. x ^ n)) x) = of_nat n * Eps2 x * (Base x) ^ (n - 1)" + by simp + +lemma Eps12_hypext_power [simp]: + "Eps12 ((*h* (\<lambda>x. x ^ n)) x) = + Eps12 x * (of_nat n * Base x ^ (n - 1)) + Eps1 x * Eps2 x * (of_nat n * of_nat (n - 1) * Base x ^ (n - 2))" + by simp + +subsubsection\<open>Inverse\<close> + +lemma hypext_inverse: + assumes "Base x \<noteq> 0" + shows "(*h* inverse) x = inverse x" + using assms by (simp add: hyperdual_eq_iff inverse_eq_divide) + +lemma hypext_fun_inverse: + assumes "f twice_field_differentiable_at (Base x)" + and "f (Base x) \<noteq> 0" + shows "(*h* (\<lambda>x. inverse (f x))) x = inverse ((*h* f) x)" + using assms hypext_compose[of f x inverse] by (simp add: hypext_inverse) + +lemma hypext_inverse_Hyperdual: + "a \<noteq> 0 \<Longrightarrow> + (*h* inverse) (Hyperdual a b c d) = + Hyperdual (inverse a) (- (b / a\<^sup>2)) (- (c / a\<^sup>2)) (2 * b * c / (a ^ 3) - d / a\<^sup>2)" + by (simp add: hypext_Hyperdual_eq divide_inverse) + +lemma hypext_inverse_Hyperdual_parts: + "a \<noteq> 0 \<Longrightarrow> + (*h* inverse) (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = + inverse a *\<^sub>H ba + - (b / a\<^sup>2) *\<^sub>H e1 + - (c / a\<^sup>2) *\<^sub>H e2 + (2 * b * c / a ^ 3 - d / a\<^sup>2) *\<^sub>H e12" + by (metis Hyperdual_eq hypext_inverse_Hyperdual) + +lemma inverse_Hyperdual_parts: + "(a::'a::real_normed_field) \<noteq> 0 \<Longrightarrow> + inverse (a *\<^sub>H ba + b *\<^sub>H e1 + c *\<^sub>H e2 + d *\<^sub>H e12) = + inverse a *\<^sub>H ba + - (b / a\<^sup>2) *\<^sub>H e1 + - (c / a\<^sup>2) *\<^sub>H e2 + (2 * b * c / a ^ 3 - d / a\<^sup>2) *\<^sub>H e12" + by (metis Hyperdual_eq hyperdual.sel(1) hypext_inverse hypext_inverse_Hyperdual_parts) + +lemma hypext_inverse_extract: + "x \<noteq> 0 \<Longrightarrow> (*h* inverse) (\<beta> x) = inverse x *\<^sub>H ba - (1 / x\<^sup>2) *\<^sub>H e1 - (1 / x\<^sup>2) *\<^sub>H e2 + (2 / x ^ 3) *\<^sub>H e12" + by (simp add: hypext_extract_eq divide_inverse of_comp_minus scaleH_times) + +lemma inverse_extract: + "x \<noteq> 0 \<Longrightarrow> inverse (\<beta> x) = inverse x *\<^sub>H ba - (1 / x\<^sup>2) *\<^sub>H e1 - (1 / x\<^sup>2) *\<^sub>H e2 + (2 / x ^ 3) *\<^sub>H e12" + by (metis hyperdual.sel(1) hyperdualx_def hypext_inverse hypext_inverse_extract) + +lemma Eps1_hypext_inverse [simp]: + "Base x \<noteq> 0 \<Longrightarrow> Eps1 ((*h* inverse) x) = - Eps1 x * (1 / (Base x)\<^sup>2)" + by simp +lemma Eps1_inverse [simp]: + "Base (x::'a::real_normed_field hyperdual) \<noteq> 0 \<Longrightarrow> Eps1 (inverse x) = - Eps1 x * (1 / (Base x)\<^sup>2)" + by simp + +lemma Eps2_hypext_inverse [simp]: + "Base (x::'a::real_normed_field hyperdual) \<noteq> 0 \<Longrightarrow> Eps2 (inverse x) = - Eps2 x * (1 / (Base x)\<^sup>2)" + by simp + +lemma Eps12_hypext_inverse [simp]: + "Base (x::'a::real_normed_field hyperdual) \<noteq> 0 + \<Longrightarrow> Eps12 (inverse x) = Eps1 x * Eps2 x * (2/ (Base x ^ 3)) - Eps12 x / (Base x)\<^sup>2" + by simp + +subsubsection\<open>Division\<close> + +lemma hypext_fun_divide: + assumes "f twice_field_differentiable_at (Base x)" + and "g twice_field_differentiable_at (Base x)" + and "g (Base x) \<noteq> 0" + shows "(*h* (\<lambda>x. f x / g x)) x = (*h* f) x / (*h* g) x" +proof - + have "(\<lambda>x. inverse (g x)) twice_field_differentiable_at Base x" + by (simp add: assms(2) assms(3) twice_field_differentiable_at_compose) + moreover have "(*h* f) x * (*h* (\<lambda>x. inverse (g x))) x = (*h* f) x * inverse ((*h* g) x)" + by (simp add: assms(2) assms(3) hypext_fun_inverse) + ultimately have "(*h* (\<lambda>x. f x * inverse (g x))) x = (*h* f) x * inverse ((*h* g) x)" + by (simp add: assms(1) hypext_fun_mult) + then show ?thesis + by (simp add: divide_inverse hyp_divide_inverse) +qed + +subsubsection\<open>Polynomial\<close> + +lemma hypext_polyn: + fixes coef :: "nat \<Rightarrow> 'a :: {real_normed_field}" + and n :: nat + shows "(*h* (\<lambda>x. \<Sum>i<n. coef i * x^i)) x = (\<Sum>i<n. (coef i) *\<^sub>H (x^i))" +proof (induction n) + case 0 + then show ?case + by (simp add: zero_hyperdual_def) +next + case hyp: (Suc n) + + have "(\<lambda>x. \<Sum>i<Suc n. coef i * x ^ i) = (\<lambda>x. (\<Sum>i<n. coef i * x ^ i) + coef n * x ^ n)" + and "(\<lambda>x. \<Sum>i<Suc n. coef i *\<^sub>H x ^ i) = (\<lambda>x. (\<Sum>i<n. coef i *\<^sub>H x ^ i) + coef n *\<^sub>H x ^ n)" + by (simp_all add: field_simps) + + then show ?case + proof (simp) + have "(\<lambda>x. coef n * x ^ n) twice_field_differentiable_at Base x" + using twice_field_differentiable_at_compose[of "\<lambda>x. x ^ n" "Base x" "(*) (coef n)"] + by simp + then have "(*h* (\<lambda>x. (\<Sum>i<n. coef i * x ^ i) + coef n * x ^ n)) x = + (*h* (\<lambda>x. (\<Sum>i<n. coef i * x ^ i))) x + (*h* (\<lambda>x. coef n * x ^ n)) x" + by (simp add: hypext_fun_add) + moreover have "(*h* (\<lambda>x. coef n * x ^ n)) x = coef n *\<^sub>H x ^ n" + by (simp add: hypext_fun_scaleH hypext_power) + ultimately have "(*h* (\<lambda>x. (\<Sum>i<n. coef i * x ^ i) + coef n * x ^ n)) x = (\<Sum>i<n. coef i *\<^sub>H x ^ i) + coef n *\<^sub>H x ^ n" + using hyp by simp + then show "(*h* (\<lambda>x. (\<Sum>i<n. coef i * x ^ i) + coef n * x ^ n)) x = (\<Sum>i<n. coef i *\<^sub>H x ^ i) + coef n *\<^sub>H x ^ n" + by simp + qed +qed + +lemma hypext_fun_polyn: + fixes coef :: "nat \<Rightarrow> 'a :: {real_normed_field}" + and n :: nat + assumes "f twice_field_differentiable_at (Base x)" + shows "(*h* (\<lambda>x. \<Sum>i<n. coef i * (f x)^i)) x = (\<Sum>i<n. (coef i) *\<^sub>H (((*h* f) x)^i))" + using assms hypext_compose[of f x "\<lambda>x. (\<Sum>i<n. coef i * x^i)"] by (simp add: hypext_polyn) + +end diff --git a/thys/Hyperdual/LogisticFunction.thy b/thys/Hyperdual/LogisticFunction.thy new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/LogisticFunction.thy @@ -0,0 +1,94 @@ +(* Title: LogisticFunction.thy + Author: Filip Smola, 2019-2021 +*) + +theory LogisticFunction + imports HyperdualFunctionExtension +begin + +subsection\<open>Logistic Function\<close> + +text\<open>Define the standard logistic function and its hyperdual variant:\<close> +definition logistic :: "real \<Rightarrow> real" + where "logistic x = inverse (1 + exp (-x))" +definition hyp_logistic :: "real hyperdual \<Rightarrow> real hyperdual" + where "hyp_logistic x = inverse (1 + (*h* exp) (-x))" + +text\<open>Hyperdual extension of the logistic function is its hyperdual variant:\<close> +lemma hypext_logistic: + "(*h* logistic) x = hyp_logistic x" +proof - + have "(*h* (\<lambda>x. exp (- x) + 1)) x = (*h* exp) (- x) + of_comp 1" + by (simp add: hypext_compose hypext_uminus hypext_fun_cadd twice_field_differentiable_at_compose) + then have "(*h* (\<lambda>x. 1 + exp (- x))) x = 1 + (*h* exp) (- x)" + by (simp add: one_hyperdual_def add.commute) + moreover have "1 + exp (- Base x) \<noteq> 0" + by (metis exp_ge_zero add_eq_0_iff neg_0_le_iff_le not_one_le_zero) + moreover have "(\<lambda>x. 1 + exp (- x)) twice_field_differentiable_at Base x" + proof - + have "(\<lambda>x. exp (- x)) twice_field_differentiable_at Base x" + by (simp add: twice_field_differentiable_at_compose) + then have "(\<lambda>x. exp (- x) + 1) twice_field_differentiable_at Base x" + using twice_field_differentiable_at_compose[of "\<lambda>x. exp (- x)" "Base x" "\<lambda>x. x + 1"] + by simp + then show ?thesis + by (simp add: add.commute) + qed + ultimately have "(*h* (\<lambda>x. inverse (1 + exp (- x)))) x = inverse (1 + (*h* exp) (- x))" + by (simp add: hypext_fun_inverse) + then show ?thesis + unfolding logistic_def hyp_logistic_def . +qed + +text\<open>From properties of autodiff we know it gives us the derivative:\<close> +lemma "Eps1 (hyp_logistic (\<beta> x)) = deriv logistic x" + by (metis Eps1_hypext hypext_logistic) +text\<open>which is equal to the known derivative of the standard logistic function:\<close> +lemma "First (autodiff logistic x) = exp (- x) / (1 + exp (- x)) ^ 2" + (* Move to hyperdual variant: *) + apply (simp only: autodiff.simps hyperdual_to_derivs.simps derivs.sel hypext_logistic) + (* Unfold extensions of functions that have a hyperdual variant (all except exp): *) + apply (simp only: hyp_logistic_def inverse_hyperdual.code hyperdual.sel) + (* Finish by expanding the extension of exp and hyperdual computations: *) + apply (simp add: hyperdualx_def hypext_exp_Hyperdual hyperdual_bases) + done + +text\<open>Similarly we can get the second derivative:\<close> +lemma "Second (autodiff logistic x) = deriv (deriv logistic) x" + by (rule autodiff_extract_second) +text\<open>and derive its value:\<close> +lemma "Second (autodiff logistic x) = ((exp (- x) - 1) * exp (- x)) / ((1 + exp (- x)) ^ 3)" + (* Move to hyperdual variant: *) + apply (simp only: autodiff.simps hyperdual_to_derivs.simps derivs.sel hypext_logistic) + (* Unfold extensions of functions that have a hyperdual variant (all except exp): *) + apply (simp only: hyp_logistic_def inverse_hyperdual.code hyperdual.sel) + (* Finish by expanding the extension of exp and hyperdual computations: *) + apply (simp add: hyperdualx_def hypext_exp_Hyperdual hyperdual_bases) + (* Simplify the resulting expression: *) +proof - + have + "2 * (exp (- x) * exp (- x)) / (1 + exp (- x)) ^ 3 - exp (- x) / (1 + exp (- x)) ^ 2 = + (2 * exp (- x) / (1 + exp (- x)) ^ 3 - 1 / (1 + exp (- x)) ^ 2) * exp (- x)" + by (simp add: field_simps) + also have "... = (2 * exp (- x) / (1 + exp (- x)) ^ 3 - (1 + exp (- x)) / (1 + exp (- x)) ^ 3) * exp (- x)" + proof - + have "inverse ((1 + exp (- x)) ^ 2) = inverse (1 + exp (- x)) ^ 2" + by (simp add: power_inverse) + also have "... = (1 + exp (- x)) * inverse (1 + exp (- x)) * inverse (1 + exp (- x)) ^ 2" + by (simp add: inverse_eq_divide) + also have "... = (1 + exp (- x)) * inverse (1 + exp (- x)) ^ 3" + by (simp add: power2_eq_square power3_eq_cube) + finally have "inverse ((1 + exp (- x)) ^ 2) = (1 + exp (- x)) * inverse ((1 + exp (- x)) ^ 3)" + by (simp add: power_inverse) + then show ?thesis + by (simp add: inverse_eq_divide) + qed + also have "... = (2 * exp (- x) - (1 + exp (- x))) / (1 + exp (- x)) ^ 3 * exp (- x)" + by (metis diff_divide_distrib) + finally show + "2 * (exp (- x) * exp (- x)) / (1 + exp (- x)) ^ 3 - exp (- x) / (1 + exp (- x))\<^sup>2 = + (exp (- x) - 1) * exp (- x) / (1 + exp (- x)) ^ 3" + by (simp add: field_simps) +qed + +end \ No newline at end of file diff --git a/thys/Hyperdual/ROOT b/thys/Hyperdual/ROOT new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/ROOT @@ -0,0 +1,15 @@ +chapter AFP + +session "Hyperdual" (AFP) = "HOL-Analysis" + + options [timeout = 600] + sessions + "HOL-Decision_Procs" + theories + Hyperdual + TwiceFieldDifferentiable + HyperdualFunctionExtension + LogisticFunction + AnalyticTestFunction + document_files + "root.tex" + "root.bib" diff --git a/thys/Hyperdual/TwiceFieldDifferentiable.thy b/thys/Hyperdual/TwiceFieldDifferentiable.thy new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/TwiceFieldDifferentiable.thy @@ -0,0 +1,741 @@ +(* Title: TwiceFieldDifferentiable.thy + Authors: Jacques Fleuriot and Filip Smola, University of Edinburgh, 2020 +*) + +section \<open>Twice Field Differentiable\<close> + +theory TwiceFieldDifferentiable + imports "HOL-Analysis.Analysis" +begin + +subsection\<open>Differentiability on a Set\<close> + +text\<open>A function is differentiable on a set iff it is differentiable at any point within that set.\<close> +definition field_differentiable_on :: "('a \<Rightarrow> 'a::real_normed_field) \<Rightarrow> 'a set \<Rightarrow> bool" + (infix "field'_differentiable'_on" 50) + where "f field_differentiable_on s \<equiv> \<forall>x\<in>s. f field_differentiable (at x within s)" + +text\<open>This is preserved for subsets.\<close> +lemma field_differentiable_on_subset: + assumes "f field_differentiable_on S" + and "T \<subseteq> S" + shows "f field_differentiable_on T" + by (meson assms field_differentiable_on_def field_differentiable_within_subset in_mono) + +subsection\<open>Twice Differentiability\<close> +text\<open> + Informally, a function is twice differentiable at x iff it is differentiable on some neighbourhood + of x and its derivative is differentiable at x. +\<close> +definition twice_field_differentiable_at :: "['a \<Rightarrow> 'a::real_normed_field, 'a ] \<Rightarrow> bool" + (infixr "(twice'_field'_differentiable'_at)" 50) + where "f twice_field_differentiable_at x \<equiv> + \<exists>S. f field_differentiable_on S \<and> x \<in> interior S \<and> (deriv f) field_differentiable (at x)" + +lemma once_field_differentiable_at: + "f twice_field_differentiable_at x \<Longrightarrow> f field_differentiable (at x)" + by (metis at_within_interior field_differentiable_on_def interior_subset subsetD twice_field_differentiable_at_def) + +lemma deriv_field_differentiable_at: + "f twice_field_differentiable_at x \<Longrightarrow> deriv f field_differentiable (at x)" + using twice_field_differentiable_at_def by blast + +text\<open> + For a composition of two functions twice differentiable at x, the chain rule eventually holds on + some neighbourhood of x. +\<close> +lemma eventually_deriv_compose: + assumes "\<exists>S. f field_differentiable_on S \<and> x \<in> interior S" + and "g twice_field_differentiable_at (f x)" + shows "\<forall>\<^sub>F x in nhds x. deriv (\<lambda>x. g (f x)) x = deriv g (f x) * deriv f x" +proof - + obtain S S' + where Df_on_S: "f field_differentiable_on S" and x_int_S: "x \<in> interior S" + and Dg_on_S': "g field_differentiable_on S'" and fx_int_S': "f x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + + let ?T = "{x \<in> interior S. f x \<in> interior S'}" + + have "continuous_on (interior S) f" + by (meson Df_on_S continuous_on_eq_continuous_within continuous_on_subset field_differentiable_imp_continuous_at + field_differentiable_on_def interior_subset) + then have "open (interior S \<inter> {x. f x \<in> interior S'})" + by (metis continuous_open_preimage open_interior vimage_def) + then have x_int_T: "x \<in> interior ?T" + by (metis (no_types) Collect_conj_eq Collect_mem_eq Int_Collect fx_int_S' interior_eq x_int_S) + moreover have Dg_on_fT: "g field_differentiable_on f`?T" + by (metis (no_types, lifting) Dg_on_S' field_differentiable_on_subset image_Collect_subsetI interior_subset) + moreover have Df_on_T: "f field_differentiable_on ?T" + using field_differentiable_on_subset Df_on_S + by (metis Collect_subset interior_subset) + moreover have "\<forall>x \<in> interior ?T. deriv (\<lambda>x. g (f x)) x = deriv g (f x) * deriv f x" + proof + fix x + assume x_int_T: "x \<in> interior ?T" + have "f field_differentiable at x" + by (metis (no_types, lifting) Df_on_T at_within_interior field_differentiable_on_def + interior_subset subsetD x_int_T) + moreover have "g field_differentiable at (f x)" + by (metis (no_types, lifting) Dg_on_S' at_within_interior field_differentiable_on_def + interior_subset mem_Collect_eq subsetD x_int_T) + ultimately have "deriv (g \<circ> f) x = deriv g (f x) * deriv f x" + using deriv_chain[of f x g] by simp + then show "deriv (\<lambda>x. g (f x)) x = deriv g (f x) * deriv f x" + by (simp add: comp_def) + qed + ultimately show ?thesis + using eventually_nhds by blast +qed + +lemma eventually_deriv_compose': + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at (f x)" + shows "\<forall>\<^sub>F x in nhds x. deriv (\<lambda>x. g (f x)) x = deriv g (f x) * deriv f x" + using assms eventually_deriv_compose twice_field_differentiable_at_def by blast + +text\<open>Composition of twice differentiable functions is twice differentiable.\<close> +lemma twice_field_differentiable_at_compose: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at (f x)" + shows "(\<lambda>x. g (f x)) twice_field_differentiable_at x" +proof - + obtain S S' + where Df_on_S: "f field_differentiable_on S" and x_int_S: "x \<in> interior S" + and Dg_on_S': "g field_differentiable_on S'" and fx_int_S': "f x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + + let ?T = "{x \<in> interior S. f x \<in> interior S'}" + + have "continuous_on (interior S) f" + by (meson Df_on_S continuous_on_eq_continuous_within continuous_on_subset field_differentiable_imp_continuous_at + field_differentiable_on_def interior_subset) + then have "open (interior S \<inter> {x. f x \<in> interior S'})" + by (metis continuous_open_preimage open_interior vimage_def) + then have x_int_T: "x \<in> interior ?T" + by (metis (no_types) Collect_conj_eq Collect_mem_eq Int_Collect fx_int_S' interior_eq x_int_S) + + have Dg_on_fT: "g field_differentiable_on f`?T" + by (metis (no_types, lifting) Dg_on_S' field_differentiable_on_subset image_Collect_subsetI interior_subset) + + have Df_on_T: "f field_differentiable_on ?T" + using field_differentiable_on_subset Df_on_S + by (metis Collect_subset interior_subset) + + have "(\<lambda>x. g (f x)) field_differentiable_on ?T" + unfolding field_differentiable_on_def + proof + fix x assume x_int: "x \<in> {x \<in> interior S. f x \<in> interior S'}" + have "f field_differentiable at x" + by (metis Df_on_S at_within_interior field_differentiable_on_def interior_subset mem_Collect_eq subsetD x_int) + moreover have "g field_differentiable at (f x)" + by (metis Dg_on_S' at_within_interior field_differentiable_on_def interior_subset mem_Collect_eq subsetD x_int) + ultimately have "(g \<circ> f) field_differentiable at x" + by (simp add: field_differentiable_compose) + then have "(\<lambda>x. g (f x)) field_differentiable at x" + by (simp add: comp_def) + then show "(\<lambda>x. g (f x)) field_differentiable at x within {x \<in> interior S. f x \<in> interior S'}" + using field_differentiable_at_within by blast + qed + moreover have "deriv (\<lambda>x. g (f x)) field_differentiable at x" + proof - + have "(\<lambda>x. deriv g (f x)) field_differentiable at x" + by (metis DERIV_chain2 assms deriv_field_differentiable_at field_differentiable_def once_field_differentiable_at) + then have "(\<lambda>x. deriv g (f x) * deriv f x) field_differentiable at x" + using assms field_differentiable_mult[of "\<lambda>x. deriv g (f x)"] + by (simp add: deriv_field_differentiable_at) + moreover have "deriv (deriv (\<lambda>x. g (f x))) x = deriv (\<lambda>x. deriv g (f x) * deriv f x) x" + using assms Df_on_S x_int_S deriv_cong_ev eventually_deriv_compose by fastforce + ultimately show ?thesis + using assms eventually_deriv_compose DERIV_deriv_iff_field_differentiable Df_on_S x_int_S + DERIV_cong_ev[of x x "deriv (\<lambda>x. g (f x))" "\<lambda>x. deriv g (f x) * deriv f x"] + by blast + qed + ultimately show ?thesis + using twice_field_differentiable_at_def x_int_T by blast +qed + +subsubsection\<open>Constant\<close> +lemma twice_field_differentiable_at_const [simp, intro]: + "(\<lambda>x. a) twice_field_differentiable_at x" + by (auto intro: exI [of _ UNIV] simp add: twice_field_differentiable_at_def field_differentiable_on_def) + +subsubsection\<open>Identity\<close> +lemma twice_field_differentiable_at_ident [simp, intro]: + "(\<lambda>x. x) twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (\<lambda>x. x) field_differentiable at x" + and "deriv ((\<lambda>x. x)) field_differentiable at x" + by simp_all + then show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by fastforce +qed + +subsubsection\<open>Constant Multiplication\<close> +lemma twice_field_differentiable_at_cmult [simp, intro]: +"(*) k twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (*) k field_differentiable at x" + by simp + moreover have "deriv ((*) k) field_differentiable at x" + by simp + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by fastforce +qed + +lemma twice_field_differentiable_at_uminus [simp, intro]: + "uminus twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. uminus field_differentiable at x" + by (simp add: field_differentiable_minus) + moreover have "deriv uminus field_differentiable at x" + by simp + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +lemma twice_field_differentiable_at_uminus_fun [intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. - f x) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +subsubsection\<open>Real Scaling\<close> + +lemma deriv_scaleR_right_id [simp]: + "(deriv ((*\<^sub>R) k)) = (\<lambda>z. k *\<^sub>R 1)" + using DERIV_imp_deriv has_field_derivative_scaleR_right DERIV_ident by blast + +lemma deriv_deriv_scaleR_right_id [simp]: + "deriv (deriv ((*\<^sub>R) k)) = (\<lambda>z. 0)" + by simp + +lemma deriv_scaleR_right: + "f field_differentiable (at z) \<Longrightarrow> deriv (\<lambda>x. k *\<^sub>R f x) z = k *\<^sub>R deriv f z" + by (simp add: DERIV_imp_deriv field_differentiable_derivI has_field_derivative_scaleR_right) + +lemma field_differentiable_scaleR_right [intro]: + "f field_differentiable F \<Longrightarrow> (\<lambda>x. c *\<^sub>R f x) field_differentiable F" + using field_differentiable_def has_field_derivative_scaleR_right by blast + +lemma has_field_derivative_scaleR_deriv_right: + assumes "f twice_field_differentiable_at z" + shows "((\<lambda>x. k *\<^sub>R deriv f x) has_field_derivative k *\<^sub>R deriv (deriv f) z) (at z)" + by (simp add: DERIV_deriv_iff_field_differentiable assms deriv_field_differentiable_at has_field_derivative_scaleR_right) + +lemma deriv_scaleR_deriv_right: + assumes "f twice_field_differentiable_at z" + shows "deriv (\<lambda>x. k *\<^sub>R deriv f x) z = k *\<^sub>R deriv (deriv f) z" + using assms deriv_scaleR_right twice_field_differentiable_at_def by blast + +lemma twice_field_differentiable_at_scaleR [simp, intro]: + "(*\<^sub>R) k twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (*\<^sub>R) k field_differentiable at x" + by (simp add: field_differentiable_scaleR_right) + moreover have "deriv ((*\<^sub>R) k) field_differentiable at x" + by simp + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +lemma twice_field_differentiable_at_scaleR_fun [simp, intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. k *\<^sub>R f x) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +subsubsection\<open>Addition\<close> + +lemma eventually_deriv_add: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at x" + shows "\<forall>\<^sub>F x in nhds x. deriv (\<lambda>x. f x + g x) x = deriv f x + deriv g x" +proof - + obtain S where Df_on_S: "f field_differentiable_on S" and x_int_S: "x \<in> interior S" + using assms twice_field_differentiable_at_def by blast + obtain S' where Dg_on_S: "g field_differentiable_on S'" and x_int_S': "x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + have "x \<in> interior (S \<inter> S')" + by (simp add: x_int_S x_int_S') + moreover have Df_on_SS': "f field_differentiable_on (S \<inter> S')" + by (meson Df_on_S IntD1 field_differentiable_on_def field_differentiable_within_subset inf_sup_ord(1)) + moreover have Dg_on_SS': "g field_differentiable_on (S \<inter> S')" + by (meson Dg_on_S IntD2 field_differentiable_on_def field_differentiable_within_subset inf_le2) + moreover have "open (interior (S \<inter> S'))" + by blast + moreover have "\<forall>x\<in> interior (S \<inter> S'). deriv (\<lambda>x. f x + g x) x = deriv f x + deriv g x" + by (metis (full_types) Df_on_SS' Dg_on_SS' at_within_interior deriv_add field_differentiable_on_def in_mono interior_subset) + ultimately show ?thesis + using eventually_nhds by blast +qed + +lemma twice_field_differentiable_at_add [intro]: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at x" + shows "(\<lambda>x. f x + g x) twice_field_differentiable_at x" +proof - + obtain S S' + where Df_on_S: "f field_differentiable_on S" and x_int_S: "x \<in> interior S" + and Dg_on_S': "g field_differentiable_on S'" and x_int_S': " x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + + let ?T = "interior (S \<inter> S')" + + have x_int_T: "x \<in> interior ?T" + by (simp add: x_int_S x_int_S') + + have Df_on_T: "f field_differentiable_on ?T" + by (meson Df_on_S field_differentiable_on_subset inf_sup_ord(1) interior_subset) + have Dg_on_fT: "g field_differentiable_on ?T" + by (meson Dg_on_S' field_differentiable_on_subset interior_subset le_infE) + + have "(\<lambda>x. f x + g x) field_differentiable_on ?T" + unfolding field_differentiable_on_def + proof + fix x assume x_in_T: "x \<in> ?T" + have "f field_differentiable at x" + by (metis x_in_T Df_on_T at_within_open field_differentiable_on_def open_interior) + moreover have "g field_differentiable at x" + by (metis x_in_T Dg_on_fT at_within_open field_differentiable_on_def open_interior) + ultimately have "(\<lambda>x. f x + g x) field_differentiable at x" + by (simp add: field_differentiable_add) + then show "(\<lambda>x. f x + g x) field_differentiable at x within ?T" + using field_differentiable_at_within by blast + qed + moreover have "deriv (\<lambda>x. f x + g x) field_differentiable at x" + proof - + have "deriv (\<lambda>x. f x + g x) x = deriv f x + deriv g x" + by (simp add: assms once_field_differentiable_at) + moreover have "(\<lambda>x. deriv f x + deriv g x) field_differentiable at x" + by (simp add: field_differentiable_add assms deriv_field_differentiable_at) + ultimately show ?thesis + using assms DERIV_deriv_iff_field_differentiable + DERIV_cong_ev[of x x "deriv (\<lambda>x. f x + g x)" "\<lambda>x. deriv f x + deriv g x"] + by (simp add: eventually_deriv_add field_differentiable_def) + qed + ultimately show ?thesis + using twice_field_differentiable_at_def x_int_T by blast +qed + +lemma deriv_add_id_const [simp]: + "deriv (\<lambda>x. x + a) = (\<lambda>z. 1)" + using ext trans[OF deriv_add] by force + +lemma deriv_deriv_add_id_const [simp]: + "deriv (deriv (\<lambda>x. x + a)) z = 0" + by simp + +lemma twice_field_differentiable_at_cadd [simp]: + "(\<lambda>x. x + a) twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (\<lambda>x. x + a) field_differentiable at x" + by (simp add: field_differentiable_add) + moreover have "deriv ((\<lambda>x. x + a)) field_differentiable at x" + by (simp add: ext) + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +subsubsection\<open>Linear Function\<close> +lemma twice_field_differentiable_at_linear [simp, intro]: + "(\<lambda>x. k * x + a) twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (\<lambda>x. k * x + a) field_differentiable at x" + by (simp add: field_differentiable_add) + moreover have "deriv ((\<lambda>x. k * x + a)) field_differentiable at x" + proof - + have "deriv ((\<lambda>x. k * x + a)) = (\<lambda>x. k)" + by (simp add: ext) + then show ?thesis + by simp + qed + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +lemma twice_field_differentiable_at_linearR [simp, intro]: + "(\<lambda>x. k *\<^sub>R x + a) twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (\<lambda>x. k *\<^sub>R x + a) field_differentiable at x" + by (simp add: field_differentiable_scaleR_right field_differentiable_add) + moreover have "deriv ((\<lambda>x. k *\<^sub>R x + a)) field_differentiable at x" + proof - + have "deriv ((\<lambda>x. k *\<^sub>R x + a)) = (\<lambda>x. k *\<^sub>R 1)" + by (simp add: ext once_field_differentiable_at) + then show ?thesis + by simp + qed + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +subsubsection\<open>Multiplication\<close> + +lemma eventually_deriv_mult: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at x" + shows "\<forall>\<^sub>F x in nhds x. deriv (\<lambda>x. f x * g x) x = f x * deriv g x + deriv f x * g x" +proof - + obtain S and S' + where "f field_differentiable_on S" and in_S: "x \<in> interior S" + and "g field_differentiable_on S'" and in_S': "x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + then have Df_on_SS': "f field_differentiable_on (S \<inter> S')" + and Dg_on_SS': "g field_differentiable_on (S \<inter> S')" + using field_differentiable_on_subset by blast+ + + have "\<forall>x\<in> interior (S \<inter> S'). deriv (\<lambda>x. f x * g x) x = f x * deriv g x + deriv f x * g x" + proof + fix x assume "x \<in> interior (S \<inter> S')" + then have "f field_differentiable (at x)" + and "g field_differentiable (at x)" + using Df_on_SS' Dg_on_SS' field_differentiable_on_def at_within_interior interior_subset subsetD by metis+ + then show "deriv (\<lambda>x. f x * g x) x = f x * deriv g x + deriv f x * g x" + by simp + qed + moreover have "x \<in> interior (S \<inter> S')" + by (simp add: in_S in_S') + moreover have "open (interior (S \<inter> S'))" + by blast + ultimately show ?thesis + using eventually_nhds by blast +qed + +lemma twice_field_differentiable_at_mult [intro]: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at x" + shows "(\<lambda>x. f x * g x) twice_field_differentiable_at x" +proof - + obtain S S' + where Df_on_S: "f field_differentiable_on S" and x_int_S: "x \<in> interior S" + and Dg_on_S': "g field_differentiable_on S'" and x_int_S': " x \<in> interior S'" + using assms twice_field_differentiable_at_def by blast + + let ?T = "interior (S \<inter> S')" + + have x_int_T: "x \<in> interior ?T" + by (simp add: x_int_S x_int_S') + + have Df_on_T: "f field_differentiable_on ?T" + by (meson Df_on_S field_differentiable_on_subset inf_sup_ord(1) interior_subset) + have Dg_on_fT: "g field_differentiable_on ?T" + by (meson Dg_on_S' field_differentiable_on_subset interior_subset le_infE) + + have "(\<lambda>x. f x * g x) field_differentiable_on ?T" + unfolding field_differentiable_on_def + proof + fix x assume x_in_T: "x \<in> ?T" + have "f field_differentiable at x" + by (metis x_in_T Df_on_T at_within_open field_differentiable_on_def open_interior) + moreover have "g field_differentiable at x" + by (metis x_in_T Dg_on_fT at_within_open field_differentiable_on_def open_interior) + ultimately have "(\<lambda>x. f x * g x) field_differentiable at x" + by (simp add: field_differentiable_mult) + then show "(\<lambda>x. f x * g x) field_differentiable at x within ?T" + using field_differentiable_at_within by blast + qed + moreover have "deriv (\<lambda>x. f x * g x) field_differentiable at x" + proof - + have "deriv (\<lambda>x. f x * g x) x = f x * deriv g x + deriv f x * g x" + by (simp add: assms once_field_differentiable_at) + moreover have "(\<lambda>x. f x * deriv g x + deriv f x * g x) field_differentiable at x" + by (rule field_differentiable_add, simp_all add: field_differentiable_mult assms once_field_differentiable_at deriv_field_differentiable_at) + ultimately show ?thesis + using assms DERIV_deriv_iff_field_differentiable + DERIV_cong_ev[of x x "deriv (\<lambda>x. f x * g x)" "\<lambda>x. f x * deriv g x + deriv f x * g x"] + by (simp add: eventually_deriv_mult field_differentiable_def) + qed + ultimately show ?thesis + using twice_field_differentiable_at_def x_int_T by blast +qed + +subsubsection\<open>Sine and Cosine\<close> + +lemma deriv_sin [simp]: "deriv sin a = cos a" + by (simp add: DERIV_imp_deriv) + +lemma deriv_sinf [simp]: "deriv sin = (\<lambda>x. cos x)" + by auto + +lemma deriv_cos [simp]: "deriv cos a = - sin a" + by (simp add: DERIV_imp_deriv) + +lemma deriv_cosf [simp]: "deriv cos = (\<lambda>x. - sin x)" + by auto + +lemma deriv_sin_minus [simp]: + "deriv (\<lambda>x. - sin x) a = - deriv (\<lambda>x. sin x) a" + by (simp add: DERIV_imp_deriv Deriv.field_differentiable_minus) + +lemma twice_field_differentiable_at_sin [simp, intro]: + "sin twice_field_differentiable_at x" + by (auto intro!: exI [of _ UNIV] simp add: field_differentiable_at_sin + field_differentiable_on_def twice_field_differentiable_at_def field_differentiable_at_cos) + +lemma twice_field_differentiable_at_sin_fun [intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. sin (f x)) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +lemma twice_field_differentiable_at_cos [simp, intro]: + "cos twice_field_differentiable_at x" + by (auto intro!: exI [of _ UNIV] simp add: field_differentiable_within_sin field_differentiable_minus + field_differentiable_on_def twice_field_differentiable_at_def field_differentiable_at_cos) + +lemma twice_field_differentiable_at_cos_fun [intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. cos (f x)) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +subsubsection\<open>Exponential\<close> + +lemma deriv_exp [simp]: "deriv exp x = exp x" + using DERIV_exp DERIV_imp_deriv by blast + +lemma deriv_expf [simp]: "deriv exp = exp" + by (simp add: ext) + +lemma deriv_deriv_exp [simp]: "deriv (deriv exp) x = exp x" + by simp + +lemma twice_field_differentiable_at_exp [simp, intro]: + "exp twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. exp field_differentiable at x" + and "deriv exp field_differentiable at x" + by (simp_all add: field_differentiable_within_exp) + then show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by auto +qed + +lemma twice_field_differentiable_at_exp_fun [simp, intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. exp (f x)) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +subsubsection\<open>Square Root\<close> + +lemma deriv_real_sqrt [simp]: "x > 0 \<Longrightarrow> deriv sqrt x = inverse (sqrt x) / 2" + using DERIV_imp_deriv DERIV_real_sqrt by blast + +lemma has_real_derivative_inverse_sqrt: + assumes "x > 0" + shows "((\<lambda>x. inverse (sqrt x) / 2) has_real_derivative - (inverse (sqrt x ^ 3) / 4)) (at x)" +proof - + have inv_sqrt_mult: "(inverse (sqrt x)/2) * (sqrt x * 2) = 1" + using assms by simp + have inv_sqrt_mult2: "(- inverse ((sqrt x)^3)/2)* x * (sqrt x * 2) = -1" + using assms by (simp add: field_simps power3_eq_cube) + then show ?thesis + using assms by (safe intro!: DERIV_imp_deriv derivative_eq_intros) + (auto intro: derivative_eq_intros inv_sqrt_mult [THEN ssubst] inv_sqrt_mult2 [THEN ssubst] + simp add: divide_simps power3_eq_cube) +qed + +lemma deriv_deriv_real_sqrt': + assumes "x > 0" + shows "deriv (\<lambda>x. inverse (sqrt x) / 2) x = - inverse ((sqrt x)^3)/4" + by (simp add: DERIV_imp_deriv assms has_real_derivative_inverse_sqrt) + +lemma has_real_derivative_deriv_sqrt: + assumes "x > 0" + shows "(deriv sqrt has_real_derivative - inverse (sqrt x ^ 3) / 4) (at x)" +proof - + have "((\<lambda>x. inverse (sqrt x) / 2) has_real_derivative - inverse (sqrt x ^ 3) / 4) (at x)" + using assms has_real_derivative_inverse_sqrt by auto + moreover + {fix xa :: real + assume "xa \<in> {0<..}" + then have "inverse (sqrt xa) / 2 = deriv sqrt xa" + by simp + } + ultimately show ?thesis + using has_field_derivative_transform_within_open [where S="{0 <..}" and f="(\<lambda>x. inverse (sqrt x) / 2)"] + by (meson assms greaterThan_iff open_greaterThan) +qed + +lemma deriv_deriv_real_sqrt [simp]: + assumes "x > 0" + shows "deriv(deriv sqrt) x = - inverse ((sqrt x)^3)/4" + using DERIV_imp_deriv assms has_real_derivative_deriv_sqrt by blast + +lemma twice_field_differentiable_at_sqrt [simp, intro]: + assumes "x > 0" + shows "sqrt twice_field_differentiable_at x" +proof - + have "sqrt field_differentiable_on {0<..}" + by (metis DERIV_real_sqrt at_within_open field_differentiable_def field_differentiable_on_def + greaterThan_iff open_greaterThan) + moreover have "x \<in> interior {0<..}" + by (metis assms greaterThan_iff interior_interior interior_real_atLeast) + moreover have "deriv sqrt field_differentiable at x" + using assms field_differentiable_def has_real_derivative_deriv_sqrt by blast + ultimately show ?thesis + using twice_field_differentiable_at_def by blast +qed + +lemma twice_field_differentiable_at_sqrt_fun [intro]: + assumes "f twice_field_differentiable_at x" + and "f x > 0" + shows "(\<lambda>x. sqrt (f x)) twice_field_differentiable_at x" + by (simp add: assms(1) assms(2) twice_field_differentiable_at_compose) + +subsubsection\<open>Natural Power\<close> + +lemma field_differentiable_power [simp]: + "(\<lambda>x. x ^ n) field_differentiable at x" + using DERIV_power DERIV_ident field_differentiable_def + by blast + +lemma deriv_power_fun [simp]: + assumes "f field_differentiable at x" + shows "deriv (\<lambda>x. f x ^ n) x = of_nat n * deriv f x * f x ^ (n - 1)" + using DERIV_power[of f "deriv f x"] + by (simp add: DERIV_imp_deriv assms field_differentiable_derivI mult.assoc [symmetric]) + +lemma deriv_power [simp]: + "deriv (\<lambda>x. x ^ n) x = of_nat n * x ^ (n - 1)" + using DERIV_power[of "\<lambda>x. x" 1] DERIV_imp_deriv by force + +lemma deriv_deriv_power [simp]: + "deriv (deriv (\<lambda>x. x ^ n)) x = of_nat n * of_nat (n - Suc 0) * x ^ (n - 2)" +proof - + have "(\<lambda>x. x ^ (n - 1)) field_differentiable at x" + by simp + then have "deriv (\<lambda>x. of_nat n * x ^ (n - 1)) x = of_nat n * of_nat (n - Suc 0) * x ^ (n - 2)" + by (simp add: diff_diff_add mult.assoc numeral_2_eq_2) + then show ?thesis + by (simp add: ext[OF deriv_power]) +qed + +lemma twice_field_differentiable_at_power [simp, intro]: + "(\<lambda>x. x ^ n) twice_field_differentiable_at x" +proof - + have "\<forall>x\<in>UNIV. (\<lambda>x. x ^ n) field_differentiable at x" + by simp + moreover have "deriv ((\<lambda>x. x ^ n)) field_differentiable at x" + proof - + have "deriv ((\<lambda>x. x ^ n)) = (\<lambda>x. of_nat n * x ^ (n - 1))" + by (simp add: ext) + then show ?thesis + using field_differentiable_mult[of "\<lambda>x. of_nat n" x UNIV "\<lambda>x. x ^ (n - 1)"] + by (simp add: field_differentiable_caratheodory_at) + qed + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by force +qed + +lemma twice_field_differentiable_at_power_fun [intro]: + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. f x ^ n) twice_field_differentiable_at x" + by (blast intro: assms twice_field_differentiable_at_compose [OF _ twice_field_differentiable_at_power]) + +subsubsection\<open>Inverse\<close> + +lemma eventually_deriv_inverse: + assumes "x \<noteq> 0" + shows "\<forall>\<^sub>F x in nhds x. deriv inverse x = - 1 / (x ^ 2)" +proof - + obtain T where open_T: "open T" and "\<forall>z\<in>T. z \<noteq> 0" and x_in_T: "x \<in> T" + using assms t1_space by blast + + then have "\<forall>x \<in> T. deriv inverse x = - 1 / (x ^ 2)" + by simp + then show ?thesis + using eventually_nhds open_T x_in_T by blast +qed + +lemma deriv_deriv_inverse [simp]: + assumes "x \<noteq> 0" + shows "deriv (deriv inverse) x = 2 * inverse (x ^ 3)" +proof - + have "deriv (\<lambda>x. inverse (x ^ 2)) x = - (of_nat 2 * x) / ((x ^ 2) ^ 2)" + using assms by simp + moreover have "(\<lambda>x. inverse (x ^ 2)) field_differentiable at x" + using assms by (simp add: field_differentiable_inverse) + ultimately have "deriv (\<lambda>x. - (inverse (x ^ 2))) x = of_nat 2 * x / (x ^ 4)" + using deriv_chain[of "\<lambda>x. inverse (x ^ 2)" x] + by (simp add: comp_def field_differentiable_minus field_simps) + then have "deriv (\<lambda>x. - 1 / (x ^ 2)) x = 2 * inverse (x ^ 3)" + by (simp add: power4_eq_xxxx power3_eq_cube field_simps) + then show ?thesis + using assms eventually_deriv_inverse deriv_cong_ev by fastforce +qed + +lemma twice_field_differentiable_at_inverse [simp, intro]: + assumes "x \<noteq> 0" + shows "inverse twice_field_differentiable_at x" +proof - + obtain T where zero_T: "0 \<notin> T" and x_in_T: "x \<in> T" and open_T: "open T" + using assms t1_space by blast + then have "T \<subseteq> {z. z \<noteq> 0}" + by blast + then have "\<forall>x\<in>T. inverse field_differentiable at x within T" + using DERIV_inverse field_differentiable_def by blast + moreover have "deriv inverse field_differentiable at x" + proof - + have "(\<lambda>x. - inverse (x ^ 2)) field_differentiable at x" + using assms by (simp add: field_differentiable_inverse field_differentiable_minus) + then have "(\<lambda>x. - 1 / (x ^ 2)) field_differentiable at x" + by (simp add: inverse_eq_divide) + then show ?thesis + using eventually_deriv_inverse[OF assms] + by (simp add: DERIV_cong_ev field_differentiable_def) + qed + moreover have "x \<in> interior T" + by (simp add: x_in_T open_T interior_open) + ultimately show ?thesis + unfolding twice_field_differentiable_at_def field_differentiable_on_def + by blast +qed + +lemma twice_field_differentiable_at_inverse_fun [simp, intro]: + assumes "f twice_field_differentiable_at x" + "f x \<noteq> 0" + shows "(\<lambda>x. inverse (f x)) twice_field_differentiable_at x" + by (simp add: assms twice_field_differentiable_at_compose) + +lemma twice_field_differentiable_at_divide [intro]: + assumes "f twice_field_differentiable_at x" + and "g twice_field_differentiable_at x" + and "g x \<noteq> 0" + shows "(\<lambda>x. f x / g x) twice_field_differentiable_at x" + by (simp add: assms divide_inverse twice_field_differentiable_at_mult) + +subsubsection\<open>Polynomial\<close> + +lemma twice_field_differentiable_at_polyn [simp, intro]: + fixes coef :: "nat \<Rightarrow> 'a :: {real_normed_field}" + and n :: nat + shows "(\<lambda>x. \<Sum>i<n. coef i * x ^ i) twice_field_differentiable_at x" +proof (induction n) + case 0 + then show ?case + by simp +next + case hyp: (Suc n) + show ?case + proof (simp, rule twice_field_differentiable_at_add) + show "(\<lambda>x. \<Sum>i<n. coef i * x ^ i) twice_field_differentiable_at x" + by (rule hyp) + show "(\<lambda>x. coef n * x ^ n) twice_field_differentiable_at x" + using twice_field_differentiable_at_compose[of "\<lambda>x. x ^ n" x "(*) (coef n)"] + by simp + qed +qed + +lemma twice_field_differentiable_at_polyn_fun [simp]: + fixes coef :: "nat \<Rightarrow> 'a :: {real_normed_field}" + and n :: nat + assumes "f twice_field_differentiable_at x" + shows "(\<lambda>x. \<Sum>i<n. coef i * f x ^ i) twice_field_differentiable_at x" + by (blast intro: assms twice_field_differentiable_at_compose [OF _ twice_field_differentiable_at_polyn]) + +end diff --git a/thys/Hyperdual/document/root.bib b/thys/Hyperdual/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/document/root.bib @@ -0,0 +1,6 @@ +@InProceedings{fike_alonso-2011, + author={{Fike}, J.~A. and {Alonso}, J.~J.}, + title={The Development of Hyper-Dual Numbers for Exact Second-Derivative Calculations}, + booktitle={AIAA paper 2011-886, 49th AIAA Aerospace Sciences Meeting}, + year=2011 +} diff --git a/thys/Hyperdual/document/root.tex b/thys/Hyperdual/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Hyperdual/document/root.tex @@ -0,0 +1,70 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amsmath} +\usepackage{amssymb} + %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>, + %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>, + %\<triangleq>, \<yen>, \<lozenge> + +%\usepackage{eurosym} + %for \<euro> + +%\usepackage[only,bigsqcap]{stmaryrd} + %for \<Sqinter> + +%\usepackage{eufrak} + %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb) + +%\usepackage{textcomp} + %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>, + %\<currency> + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Hyperdual Numbers and Forward Differentiation} +\author{Filip Smola, Jacques Fleuriot} +\maketitle + +\begin{abstract} + Hyperdual numbers are ones with a real component and a number of infinitesimal components, usually written as $a_0 + a_1 \cdot \epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$. + They have been proposed by Fike and Alonso~\cite{fike_alonso-2011} in an approach to automatic differentiation. + + In this entry we formalise hyperdual numbers and their application to forward differentiation. + We show them to be an instance of multiple algebraic structures and then, along with facts about twice-differentiability, we define what we call the hyperdual extensions of functions on real-normed fields. + This extension formally represents the proposed way that the first and second derivatives of a function can be automatically calculated. + We demonstrate it on the standard logistic function $f(x) = \frac{1}{1 + e^{-x}}$ and also reproduce the example analytic function $f(x) = \frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike and Alonso. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Knights_Tour/KnightsTour.thy b/thys/Knights_Tour/KnightsTour.thy new file mode 100755 --- /dev/null +++ b/thys/Knights_Tour/KnightsTour.thy @@ -0,0 +1,3531 @@ +(* Author: Lukas Koller *) + +theory KnightsTour + imports Main +begin + +section \<open>Introduction and Definitions\<close> + +text \<open>A Knight's path is a sequence of moves on a chessboard s.t.\ every step in sequence is a +valid move for a Knight and that the Knight visits every square on the boards exactly once. +A Knight is a chess figure that is only able to move two squares vertically and one square +horizontally or two squares horizontally and one square vertically. Finding a Knight's path is an +instance of the Hamiltonian Path Problem. A Knight's circuit is a Knight's path, where additionally +the Knight can move from the last square to the first square of the path, forming a loop. + +Cull and De Curtins @{cite "cull_decurtins_1987"} prove the existence of a Knight's path on a \<open>n\<times>m\<close>-board for +sufficiently large \<open>n\<close> and \<open>m\<close>. The main idea for the proof is to inductivly construct a Knight's +path for the \<open>n\<times>m\<close>-board from a few pre-computed Knight's paths for small boards, i.e. \<open>5\<times>5\<close>, +\<open>8\<times>6\<close>, ..., \<open>8\<times>9\<close>. The paths for small boards are transformed (i.e. transpose, mirror, translate) +and concatenated to create paths for larger boards. + +While formalizing the proofs I discovered two mistakes in the original proof in +@{cite "cull_decurtins_1987"}: (i) the pre-computed path for the \<open>6\<times>6\<close>-board that ends in +the upper-left (in Figure 2) and (ii) the pre-computed path for the \<open>8\<times>8\<close>-board that ends in +the upper-left (in Figure 5) are incorrect: on the \<open>6\<times>6\<close>-board the Knight cannot step +from square 26 to square 27; in the \<open>8\<times>8\<close>-board the Knight cannot step from square 27 to +square 28. In this formalization I have replaced the two incorrect paths with correct paths.\<close> + +text \<open>A square on a board is identified by its coordinates.\<close> +type_synonym square = "int \<times> int" +text \<open>A board is represented as a set of squares. Note, that this allows boards to have an +arbitrary shape and do not necessarily need to be rectangular.\<close> +type_synonym board = "square set" + +text \<open>A (rectangular) \<open>(n\<times>m)\<close>-board is the set of all squares \<open>(i,j)\<close> where \<open>1 \<le> i \<le> n\<close> +and \<open>1 \<le> j \<le> m\<close>. \<open>(1,1)\<close> is the lower-left corner, and \<open>(n,m)\<close> is the upper-right corner.\<close> +definition board :: "nat \<Rightarrow> nat \<Rightarrow> board" where + "board n m = {(i,j) |i j. 1 \<le> i \<and> i \<le> int n \<and> 1 \<le> j \<and> j \<le> int m}" + +text \<open>A path is a sequence of steps on a board. A path is represented by the list of visited +squares on the board. Each square on the \<open>(n\<times>m)\<close>-board is identified by its coordinates \<open>(i,j)\<close>.\<close> +type_synonym path = "square list" + +text \<open>A Knight can only move two squares vertically and one square horizontally or two squares +horizontally and one square vertically. Thus, a knight at position \<open>(i,j)\<close> can only move +to \<open>(i\<plusminus>1,j\<plusminus>2)\<close> or \<open>(i\<plusminus>2,j\<plusminus>1)\<close>.\<close> +definition valid_step :: "square \<Rightarrow> square \<Rightarrow> bool" where + "valid_step s\<^sub>i s\<^sub>j \<equiv> (case s\<^sub>i of (i,j) \<Rightarrow> s\<^sub>j \<in> {(i+1,j+2),(i-1,j+2),(i+1,j-2),(i-1,j-2), + (i+2,j+1),(i-2,j+1),(i+2,j-1),(i-2,j-1)})" + +text \<open>Now we define an inductive predicate that characterizes a Knight's path. A square \<open>s\<^sub>i\<close> can be +pre-pended to a current Knight's path \<open>s\<^sub>j#ps\<close> if (i) there is a valid step from the square \<open>s\<^sub>i\<close> to +the first square \<open>s\<^sub>j\<close> of the current path and (ii) the square \<open>s\<^sub>i\<close> has not been visited yet.\<close> +inductive knights_path :: "board \<Rightarrow> path \<Rightarrow> bool" where + "knights_path {s\<^sub>i} [s\<^sub>i]" +| "s\<^sub>i \<notin> b \<Longrightarrow> valid_step s\<^sub>i s\<^sub>j \<Longrightarrow> knights_path b (s\<^sub>j#ps) \<Longrightarrow> knights_path (b \<union> {s\<^sub>i}) (s\<^sub>i#s\<^sub>j#ps)" + +code_pred knights_path . + +text \<open>A sequence is a Knight's circuit iff the sequence if a Knight's path and there is a valid +step from the last square to the first square.\<close> +definition "knights_circuit b ps \<equiv> (knights_path b ps \<and> valid_step (last ps) (hd ps))" + +section \<open>Executable Checker for a Knight's Path\<close> + +text \<open>This section gives the implementation and correctness-proof for an executable checker for a +knights-path w.r.t.\ the definition @{const knights_path}.\<close> + +subsection \<open>Implementation of an Executable Checker\<close> + +fun row_exec :: "nat \<Rightarrow> int set" where + "row_exec 0 = {}" +| "row_exec m = insert (int m) (row_exec (m-1))" + +fun board_exec_aux :: "nat \<Rightarrow> int set \<Rightarrow> board" where + "board_exec_aux 0 M = {}" +| "board_exec_aux k M = {(int k,j) |j. j \<in> M} \<union> board_exec_aux (k-1) M" + +text \<open>Compute a board.\<close> +fun board_exec :: "nat \<Rightarrow> nat \<Rightarrow> board" where + "board_exec n m = board_exec_aux n (row_exec m)" + +fun step_checker :: "square \<Rightarrow> square \<Rightarrow> bool" where + "step_checker (i,j) (i',j') = + ((i+1,j+2) = (i',j') \<or> (i-1,j+2) = (i',j') \<or> (i+1,j-2) = (i',j') \<or> (i-1,j-2) = (i',j') + \<or> (i+2,j+1) = (i',j') \<or> (i-2,j+1) = (i',j') \<or> (i+2,j-1) = (i',j') \<or> (i-2,j-1) = (i',j'))" + +fun path_checker :: "board \<Rightarrow> path \<Rightarrow> bool" where + "path_checker b [] = False" +| "path_checker b [s\<^sub>i] = ({s\<^sub>i} = b)" +| "path_checker b (s\<^sub>i#s\<^sub>j#ps) = (s\<^sub>i \<in> b \<and> step_checker s\<^sub>i s\<^sub>j \<and> path_checker (b - {s\<^sub>i}) (s\<^sub>j#ps))" + +fun circuit_checker :: "board \<Rightarrow> path \<Rightarrow> bool" where + "circuit_checker b ps = (path_checker b ps \<and> step_checker (last ps) (hd ps))" + +subsection \<open>Correctness Proof of the Executable Checker\<close> + +lemma row_exec_leq: "j \<in> row_exec m \<longleftrightarrow> 1 \<le> j \<and> j \<le> int m" + by (induction m) auto + +lemma board_exec_aux_leq_mem: "(i,j) \<in> board_exec_aux k M \<longleftrightarrow> 1 \<le> i \<and> i \<le> int k \<and> j \<in> M" + by (induction k M rule: board_exec_aux.induct) auto + +lemma board_exec_leq: "(i,j) \<in> board_exec n m \<longleftrightarrow> 1 \<le> i \<and> i \<le> int n \<and> 1 \<le> j \<and> j \<le> int m" + using board_exec_aux_leq_mem row_exec_leq by auto + +lemma board_exec_correct: "board n m = board_exec n m" + unfolding board_def using board_exec_leq by auto + +lemma step_checker_correct: "step_checker s\<^sub>i s\<^sub>j \<longleftrightarrow> valid_step s\<^sub>i s\<^sub>j" +proof + assume "step_checker s\<^sub>i s\<^sub>j" + then show "valid_step s\<^sub>i s\<^sub>j" + unfolding valid_step_def + apply (cases s\<^sub>i) + apply (cases s\<^sub>j) + apply auto + done +next + assume assms: "valid_step s\<^sub>i s\<^sub>j" + then show "step_checker s\<^sub>i s\<^sub>j" + unfolding valid_step_def by auto +qed + +lemma step_checker_rev: "step_checker (i,j) (i',j') \<Longrightarrow> step_checker (i',j') (i,j)" + apply (simp only: step_checker.simps) + by (elim disjE) auto + +lemma knights_path_intro_rev: + assumes "s\<^sub>i \<in> b" "valid_step s\<^sub>i s\<^sub>j" "knights_path (b - {s\<^sub>i}) (s\<^sub>j#ps)" + shows "knights_path b (s\<^sub>i#s\<^sub>j#ps)" + using assms +proof - + assume assms: "s\<^sub>i \<in> b" "valid_step s\<^sub>i s\<^sub>j" "knights_path (b - {s\<^sub>i}) (s\<^sub>j#ps)" + then have "s\<^sub>i \<notin> (b - {s\<^sub>i})" "b - {s\<^sub>i} \<union> {s\<^sub>i} = b" + by auto + then show ?thesis + using assms knights_path.intros(2)[of s\<^sub>i "b - {s\<^sub>i}"] by auto +qed + +text \<open>Final correctness corollary for the executable checker @{const path_checker}.\<close> +lemma path_checker_correct: "path_checker b ps \<longleftrightarrow> knights_path b ps" +proof + assume "path_checker b ps" + then show "knights_path b ps" + proof (induction rule: path_checker.induct) + case (3 s\<^sub>i s\<^sub>j xs b) + then show ?case using step_checker_correct knights_path_intro_rev by auto + qed (auto intro: knights_path.intros) +next + assume "knights_path b ps" + then show "path_checker b ps" + using step_checker_correct + by (induction rule: knights_path.induct) (auto elim: knights_path.cases) +qed + +corollary knights_path_exec_simp: "knights_path (board n m) ps \<longleftrightarrow> path_checker (board_exec n m) ps" + using board_exec_correct path_checker_correct[symmetric] by simp + +lemma circuit_checker_correct: "circuit_checker b ps \<longleftrightarrow> knights_circuit b ps" + unfolding knights_circuit_def using path_checker_correct step_checker_correct by auto + +corollary knights_circuit_exec_simp: + "knights_circuit (board n m) ps \<longleftrightarrow> circuit_checker (board_exec n m) ps" + using board_exec_correct circuit_checker_correct[symmetric] by simp + +section \<open>Basic Properties of @{const knights_path} and @{const knights_circuit}\<close> + +lemma board_leq_subset: "n\<^sub>1 \<le> n\<^sub>2 \<and> m\<^sub>1 \<le> m\<^sub>2 \<Longrightarrow> board n\<^sub>1 m\<^sub>1 \<subseteq> board n\<^sub>2 m\<^sub>2" + unfolding board_def by auto + +lemma finite_row_exec: "finite (row_exec m)" + by (induction m) auto + +lemma finite_board_exec_aux: "finite M \<Longrightarrow> finite (board_exec_aux n M)" + by (induction n) auto + +lemma board_finite: "finite (board n m)" + using finite_board_exec_aux finite_row_exec by (simp only: board_exec_correct) auto + +lemma card_row_exec: "card (row_exec m) = m" +proof (induction m) + case (Suc m) + have "int (Suc m) \<notin> row_exec m" + using row_exec_leq by auto + then have "card (insert (int (Suc m)) (row_exec m)) = 1 + card (row_exec m)" + using card_Suc_eq by (metis Suc plus_1_eq_Suc row_exec.simps(1)) + then have "card (row_exec (Suc m)) = 1 + card (row_exec m)" + by auto + then show ?case using Suc.IH by auto +qed auto + +lemma set_comp_ins: + "{(k,j) |j. j \<in> insert x M} = insert (k,x) {(k,j) |j. j \<in> M}" (is "?Mi = ?iM") +proof + show "?Mi \<subseteq> ?iM" + proof + fix y assume "y \<in> ?Mi" + then obtain j where [simp]: "y = (k,j)" and "j \<in> insert x M" by blast + then have "j = x \<or> j \<in> M" by auto + then show "y \<in> ?iM" by (elim disjE) auto + qed +next + show "?iM \<subseteq> ?Mi" + proof + fix y assume "y \<in> ?iM" + then obtain j where [simp]: "y = (k,j)" and "j \<in> insert x M" by blast + then have "j = x \<or> j \<in> M" by auto + then show "y \<in> ?Mi" by (elim disjE) auto + qed +qed + +lemma finite_card_set_comp: "finite M \<Longrightarrow> card {(k,j) |j. j \<in> M} = card M" +proof (induction M rule: finite_induct) + case (insert x M) + then show ?case using set_comp_ins[of k x M] by auto +qed auto + +lemma card_board_exec_aux: "finite M \<Longrightarrow> card (board_exec_aux k M) = k * card M" +proof (induction k) + case (Suc k) + let ?M'="{(int (Suc k),j) |j. j \<in> M}" + let ?rec_k="board_exec_aux k M" + + have finite: "finite ?M'" "finite ?rec_k" + using Suc finite_board_exec_aux by auto + then have card_Un_simp: "card (?M' \<union> ?rec_k) = card ?M' + card ?rec_k" + using board_exec_aux_leq_mem card_Un_Int[of ?M' ?rec_k] by auto + + have card_M: "card ?M' = card M" + using Suc finite_card_set_comp by auto + + have "card (board_exec_aux (Suc k) M) = card ?M' + card ?rec_k" + using card_Un_simp by auto + also have "... = card M + k * card M" + using Suc card_M by auto + also have "... = (Suc k) * card M" + by auto + finally show ?case . +qed auto + +lemma card_board: "card (board n m) = n * m" +proof - + have "card (board n m) = card (board_exec_aux n (row_exec m))" + using board_exec_correct by auto + also have "... = n * m" + using card_row_exec card_board_exec_aux finite_row_exec by auto + finally show ?thesis . +qed + +lemma knights_path_board_non_empty: "knights_path b ps \<Longrightarrow> b \<noteq> {}" + by (induction arbitrary: ps rule: knights_path.induct) auto + +lemma knights_path_board_m_n_geq_1: "knights_path (board n m) ps \<Longrightarrow> min n m \<ge> 1" + unfolding board_def using knights_path_board_non_empty by fastforce + +lemma knights_path_non_nil: "knights_path b ps \<Longrightarrow> ps \<noteq> []" + by (induction arbitrary: b rule: knights_path.induct) auto + +lemma knights_path_set_eq: "knights_path b ps \<Longrightarrow> set ps = b" + by (induction rule: knights_path.induct) auto + +lemma knights_path_subset: + "knights_path b\<^sub>1 ps\<^sub>1 \<Longrightarrow> knights_path b\<^sub>2 ps\<^sub>2 \<Longrightarrow> set ps\<^sub>1 \<subseteq> set ps\<^sub>2 \<longleftrightarrow> b\<^sub>1 \<subseteq> b\<^sub>2" + using knights_path_set_eq by auto + +lemma knights_path_board_unique: "knights_path b\<^sub>1 ps \<Longrightarrow> knights_path b\<^sub>2 ps \<Longrightarrow> b\<^sub>1 = b\<^sub>2" + using knights_path_set_eq by auto + +lemma valid_step_neq: "valid_step s\<^sub>i s\<^sub>j \<Longrightarrow> s\<^sub>i \<noteq> s\<^sub>j" + unfolding valid_step_def by auto + +lemma valid_step_non_transitive: "valid_step s\<^sub>i s\<^sub>j \<Longrightarrow> valid_step s\<^sub>j s\<^sub>k \<Longrightarrow> \<not>valid_step s\<^sub>i s\<^sub>k" +proof - + assume assms: "valid_step s\<^sub>i s\<^sub>j" "valid_step s\<^sub>j s\<^sub>k" + obtain i\<^sub>i j\<^sub>i i\<^sub>j j\<^sub>j i\<^sub>k j\<^sub>k where [simp]: "s\<^sub>i = (i\<^sub>i,j\<^sub>i)" "s\<^sub>j = (i\<^sub>j,j\<^sub>j)" "s\<^sub>k = (i\<^sub>k,j\<^sub>k)" by force + then have "step_checker (i\<^sub>i,j\<^sub>i) (i\<^sub>j,j\<^sub>j)" "step_checker (i\<^sub>j,j\<^sub>j) (i\<^sub>k,j\<^sub>k)" + using assms step_checker_correct by auto + then show "\<not>valid_step s\<^sub>i s\<^sub>k" + apply (simp add: step_checker_correct[symmetric]) + apply (elim disjE) + apply auto + done +qed + +lemma knights_path_distinct: "knights_path b ps \<Longrightarrow> distinct ps" +proof (induction rule: knights_path.induct) + case (2 s\<^sub>i b s\<^sub>j ps) + then have "s\<^sub>i \<notin> set (s\<^sub>j # ps)" + using knights_path_set_eq valid_step_neq by blast + then show ?case using 2 by auto +qed auto + +lemma knights_path_length: "knights_path b ps \<Longrightarrow> length ps = card b" + using knights_path_set_eq knights_path_distinct by (metis distinct_card) + +lemma knights_path_take: + assumes "knights_path b ps" "0 < k" "k < length ps" + shows "knights_path (set (take k ps)) (take k ps)" + using assms +proof (induction arbitrary: k rule: knights_path.induct) + case (2 s\<^sub>i b s\<^sub>j ps) + then have "k = 1 \<or> k = 2 \<or> 2 < k" by force + then show ?case + using 2 + proof (elim disjE) + assume "k = 2" + then have "take k (s\<^sub>i#s\<^sub>j#ps) = [s\<^sub>i,s\<^sub>j]" "s\<^sub>i \<notin> {s\<^sub>j}" using 2 valid_step_neq by auto + then show ?thesis using 2 knights_path.intros by auto + next + assume "2 < k" + then have k_simps: "k-2 = k-1-1" "0 < k-2" "k-2 < length ps" and + take_simp1: "take k (s\<^sub>i#s\<^sub>j#ps) = s\<^sub>i#take (k-1) (s\<^sub>j#ps)" and + take_simp2: "take k (s\<^sub>i#s\<^sub>j#ps) = s\<^sub>i#s\<^sub>j#take (k-1-1) ps" + using assms 2 take_Cons'[of k s\<^sub>i "s\<^sub>j#ps"] take_Cons'[of "k-1" s\<^sub>j ps] by auto + then have "knights_path (set (take (k-1) (s\<^sub>j#ps))) (take (k-1) (s\<^sub>j#ps))" + using 2 k_simps by auto + then have kp: "knights_path (set (take (k-1) (s\<^sub>j#ps))) (s\<^sub>j#take (k-2) ps)" + using take_Cons'[of "k-1" s\<^sub>j ps] by (auto simp: k_simps elim: knights_path.cases) + + have no_mem: "s\<^sub>i \<notin> set (take (k-1) (s\<^sub>j#ps))" + using 2 set_take_subset[of "k-1" "s\<^sub>j#ps"] knights_path_set_eq by blast + have "knights_path (set (take (k-1) (s\<^sub>j#ps)) \<union> {s\<^sub>i}) (s\<^sub>i#s\<^sub>j#take (k-2) ps)" + using knights_path.intros(2)[OF no_mem \<open>valid_step s\<^sub>i s\<^sub>j\<close> kp] by auto + then show ?thesis using k_simps take_simp2 knights_path_set_eq by metis + qed (auto intro: knights_path.intros) +qed auto + +lemma knights_path_drop: + assumes "knights_path b ps" "0 < k" "k < length ps" + shows "knights_path (set (drop k ps)) (drop k ps)" + using assms +proof (induction arbitrary: k rule: knights_path.induct) + case (2 s\<^sub>i b s\<^sub>j ps) + then have "(k = 1 \<and> ps = []) \<or> (k = 1 \<and> ps \<noteq> []) \<or> 1 < k" by force + then show ?case + using 2 + proof (elim disjE) + assume "k = 1 \<and> ps \<noteq> []" + then show ?thesis using 2 knights_path_set_eq by force + next + assume "1 < k" + then have "0 < k-1" "k-1 < length (s\<^sub>j#ps)" "drop k (s\<^sub>i#s\<^sub>j#ps) = drop (k-1) (s\<^sub>j#ps)" + using assms 2 drop_Cons'[of k s\<^sub>i "s\<^sub>j#ps"] by auto + then show ?thesis + using 2 by auto + qed (auto intro: knights_path.intros) +qed auto + +text \<open>A Knight's path can be split to form two new disjoint Knight's paths.\<close> +corollary knights_path_split: + assumes "knights_path b ps" "0 < k" "k < length ps" + shows + "\<exists>b\<^sub>1 b\<^sub>2. knights_path b\<^sub>1 (take k ps) \<and> knights_path b\<^sub>2 (drop k ps) \<and> b\<^sub>1 \<union> b\<^sub>2 = b \<and> b\<^sub>1 \<inter> b\<^sub>2 = {}" + using assms +proof - + let ?b\<^sub>1="set (take k ps)" + let ?b\<^sub>2="set (drop k ps)" + have kp1: "knights_path ?b\<^sub>1 (take k ps)" and kp2: "knights_path ?b\<^sub>2 (drop k ps)" + using assms knights_path_take knights_path_drop by auto + have union: "?b\<^sub>1 \<union> ?b\<^sub>2 = b" + using assms knights_path_set_eq by (metis append_take_drop_id set_append) + have inter: "?b\<^sub>1 \<inter> ?b\<^sub>2 = {}" + using assms knights_path_distinct by (metis append_take_drop_id distinct_append) + show ?thesis using kp1 kp2 union inter by auto +qed + +text \<open>Append two disjoint Knight's paths.\<close> +corollary knights_path_append: + assumes "knights_path b\<^sub>1 ps\<^sub>1" "knights_path b\<^sub>2 ps\<^sub>2" "b\<^sub>1 \<inter> b\<^sub>2 = {}" "valid_step (last ps\<^sub>1) (hd ps\<^sub>2)" + shows "knights_path (b\<^sub>1 \<union> b\<^sub>2) (ps\<^sub>1 @ ps\<^sub>2)" + using assms +proof (induction arbitrary: ps\<^sub>2 b\<^sub>2 rule: knights_path.induct) + case (1 s\<^sub>i) + then have "s\<^sub>i \<notin> b\<^sub>2" "ps\<^sub>2 \<noteq> []" "valid_step s\<^sub>i (hd ps\<^sub>2)" "knights_path b\<^sub>2 (hd ps\<^sub>2#tl ps\<^sub>2)" + using knights_path_non_nil by auto + then have "knights_path (b\<^sub>2 \<union> {s\<^sub>i}) (s\<^sub>i#hd ps\<^sub>2#tl ps\<^sub>2)" + using knights_path.intros by blast + then show ?case using \<open>ps\<^sub>2 \<noteq> []\<close> by auto +next + case (2 s\<^sub>i b\<^sub>1 s\<^sub>j ps\<^sub>1) + then have "s\<^sub>i \<notin> b\<^sub>1 \<union> b\<^sub>2" "valid_step s\<^sub>i s\<^sub>j" "knights_path (b\<^sub>1 \<union> b\<^sub>2) (s\<^sub>j#ps\<^sub>1@ps\<^sub>2)" by auto + then have "knights_path (b\<^sub>1 \<union> b\<^sub>2 \<union> {s\<^sub>i}) (s\<^sub>i#s\<^sub>j#ps\<^sub>1@ps\<^sub>2)" + using knights_path.intros by auto + then show ?case by auto +qed + +lemma valid_step_rev: "valid_step s\<^sub>i s\<^sub>j \<Longrightarrow> valid_step s\<^sub>j s\<^sub>i" + using step_checker_correct step_checker_rev by (metis prod.exhaust_sel) + +text \<open>Reverse a Knight's path.\<close> +corollary knights_path_rev: + assumes "knights_path b ps" + shows "knights_path b (rev ps)" + using assms +proof (induction rule: knights_path.induct) + case (2 s\<^sub>i b s\<^sub>j ps) + then have "knights_path {s\<^sub>i} [s\<^sub>i]" "b \<inter> {s\<^sub>i} = {}" "valid_step (last (rev (s\<^sub>j # ps))) (hd [s\<^sub>i])" + using valid_step_rev by (auto intro: knights_path.intros) + then have "knights_path (b \<union> {s\<^sub>i}) ((rev (s\<^sub>j#ps))@[s\<^sub>i])" + using 2 knights_path_append by blast + then show ?case by auto +qed (auto intro: knights_path.intros) + +text \<open>Reverse a Knight's circuit.\<close> +corollary knights_circuit_rev: + assumes "knights_circuit b ps" + shows "knights_circuit b (rev ps)" + using assms knights_path_rev valid_step_rev + unfolding knights_circuit_def by (auto simp: hd_rev last_rev) + +(* Function to rotate a Knight's circuit to start with (1,1),(3,2),... *) +(* fun rot_c_acc :: "path \<Rightarrow> path \<Rightarrow> path" where + "rot_c_acc (s\<^sub>i#s\<^sub>j#ps) acc = + (if s\<^sub>i = (1,1) then + if s\<^sub>j = (3,2) then s\<^sub>i#rev (s\<^sub>j#ps@acc) else s\<^sub>i#s\<^sub>j#ps@acc + else rot_c_acc (s\<^sub>j#ps) (s\<^sub>i#acc))" +| "rot_c_acc _ acc = []" + +definition "rot_c ps \<equiv> rot_c_acc ps []" *) + +lemma knights_circuit_rotate1: + assumes "knights_circuit b (s\<^sub>i#ps)" + shows "knights_circuit b (ps@[s\<^sub>i])" +proof (cases "ps = []") + case True + then show ?thesis using assms by auto +next + case False + have kp1: "knights_path b (s\<^sub>i#ps)" "valid_step (last (s\<^sub>i#ps)) (hd (s\<^sub>i#ps))" + using assms unfolding knights_circuit_def by auto + then have kp_elim: "s\<^sub>i \<notin> (b - {s\<^sub>i})" "valid_step s\<^sub>i (hd ps)" "knights_path (b - {s\<^sub>i}) ps" + using \<open>ps \<noteq> []\<close> by (auto elim: knights_path.cases) + then have vs': "valid_step (last (ps@[s\<^sub>i])) (hd (ps@[s\<^sub>i]))" + using \<open>ps \<noteq> []\<close> valid_step_rev by auto + + have kp2: "knights_path {s\<^sub>i} [s\<^sub>i]" "(b - {s\<^sub>i}) \<inter> {s\<^sub>i} = {}" + by (auto intro: knights_path.intros) + + have vs: "valid_step (last ps) (hd [s\<^sub>i])" + using \<open>ps \<noteq> []\<close> \<open>valid_step (last (s\<^sub>i#ps)) (hd (s\<^sub>i#ps))\<close> by auto + + have "(b - {s\<^sub>i}) \<union> {s\<^sub>i} = b" + using kp1 kp_elim knights_path_set_eq by force + then show ?thesis + unfolding knights_circuit_def + using vs knights_path_append[OF \<open>knights_path (b - {s\<^sub>i}) ps\<close> kp2] vs' by auto +qed + +text \<open>A Knight's circuit can be rotated to start at any square on the board.\<close> +lemma knights_circuit_rotate_to: + assumes "knights_circuit b ps" "hd (drop k ps) = s\<^sub>i" "k < length ps" + shows "\<exists>ps'. knights_circuit b ps' \<and> hd ps' = s\<^sub>i" + using assms +proof (induction k arbitrary: b ps) + case (Suc k) + let ?s\<^sub>j="hd ps" + let ?ps'="tl ps" + show ?case + proof (cases "s\<^sub>i = ?s\<^sub>j") + case True + then show ?thesis using Suc by auto + next + case False + then have "?ps' \<noteq> []" + using Suc by (metis drop_Nil drop_Suc drop_eq_Nil2 le_antisym nat_less_le) + then have "knights_circuit b (?s\<^sub>j#?ps')" + using Suc by (metis list.exhaust_sel tl_Nil) + then have "knights_circuit b (?ps'@[?s\<^sub>j])" "hd (drop k (?ps'@[?s\<^sub>j])) = s\<^sub>i" + using Suc knights_circuit_rotate1 by (auto simp: drop_Suc) + then show ?thesis using Suc by auto + qed +qed auto + +text \<open>For positive boards (1,1) can only have (2,3) and (3,2) as a neighbour.\<close> +lemma valid_step_1_1: + assumes "valid_step (1,1) (i,j)" "i > 0" "j > 0" + shows "(i,j) = (2,3) \<or> (i,j) = (3,2)" + using assms unfolding valid_step_def by auto + +lemma list_len_g_1_split: "length xs > 1 \<Longrightarrow> \<exists>x\<^sub>1 x\<^sub>2 xs'. xs = x\<^sub>1#x\<^sub>2#xs'" +proof (induction xs) + case (Cons x xs) + then have "length xs > 0" by auto + then have "length xs \<ge> 1" by presburger + then have "length xs = 1 \<or> length xs > 1" by auto + then show ?case + proof (elim disjE) + assume "length xs = 1" + then obtain x\<^sub>1 where [simp]: "xs = [x\<^sub>1]" + using length_Suc_conv[of xs 0] by auto + then show ?thesis by auto + next + assume "1 < length xs" + then show ?thesis using Cons by auto + qed +qed auto + +lemma list_len_g_3_split: "length xs > 3 \<Longrightarrow> \<exists>x\<^sub>1 x\<^sub>2 xs' x\<^sub>3. xs = x\<^sub>1#x\<^sub>2#xs'@[x\<^sub>3]" +proof (induction xs) + case (Cons x xs) + then have "length xs = 3 \<or> length xs > 3" by auto + then show ?case + proof (elim disjE) + assume "length xs = 3" + then obtain x\<^sub>1 xs\<^sub>1 where [simp]: "xs = x\<^sub>1#xs\<^sub>1" "length xs\<^sub>1 = 2" + using length_Suc_conv[of xs 2] by auto + then obtain x\<^sub>2 xs\<^sub>2 where [simp]: "xs\<^sub>1 = x\<^sub>2#xs\<^sub>2" "length xs\<^sub>2 = 1" + using length_Suc_conv[of xs\<^sub>1 1] by auto + then obtain x\<^sub>3 where [simp]: "xs\<^sub>2 = [x\<^sub>3]" + using length_Suc_conv[of xs\<^sub>2 0] by auto + then show ?thesis by auto + next + assume "length xs > 3" + then show ?thesis using Cons by auto + qed +qed auto + +text \<open>Any Knight's circuit on a positive board can be rotated to start with (1,1) and +end with (3,2).\<close> +corollary rotate_knights_circuit: + assumes "knights_circuit (board n m) ps" "min n m \<ge> 5" + shows "\<exists>ps. knights_circuit (board n m) ps \<and> hd ps = (1,1) \<and> last ps = (3,2)" + using assms +proof - + let ?b="board n m" + have "knights_path ?b ps" + using assms unfolding knights_circuit_def by auto + then have "(1,1) \<in> set ps" + using assms knights_path_set_eq by (auto simp: board_def) + then obtain k where "hd (drop k ps) = (1,1)" "k < length ps" + by (metis hd_drop_conv_nth in_set_conv_nth) + then obtain ps\<^sub>r where ps\<^sub>r_prems: "knights_circuit ?b ps\<^sub>r" "hd ps\<^sub>r = (1,1)" + using assms knights_circuit_rotate_to by blast + then have kp: "knights_path ?b ps\<^sub>r" and "valid_step (last ps\<^sub>r) (1,1)" + unfolding knights_circuit_def by auto + + have "(1,1) \<in> ?b" "(1,2) \<in> ?b" "(1,3) \<in> ?b" + using assms unfolding board_def by auto + then have "(1,1) \<in> set ps\<^sub>r" "(1,2) \<in> set ps\<^sub>r" "(1,3) \<in> set ps\<^sub>r" + using kp knights_path_set_eq by auto + + have "3 < card ?b" + using assms board_leq_subset card_board[of 5 5] + card_mono[OF board_finite[of n m], of "board 5 5"] by auto + then have "3 < length ps\<^sub>r" + using knights_path_length kp by auto + then obtain s\<^sub>j ps' s\<^sub>k where [simp]: "ps\<^sub>r = (1,1)#s\<^sub>j#ps'@[s\<^sub>k]" + using \<open>hd ps\<^sub>r = (1,1)\<close> list_len_g_3_split[of ps\<^sub>r] by auto + have "s\<^sub>j \<noteq> s\<^sub>k" + using kp knights_path_distinct by force + + have vs_s\<^sub>k: "valid_step s\<^sub>k (1,1)" + using \<open>valid_step (last ps\<^sub>r) (1,1)\<close> by simp + + have vs_s\<^sub>j: "valid_step (1,1) s\<^sub>j" and kp': "knights_path (?b - {(1,1)}) (s\<^sub>j#ps'@[s\<^sub>k])" + using kp by (auto elim: knights_path.cases) + + have "s\<^sub>j \<in> set ps\<^sub>r" "s\<^sub>k \<in> set ps\<^sub>r" by auto + then have "s\<^sub>j \<in> ?b" "s\<^sub>k \<in> ?b" + using kp knights_path_set_eq by blast+ + then have "0 < fst s\<^sub>j \<and> 0 < snd s\<^sub>j" "0 < fst s\<^sub>k \<and> 0 < snd s\<^sub>k" + unfolding board_def by auto + then have "s\<^sub>k = (2,3) \<or> s\<^sub>k = (3,2)" "s\<^sub>j = (2,3) \<or> s\<^sub>j = (3,2)" + using vs_s\<^sub>k vs_s\<^sub>j valid_step_1_1 valid_step_rev by (metis prod.collapse)+ + then have "s\<^sub>k = (3,2) \<or> s\<^sub>j = (3,2)" + using \<open>s\<^sub>j \<noteq> s\<^sub>k\<close> by auto + then show ?thesis + proof (elim disjE) + assume "s\<^sub>k = (3,2)" + then have "last ps\<^sub>r = (3,2)" by auto + then show ?thesis using ps\<^sub>r_prems by auto + next + assume "s\<^sub>j = (3,2)" + then have vs: "valid_step (last ((1,1)#rev (s\<^sub>j#ps'@[s\<^sub>k]))) (hd ((1,1)#rev (s\<^sub>j#ps'@[s\<^sub>k])))" + unfolding valid_step_def by auto + + have rev_simp: "rev (s\<^sub>j#ps'@[s\<^sub>k]) = s\<^sub>k#(rev ps')@[s\<^sub>j]" by auto + + have "knights_path (?b - {(1,1)}) (rev (s\<^sub>j#ps'@[s\<^sub>k]))" + using knights_path_rev[OF kp'] by auto + then have "(1,1) \<notin> (?b - {(1,1)})" "valid_step (1,1) s\<^sub>k" + "knights_path (?b - {(1,1)}) (s\<^sub>k#(rev ps')@[s\<^sub>j])" + using assms vs_s\<^sub>k valid_step_rev by (auto simp: rev_simp) + then have "knights_path (?b - {(1, 1)} \<union> {(1, 1)}) ((1,1)#s\<^sub>k#(rev ps')@[s\<^sub>j])" + using knights_path.intros(2)[of "(1,1)" "?b - {(1,1)}" s\<^sub>k "(rev ps')@[s\<^sub>j]"] by auto + then have "knights_path ?b ((1,1)#rev (s\<^sub>j#ps'@[s\<^sub>k]))" + using assms by (simp add: board_def insert_absorb rev_simp) + then have "knights_circuit ?b ((1,1)#rev (s\<^sub>j#ps'@[s\<^sub>k]))" + unfolding knights_circuit_def using vs by auto + then show ?thesis + using \<open>s\<^sub>j = (3,2)\<close> by auto + qed +qed + +section \<open>Transposing Paths and Boards\<close> + +subsection \<open>Implementation of Path and Board Transposition\<close> + +definition "transpose_square s\<^sub>i = (case s\<^sub>i of (i,j) \<Rightarrow> (j,i))" + +fun transpose :: "path \<Rightarrow> path" where + "transpose [] = []" +| "transpose (s\<^sub>i#ps) = (transpose_square s\<^sub>i)#transpose ps" + +definition transpose_board :: "board \<Rightarrow> board" where + "transpose_board b \<equiv> {(j,i) |i j. (i,j) \<in> b}" + +subsection \<open>Correctness of Path and Board Transposition\<close> + +lemma transpose2: "transpose_square (transpose_square s\<^sub>i) = s\<^sub>i" + unfolding transpose_square_def by (auto split: prod.splits) + +lemma transpose_nil: "ps = [] \<longleftrightarrow> transpose ps = []" + using transpose.elims by blast + +lemma transpose_length: "length ps = length (transpose ps)" + by (induction ps) auto + +lemma hd_transpose: "ps \<noteq>[] \<Longrightarrow> hd (transpose ps) = transpose_square (hd ps)" + by (induction ps) (auto simp: transpose_square_def) + +lemma last_transpose: "ps \<noteq>[] \<Longrightarrow> last (transpose ps) = transpose_square (last ps)" +proof (induction ps) + case (Cons s\<^sub>i ps) + then show ?case + proof (cases "ps = []") + case True + then show ?thesis using Cons by (auto simp: transpose_square_def) + next + case False + then show ?thesis using Cons transpose_nil by auto + qed +qed auto + +lemma take_transpose: + shows "take k (transpose ps) = transpose (take k ps)" +proof (induction ps arbitrary: k) + case Nil + then show ?case by auto +next + case (Cons s\<^sub>i ps) + then obtain i j where "s\<^sub>i = (i,j)" by force + then have "k = 0 \<or> k > 0" by auto + then show ?case + proof (elim disjE) + assume "k > 0" + then show ?thesis using Cons.IH by (auto simp: \<open>s\<^sub>i = (i,j)\<close> take_Cons') + qed auto +qed + +lemma drop_transpose: + shows "drop k (transpose ps) = transpose (drop k ps)" +proof (induction ps arbitrary: k) + case Nil + then show ?case by auto +next + case (Cons s\<^sub>i ps) + then obtain i j where "s\<^sub>i = (i,j)" by force + then have "k = 0 \<or> k > 0" by auto + then show ?case + proof (elim disjE) + assume "k > 0" + then show ?thesis using Cons.IH by (auto simp: \<open>s\<^sub>i = (i,j)\<close> drop_Cons') + qed auto +qed + +lemma transpose_board_correct: "s\<^sub>i \<in> b \<longleftrightarrow> (transpose_square s\<^sub>i) \<in> transpose_board b" + unfolding transpose_board_def transpose_square_def by (auto split: prod.splits) + +lemma transpose_board: "transpose_board (board n m) = board m n" + unfolding board_def using transpose_board_correct by (auto simp: transpose_square_def) + +lemma insert_transpose_board: + "insert (transpose_square s\<^sub>i) (transpose_board b) = transpose_board (insert s\<^sub>i b)" + unfolding transpose_board_def transpose_square_def by (auto split: prod.splits) + +lemma transpose_board2: "transpose_board (transpose_board b) = b" + unfolding transpose_board_def by auto + +lemma transpose_union: "transpose_board (b\<^sub>1 \<union> b\<^sub>2) = transpose_board b\<^sub>1 \<union> transpose_board b\<^sub>2" + unfolding transpose_board_def by auto + +lemma transpose_valid_step: + "valid_step s\<^sub>i s\<^sub>j \<longleftrightarrow> valid_step (transpose_square s\<^sub>i) (transpose_square s\<^sub>j)" + unfolding valid_step_def transpose_square_def by (auto split: prod.splits) + +lemma transpose_knights_path': + assumes "knights_path b ps" + shows "knights_path (transpose_board b) (transpose ps)" + using assms +proof (induction rule: knights_path.induct) + case (1 s\<^sub>i) + then have "transpose_board {s\<^sub>i} = {transpose_square s\<^sub>i}" "transpose [s\<^sub>i] = [transpose_square s\<^sub>i]" + using transpose_board_correct by (auto simp: transpose_square_def split: prod.splits) + then show ?case by (auto intro: knights_path.intros) +next + case (2 s\<^sub>i b s\<^sub>j ps) + then have prems: "transpose_square s\<^sub>i \<notin> transpose_board b" + "valid_step (transpose_square s\<^sub>i) (transpose_square s\<^sub>j)" + and "transpose (s\<^sub>j#ps) = transpose_square s\<^sub>j#transpose ps" + using 2 transpose_board_correct transpose_valid_step by auto + then show ?case + using 2 knights_path.intros(2)[OF prems] insert_transpose_board by auto +qed + +corollary transpose_knights_path: + assumes "knights_path (board n m) ps" + shows "knights_path (board m n) (transpose ps)" + using assms transpose_knights_path'[of "board n m" ps] by (auto simp: transpose_board) + +corollary transpose_knights_circuit: + assumes "knights_circuit (board n m) ps" + shows "knights_circuit (board m n) (transpose ps)" + using assms +proof - + have "knights_path (board n m) ps" and vs: "valid_step (last ps) (hd ps)" + using assms unfolding knights_circuit_def by auto + then have kp_t: "knights_path (board m n) (transpose ps)" and "ps \<noteq> []" + using transpose_knights_path knights_path_non_nil by auto + then have "valid_step (last (transpose ps)) (hd (transpose ps))" + using vs hd_transpose last_transpose transpose_valid_step by auto + then show ?thesis using kp_t by (auto simp: knights_circuit_def) +qed + +section \<open>Mirroring Paths and Boards\<close> + +subsection \<open>Implementation of Path and Board Mirroring\<close> + +abbreviation "min1 ps \<equiv> Min ((fst) ` set ps)" +abbreviation "max1 ps \<equiv> Max ((fst) ` set ps)" +abbreviation "min2 ps \<equiv> Min ((snd) ` set ps)" +abbreviation "max2 ps \<equiv> Max ((snd) ` set ps)" + +definition mirror1_square :: "int \<Rightarrow> square \<Rightarrow> square" where + "mirror1_square n s\<^sub>i = (case s\<^sub>i of (i,j) \<Rightarrow> (n-i,j))" + +fun mirror1_aux :: "int \<Rightarrow> path \<Rightarrow> path" where + "mirror1_aux n [] = []" +| "mirror1_aux n (s\<^sub>i#ps) = (mirror1_square n s\<^sub>i)#mirror1_aux n ps" + +definition "mirror1 ps = mirror1_aux (max1 ps + min1 ps) ps" + +definition mirror1_board :: "int \<Rightarrow> board \<Rightarrow> board" where + "mirror1_board n b \<equiv> {mirror1_square n s\<^sub>i |s\<^sub>i. s\<^sub>i \<in> b}" + +definition mirror2_square :: "int \<Rightarrow> square \<Rightarrow> square" where + "mirror2_square m s\<^sub>i = (case s\<^sub>i of (i,j) \<Rightarrow> (i,m-j))" + +fun mirror2_aux :: "int \<Rightarrow> path \<Rightarrow> path" where + "mirror2_aux m [] = []" +| "mirror2_aux m (s\<^sub>i#ps) = (mirror2_square m s\<^sub>i)#mirror2_aux m ps" + +definition "mirror2 ps = mirror2_aux (max2 ps + min2 ps) ps" + +definition mirror2_board :: "int \<Rightarrow> board \<Rightarrow> board" where + "mirror2_board m b \<equiv> {mirror2_square m s\<^sub>i |s\<^sub>i. s\<^sub>i \<in> b}" + +subsection \<open>Correctness of Path and Board Mirroring\<close> + +lemma mirror1_board_id: "mirror1_board (int n+1) (board n m) = board n m" (is "_ = ?b") +proof + show "mirror1_board (int n+1) ?b \<subseteq> ?b" + proof + fix s\<^sub>i' + assume assms: "s\<^sub>i' \<in> mirror1_board (int n+1) ?b" + then obtain i' j' where [simp]: "s\<^sub>i' = (i',j')" by force + then have "(i',j') \<in> mirror1_board (int n+1) ?b" + using assms by auto + then obtain i j where "(i,j) \<in> ?b" "mirror1_square (int n+1) (i,j) = (i',j')" + unfolding mirror1_board_def by auto + then have "1 \<le> i \<and> i \<le> int n" "1 \<le> j \<and> j \<le> int m" "i'=(int n+1)-i" "j'=j" + unfolding board_def mirror1_square_def by auto + then have "1 \<le> i' \<and> i' \<le> int n" "1 \<le> j' \<and> j' \<le> int m" + by auto + then show "s\<^sub>i' \<in> ?b" + unfolding board_def by auto + qed +next + show "?b \<subseteq> mirror1_board (int n+1) ?b" + proof + fix s\<^sub>i + assume assms: "s\<^sub>i \<in> ?b" + then obtain i j where [simp]: "s\<^sub>i = (i,j)" by force + then have "(i,j) \<in> ?b" + using assms by auto + then have "1 \<le> i \<and> i \<le> int n" "1 \<le> j \<and> j \<le> int m" + unfolding board_def by auto + then obtain i' j' where "i'=(int n+1)-i" "j'=j" by auto + then have "(i',j') \<in> ?b" "mirror1_square (int n+1) (i',j') = (i,j)" + using \<open>1 \<le> i \<and> i \<le> int n\<close> \<open>1 \<le> j \<and> j \<le> int m\<close> + unfolding mirror1_square_def by (auto simp: board_def) + then show "s\<^sub>i \<in> mirror1_board (int n+1) ?b" + unfolding mirror1_board_def by force + qed +qed + +lemma mirror2_board_id: "mirror2_board (int m+1) (board n m) = board n m" (is "_ = ?b") +proof + show "mirror2_board (int m+1) ?b \<subseteq> ?b" + proof + fix s\<^sub>i' + assume assms: "s\<^sub>i' \<in> mirror2_board (int m+1) ?b" + then obtain i' j' where [simp]: "s\<^sub>i' = (i',j')" by force + then have "(i',j') \<in> mirror2_board (int m+1) ?b" + using assms by auto + then obtain i j where "(i,j) \<in> ?b" "mirror2_square (int m+1) (i,j) = (i',j')" + unfolding mirror2_board_def by auto + then have "1 \<le> i \<and> i \<le> int n" "1 \<le> j \<and> j \<le> int m" "i'=i" "j'=(int m+1)-j" + unfolding board_def mirror2_square_def by auto + then have "1 \<le> i' \<and> i' \<le> int n" "1 \<le> j' \<and> j' \<le> int m" + by auto + then show "s\<^sub>i' \<in> ?b" + unfolding board_def by auto + qed +next + show "?b \<subseteq> mirror2_board (int m+1) ?b" + proof + fix s\<^sub>i + assume assms: "s\<^sub>i \<in> ?b" + then obtain i j where [simp]: "s\<^sub>i = (i,j)" by force + then have "(i,j) \<in> ?b" + using assms by auto + then have "1 \<le> i \<and> i \<le> int n" "1 \<le> j \<and> j \<le> int m" + unfolding board_def by auto + then obtain i' j' where "i'=i" "j'=(int m+1)-j" by auto + then have "(i',j') \<in> ?b" "mirror2_square (int m+1) (i',j') = (i,j)" + using \<open>1 \<le> i \<and> i \<le> int n\<close> \<open>1 \<le> j \<and> j \<le> int m\<close> + unfolding mirror2_square_def by (auto simp: board_def) + then show "s\<^sub>i \<in> mirror2_board (int m+1) ?b" + unfolding mirror2_board_def by force + qed +qed + +lemma knights_path_min1: "knights_path (board n m) ps \<Longrightarrow> min1 ps = 1" +proof - + assume assms: "knights_path (board n m) ps" + then have "min n m \<ge> 1" + using knights_path_board_m_n_geq_1 by auto + then have "(1,1) \<in> board n m" and ge_1: "\<forall>(i,j) \<in> board n m. i \<ge> 1" + unfolding board_def by auto + then have finite: "finite ((fst) ` board n m)" and + non_empty: "(fst) ` board n m \<noteq> {}" and + mem_1: "1 \<in> (fst) ` board n m" + using board_finite by auto (metis fstI image_eqI) + then have "Min ((fst) ` board n m) = 1" + using ge_1 by (auto simp: Min_eq_iff) + then show ?thesis + using assms knights_path_set_eq by auto +qed + +lemma knights_path_min2: "knights_path (board n m) ps \<Longrightarrow> min2 ps = 1" +proof - + assume assms: "knights_path (board n m) ps" + then have "min n m \<ge> 1" + using knights_path_board_m_n_geq_1 by auto + then have "(1,1) \<in> board n m" and ge_1: "\<forall>(i,j) \<in> board n m. j \<ge> 1" + unfolding board_def by auto + then have finite: "finite ((snd) ` board n m)" and + non_empty: "(snd) ` board n m \<noteq> {}" and + mem_1: "1 \<in> (snd) ` board n m" + using board_finite by auto (metis sndI image_eqI) + then have "Min ((snd) ` board n m) = 1" + using ge_1 by (auto simp: Min_eq_iff) + then show ?thesis + using assms knights_path_set_eq by auto +qed + +lemma knights_path_max1: "knights_path (board n m) ps \<Longrightarrow> max1 ps = int n" +proof - + assume assms: "knights_path (board n m) ps" + then have "min n m \<ge> 1" + using knights_path_board_m_n_geq_1 by auto + then have "(int n,1) \<in> board n m" and leq_n: "\<forall>(i,j) \<in> board n m. i \<le> int n" + unfolding board_def by auto + then have finite: "finite ((fst) ` board n m)" and + non_empty: "(fst) ` board n m \<noteq> {}" and + mem_1: "int n \<in> (fst) ` board n m" + using board_finite by auto (metis fstI image_eqI) + then have "Max ((fst) ` board n m) = int n" + using leq_n by (auto simp: Max_eq_iff) + then show ?thesis + using assms knights_path_set_eq by auto +qed + +lemma knights_path_max2: "knights_path (board n m) ps \<Longrightarrow> max2 ps = int m" +proof - + assume assms: "knights_path (board n m) ps" + then have "min n m \<ge> 1" + using knights_path_board_m_n_geq_1 by auto + then have "(1,int m) \<in> board n m" and leq_m: "\<forall>(i,j) \<in> board n m. j \<le> int m" + unfolding board_def by auto + then have finite: "finite ((snd) ` board n m)" and + non_empty: "(snd) ` board n m \<noteq> {}" and + mem_1: "int m \<in> (snd) ` board n m" + using board_finite by auto (metis sndI image_eqI) + then have "Max ((snd) ` board n m) = int m" + using leq_m by (auto simp: Max_eq_iff) + then show ?thesis + using assms knights_path_set_eq by auto +qed + +lemma mirror1_aux_nil: "ps = [] \<longleftrightarrow> mirror1_aux m ps = []" + using mirror1_aux.elims by blast + +lemma mirror1_nil: "ps = [] \<longleftrightarrow> mirror1 ps = []" + unfolding mirror1_def using mirror1_aux_nil by blast + +lemma mirror2_aux_nil: "ps = [] \<longleftrightarrow> mirror2_aux m ps = []" + using mirror2_aux.elims by blast + +lemma mirror2_nil: "ps = [] \<longleftrightarrow> mirror2 ps = []" + unfolding mirror2_def using mirror2_aux_nil by blast + +lemma length_mirror1_aux: "length ps = length (mirror1_aux n ps)" + by (induction ps) auto + +lemma length_mirror1: "length ps = length (mirror1 ps)" + unfolding mirror1_def using length_mirror1_aux by auto + +lemma length_mirror2_aux: "length ps = length (mirror2_aux n ps)" + by (induction ps) auto + +lemma length_mirror2: "length ps = length (mirror2 ps)" + unfolding mirror2_def using length_mirror2_aux by auto + +lemma mirror1_board_iff:"s\<^sub>i \<notin> b \<longleftrightarrow> mirror1_square n s\<^sub>i \<notin> mirror1_board n b" + unfolding mirror1_board_def mirror1_square_def by (auto split: prod.splits) + +lemma mirror2_board_iff:"s\<^sub>i \<notin> b \<longleftrightarrow> mirror2_square n s\<^sub>i \<notin> mirror2_board n b" + unfolding mirror2_board_def mirror2_square_def by (auto split: prod.splits) + +lemma insert_mirror1_board: + "insert (mirror1_square n s\<^sub>i) (mirror1_board n b) = mirror1_board n (insert s\<^sub>i b)" + unfolding mirror1_board_def mirror1_square_def by (auto split: prod.splits) + +lemma insert_mirror2_board: + "insert (mirror2_square n s\<^sub>i) (mirror2_board n b) = mirror2_board n (insert s\<^sub>i b)" + unfolding mirror2_board_def mirror2_square_def by (auto split: prod.splits) + +lemma valid_step_mirror1: + "valid_step s\<^sub>i s\<^sub>j \<longleftrightarrow> valid_step (mirror1_square n s\<^sub>i) (mirror1_square n s\<^sub>j)" +proof + assume assms: "valid_step s\<^sub>i s\<^sub>j" + obtain i j i' j' where [simp]: "s\<^sub>i = (i,j)" "s\<^sub>j = (i',j')" by force + then have "valid_step (n-i,j) (n-i',j')" + using assms unfolding valid_step_def + apply simp + apply (elim disjE) + apply auto + done + then show "valid_step (mirror1_square n s\<^sub>i) (mirror1_square n s\<^sub>j)" + unfolding mirror1_square_def by auto +next + assume assms: "valid_step (mirror1_square n s\<^sub>i) (mirror1_square n s\<^sub>j)" + obtain i j i' j' where [simp]: "s\<^sub>i = (i,j)" "s\<^sub>j = (i',j')" by force + then have "valid_step (i,j) (i',j')" + using assms unfolding valid_step_def mirror1_square_def + apply simp + apply (elim disjE) + apply auto + done + then show "valid_step s\<^sub>i s\<^sub>j" + unfolding mirror1_square_def by auto +qed + +lemma valid_step_mirror2: + "valid_step s\<^sub>i s\<^sub>j \<longleftrightarrow> valid_step (mirror2_square m s\<^sub>i) (mirror2_square m s\<^sub>j)" +proof + assume assms: "valid_step s\<^sub>i s\<^sub>j" + obtain i j i' j' where [simp]: "s\<^sub>i = (i,j)" "s\<^sub>j = (i',j')" by force + then have "valid_step (i,m-j) (i',m-j')" + using assms unfolding valid_step_def + apply simp + apply (elim disjE) + apply auto + done + then show "valid_step (mirror2_square m s\<^sub>i) (mirror2_square m s\<^sub>j)" + unfolding mirror2_square_def by auto +next + assume assms: "valid_step (mirror2_square m s\<^sub>i) (mirror2_square m s\<^sub>j)" + obtain i j i' j' where [simp]: "s\<^sub>i = (i,j)" "s\<^sub>j = (i',j')" by force + then have "valid_step (i,j) (i',j')" + using assms unfolding valid_step_def mirror2_square_def + apply simp + apply (elim disjE) + apply auto + done + then show "valid_step s\<^sub>i s\<^sub>j" + unfolding mirror1_square_def by auto +qed + +lemma hd_mirror1: + assumes "knights_path (board n m) ps" "hd ps = (i,j)" + shows "hd (mirror1 ps) = (int n+1-i,j)" + using assms +proof - + have "hd (mirror1 ps) = hd (mirror1_aux (int n+1) ps)" + unfolding mirror1_def using assms knights_path_min1 knights_path_max1 by auto + also have "... = hd (mirror1_aux (int n+1) ((hd ps)#(tl ps)))" + using assms knights_path_non_nil by (metis list.collapse) + also have "... = (int n+1-i,j)" + using assms by (auto simp: mirror1_square_def) + finally show ?thesis . +qed + +lemma last_mirror1_aux: + assumes "ps \<noteq> []" "last ps = (i,j)" + shows "last (mirror1_aux n ps) = (n-i,j)" + using assms +proof (induction ps) + case (Cons s\<^sub>i ps) + then show ?case + using mirror1_aux_nil Cons by (cases "ps = []") (auto simp: mirror1_square_def) +qed auto + +lemma last_mirror1: + assumes "knights_path (board n m) ps" "last ps = (i,j)" + shows "last (mirror1 ps) = (int n+1-i,j)" + unfolding mirror1_def using assms last_mirror1_aux knights_path_non_nil + by (simp add: knights_path_max1 knights_path_min1) + +lemma hd_mirror2: + assumes "knights_path (board n m) ps" "hd ps = (i,j)" + shows "hd (mirror2 ps) = (i,int m+1-j)" + using assms +proof - + have "hd (mirror2 ps) = hd (mirror2_aux (int m+1) ps)" + unfolding mirror2_def using assms knights_path_min2 knights_path_max2 by auto + also have "... = hd (mirror2_aux (int m+1) ((hd ps)#(tl ps)))" + using assms knights_path_non_nil by (metis list.collapse) + also have "... = (i,int m+1-j)" + using assms by (auto simp: mirror2_square_def) + finally show ?thesis . +qed + +lemma last_mirror2_aux: + assumes "ps \<noteq> []" "last ps = (i,j)" + shows "last (mirror2_aux m ps) = (i,m-j)" + using assms +proof (induction ps) + case (Cons s\<^sub>i ps) + then show ?case + using mirror2_aux_nil Cons by (cases "ps = []") (auto simp: mirror2_square_def) +qed auto + +lemma last_mirror2: + assumes "knights_path (board n m) ps" "last ps = (i,j)" + shows "last (mirror2 ps) = (i,int m+1-j)" + unfolding mirror2_def using assms last_mirror2_aux knights_path_non_nil + by (simp add: knights_path_max2 knights_path_min2) + +lemma mirror1_aux_knights_path: + assumes "knights_path b ps" + shows "knights_path (mirror1_board n b) (mirror1_aux n ps)" + using assms +proof (induction rule: knights_path.induct) + case (1 s\<^sub>i) + then have "mirror1_board n {s\<^sub>i} = {mirror1_square n s\<^sub>i}" + unfolding mirror1_board_def by blast + then show ?case by (auto intro: knights_path.intros) +next + case (2 s\<^sub>i b s\<^sub>j ps) + then have prems: "mirror1_square n s\<^sub>i \<notin> mirror1_board n b" + "valid_step (mirror1_square n s\<^sub>i) (mirror1_square n s\<^sub>j)" + and "mirror1_aux n (s\<^sub>j#ps) = mirror1_square n s\<^sub>j#mirror1_aux n ps" + using 2 mirror1_board_iff valid_step_mirror1 by auto + then show ?case + using 2 knights_path.intros(2)[OF prems] insert_mirror1_board by auto +qed + +corollary mirror1_knights_path: + assumes "knights_path (board n m) ps" + shows "knights_path (board n m) (mirror1 ps)" + using assms +proof - + have [simp]: "min1 ps = 1" "max1 ps = int n" + using assms knights_path_min1 knights_path_max1 by auto + then have "mirror1_board (int n+1) (board n m) = (board n m)" + using mirror1_board_id by auto + then have "knights_path (board n m) (mirror1_aux (int n+1) ps)" + using assms mirror1_aux_knights_path[of "board n m" ps "int n+1"] by auto + then show ?thesis unfolding mirror1_def by auto +qed + +lemma mirror2_aux_knights_path: + assumes "knights_path b ps" + shows "knights_path (mirror2_board n b) (mirror2_aux n ps)" + using assms +proof (induction rule: knights_path.induct) + case (1 s\<^sub>i) + then have "mirror2_board n {s\<^sub>i} = {mirror2_square n s\<^sub>i}" + unfolding mirror2_board_def by blast + then show ?case by (auto intro: knights_path.intros) +next + case (2 s\<^sub>i b s\<^sub>j ps) + then have prems: "mirror2_square n s\<^sub>i \<notin> mirror2_board n b" + "valid_step (mirror2_square n s\<^sub>i) (mirror2_square n s\<^sub>j)" + and "mirror2_aux n (s\<^sub>j#ps) = mirror2_square n s\<^sub>j#mirror2_aux n ps" + using 2 mirror2_board_iff valid_step_mirror2 by auto + then show ?case + using 2 knights_path.intros(2)[OF prems] insert_mirror2_board by auto +qed + +corollary mirror2_knights_path: + assumes "knights_path (board n m) ps" + shows "knights_path (board n m) (mirror2 ps)" +proof - + have [simp]: "min2 ps = 1" "max2 ps = int m" + using assms knights_path_min2 knights_path_max2 by auto + then have "mirror2_board (int m+1) (board n m) = (board n m)" + using mirror2_board_id by auto + then have "knights_path (board n m) (mirror2_aux (int m+1) ps)" + using assms mirror2_aux_knights_path[of "board n m" ps "int m+1"] by auto + then show ?thesis unfolding mirror2_def by auto +qed + +subsection \<open>Rotate Knight's Paths\<close> + +text \<open>Transposing (@{const transpose}) and mirroring (along first axis \<open>mirror1\<close>) a Knight's path +preserves the Knight's path's property. Tranpose+Mirror1 equals a 90deg-clockwise turn.\<close> +corollary rot90_knights_path: + assumes "knights_path (board n m) ps" + shows "knights_path (board m n) (mirror1 (transpose ps))" + using assms transpose_knights_path mirror1_knights_path by auto + +lemma hd_rot90_knights_path: + assumes "knights_path (board n m) ps" "hd ps = (i,j)" + shows "hd (mirror1 (transpose ps)) = (int m+1-j,i)" + using assms +proof - + have "hd (transpose ps) = (j,i)" "knights_path (board m n) (transpose ps)" + using assms knights_path_non_nil hd_transpose transpose_knights_path + by (auto simp: transpose_square_def) + then show ?thesis using hd_mirror1 by auto +qed + +lemma last_rot90_knights_path: + assumes "knights_path (board n m) ps" "last ps = (i,j)" + shows "last (mirror1 (transpose ps)) = (int m+1-j,i)" + using assms +proof - + have "last (transpose ps) = (j,i)" "knights_path (board m n) (transpose ps)" + using assms knights_path_non_nil last_transpose transpose_knights_path + by (auto simp: transpose_square_def) + then show ?thesis using last_mirror1 by auto +qed + +section \<open>Translating Paths and Boards\<close> + +text \<open>When constructing knight's paths for larger boards multiple knight's paths for smaller boards +are concatenated. To concatenate paths the the coordinates in the path need to be translated. +Therefore, simple auxiliary functions are provided.\<close> + +subsection \<open>Implementation of Path and Board Translation\<close> + +text \<open>Translate the coordinates for a path by \<open>(k\<^sub>1,k\<^sub>2)\<close>.\<close> +fun trans_path :: "int \<times> int \<Rightarrow> path \<Rightarrow> path" where + "trans_path (k\<^sub>1,k\<^sub>2) [] = []" +| "trans_path (k\<^sub>1,k\<^sub>2) ((i,j)#xs) = (i+k\<^sub>1,j+k\<^sub>2)#(trans_path (k\<^sub>1,k\<^sub>2) xs)" + +text \<open>Translate the coordinates of a board by \<open>(k\<^sub>1,k\<^sub>2)\<close>.\<close> +definition trans_board :: "int \<times> int \<Rightarrow> board \<Rightarrow> board" where + "trans_board t b \<equiv> (case t of (k\<^sub>1,k\<^sub>2) \<Rightarrow> {(i+k\<^sub>1,j+k\<^sub>2)|i j. (i,j) \<in> b})" + +subsection \<open>Correctness of Path and Board Translation\<close> + +lemma trans_path_length: "length ps = length (trans_path (k\<^sub>1,k\<^sub>2) ps)" + by (induction ps) auto + +lemma trans_path_non_nil: "ps \<noteq> [] \<Longrightarrow> trans_path (k\<^sub>1,k\<^sub>2) ps \<noteq> []" + by (induction ps) auto + +lemma trans_path_correct: "(i,j) \<in> set ps \<longleftrightarrow> (i+k\<^sub>1,j+k\<^sub>2) \<in> set (trans_path (k\<^sub>1,k\<^sub>2) ps)" +proof (induction ps) + case (Cons s\<^sub>i ps) + then show ?case by (cases s\<^sub>i) auto +qed auto + +lemma trans_path_non_nil_last: + "ps \<noteq> [] \<Longrightarrow> last (trans_path (k\<^sub>1,k\<^sub>2) ps) = last (trans_path (k\<^sub>1,k\<^sub>2) ((i,j)#ps))" + using trans_path_non_nil by (induction ps) auto + +lemma hd_trans_path: + assumes "ps \<noteq> []" "hd ps = (i,j)" + shows "hd (trans_path (k\<^sub>1,k\<^sub>2) ps) = (i+k\<^sub>1,j+k\<^sub>2)" + using assms by (induction ps) auto + +lemma last_trans_path: + assumes "ps \<noteq> []" "last ps = (i,j)" + shows "last (trans_path (k\<^sub>1,k\<^sub>2) ps) = (i+k\<^sub>1,j+k\<^sub>2)" + using assms +proof (induction ps) + case (Cons s\<^sub>i ps) + then show ?case + using trans_path_non_nil_last[symmetric] + apply (cases s\<^sub>i) + apply (cases "ps = []") + apply auto + done +qed (auto) + +lemma take_trans: + shows "take k (trans_path (k\<^sub>1,k\<^sub>2) ps) = trans_path (k\<^sub>1,k\<^sub>2) (take k ps)" +proof (induction ps arbitrary: k) + case Nil + then show ?case by auto +next + case (Cons s\<^sub>i ps) + then obtain i j where "s\<^sub>i = (i,j)" by force + then have "k = 0 \<or> k > 0" by auto + then show ?case + proof (elim disjE) + assume "k > 0" + then show ?thesis using Cons.IH by (auto simp: \<open>s\<^sub>i = (i,j)\<close> take_Cons') + qed auto +qed + +lemma drop_trans: + shows "drop k (trans_path (k\<^sub>1,k\<^sub>2) ps) = trans_path (k\<^sub>1,k\<^sub>2) (drop k ps)" +proof (induction ps arbitrary: k) + case Nil + then show ?case by auto +next + case (Cons s\<^sub>i ps) + then obtain i j where "s\<^sub>i = (i,j)" by force + then have "k = 0 \<or> k > 0" by auto + then show ?case + proof (elim disjE) + assume "k > 0" + then show ?thesis using Cons.IH by (auto simp: \<open>s\<^sub>i = (i,j)\<close> drop_Cons') + qed auto +qed + +lemma trans_board_correct: "(i,j) \<in> b \<longleftrightarrow> (i+k\<^sub>1,j+k\<^sub>2) \<in> trans_board (k\<^sub>1,k\<^sub>2) b" + unfolding trans_board_def by auto + +lemma board_subset: "n\<^sub>1 \<le> n\<^sub>2 \<Longrightarrow> m\<^sub>1 \<le> m\<^sub>2 \<Longrightarrow> board n\<^sub>1 m\<^sub>1 \<subseteq> board n\<^sub>2 m\<^sub>2" + unfolding board_def by auto + +text \<open>Board concatenation\<close> +corollary board_concat: + shows "board n m\<^sub>1 \<union> trans_board (0,int m\<^sub>1) (board n m\<^sub>2) = board n (m\<^sub>1+m\<^sub>2)" (is "?b1 \<union> ?b2 = ?b") +proof + show "?b1 \<union> ?b2 \<subseteq> ?b" unfolding board_def trans_board_def by auto +next + show "?b \<subseteq> ?b1 \<union> ?b2" + proof + fix x + assume "x \<in> ?b" + then obtain i j where x_split: "x = (i,j)" "1 \<le> i \<and> i \<le> int n" "1 \<le> j \<and> j \<le> int (m\<^sub>1+m\<^sub>2)" + unfolding board_def by auto + then have "j \<le> int m\<^sub>1 \<or> (int m\<^sub>1 < j \<and> j \<le> int (m\<^sub>1+m\<^sub>2))" by auto + then show "x \<in> ?b1 \<union> ?b2" + proof + assume "j \<le> int m\<^sub>1" + then show "x \<in> ?b1 \<union> ?b2" using x_split unfolding board_def by auto + next + assume asm: "int m\<^sub>1 < j \<and> j \<le> int (m\<^sub>1+m\<^sub>2)" + then have "(i,j-int m\<^sub>1) \<in> board n m\<^sub>2" using x_split unfolding board_def by auto + then show "x \<in> ?b1 \<union> ?b2" + using x_split asm trans_board_correct[of i "j-int m\<^sub>1" "board n m\<^sub>2" 0 "int m\<^sub>1"] by auto + qed + qed +qed + +lemma transpose_trans_board: + "transpose_board (trans_board (k\<^sub>1,k\<^sub>2) b) = trans_board (k\<^sub>2,k\<^sub>1) (transpose_board b)" + unfolding transpose_board_def trans_board_def by blast + +corollary board_concatT: + shows "board n\<^sub>1 m \<union> trans_board (int n\<^sub>1,0) (board n\<^sub>2 m) = board (n\<^sub>1+n\<^sub>2) m" (is "?b\<^sub>1 \<union> ?b\<^sub>2 = ?b") +proof - + let ?b\<^sub>1T="board m n\<^sub>1" + let ?b\<^sub>2T="trans_board (0,int n\<^sub>1) (board m n\<^sub>2)" + have "?b\<^sub>1 \<union> ?b\<^sub>2 = transpose_board (?b\<^sub>1T \<union> ?b\<^sub>2T) " + using transpose_board2 transpose_union transpose_board transpose_trans_board by auto + also have "... = transpose_board (board m (n\<^sub>1+n\<^sub>2))" + using board_concat by auto + also have "... = board (n\<^sub>1+n\<^sub>2) m" + using transpose_board by auto + finally show ?thesis . +qed + +lemma trans_valid_step: + "valid_step (i,j) (i',j') \<Longrightarrow> valid_step (i+k\<^sub>1,j+k\<^sub>2) (i'+k\<^sub>1,j'+k\<^sub>2)" + unfolding valid_step_def by auto + +text \<open>Translating a path and a boards preserves the validity.\<close> +lemma trans_knights_path: + assumes "knights_path b ps" + shows "knights_path (trans_board (k\<^sub>1,k\<^sub>2) b) (trans_path (k\<^sub>1,k\<^sub>2) ps)" + using assms +proof (induction rule: knights_path.induct) + case (2 s\<^sub>i b s\<^sub>j xs) + then obtain i j i' j' where split: "s\<^sub>i = (i,j)" "s\<^sub>j = (i',j')" by force + let ?s\<^sub>i="(i+k\<^sub>1,j+k\<^sub>2)" + let ?s\<^sub>j="(i'+k\<^sub>1,j'+k\<^sub>2)" + let ?xs="trans_path (k\<^sub>1,k\<^sub>2) xs" + let ?b="trans_board (k\<^sub>1,k\<^sub>2) b" + have simps: "trans_path (k\<^sub>1,k\<^sub>2) (s\<^sub>i#s\<^sub>j#xs) = ?s\<^sub>i#?s\<^sub>j#?xs" + "?b \<union> {?s\<^sub>i} = trans_board (k\<^sub>1,k\<^sub>2) (b \<union> {s\<^sub>i})" + unfolding trans_board_def using split by auto + have "?s\<^sub>i \<notin> ?b" "valid_step ?s\<^sub>i ?s\<^sub>j" "knights_path ?b (?s\<^sub>j#?xs)" + using 2 split trans_valid_step by (auto simp: trans_board_def) + then have "knights_path (?b \<union> {?s\<^sub>i}) (?s\<^sub>i#?s\<^sub>j#?xs)" + using knights_path.intros by auto + then show ?case using simps by auto +qed (auto simp: trans_board_def intro: knights_path.intros) + +text \<open>Predicate that indicates if two squares \<open>s\<^sub>i\<close> and \<open>s\<^sub>j\<close> are adjacent in \<open>ps\<close>.\<close> +definition step_in :: "path \<Rightarrow> square \<Rightarrow> square \<Rightarrow> bool" where + "step_in ps s\<^sub>i s\<^sub>j \<equiv> (\<exists>k. 0 < k \<and> k < length ps \<and> last (take k ps) = s\<^sub>i \<and> hd (drop k ps) = s\<^sub>j)" + +lemma step_in_Cons: "step_in ps s\<^sub>i s\<^sub>j \<Longrightarrow> step_in (s\<^sub>k#ps) s\<^sub>i s\<^sub>j" +proof - + assume "step_in ps s\<^sub>i s\<^sub>j" + then obtain k where "0 < k \<and> k < length ps" "last (take k ps) = s\<^sub>i" "hd (drop k ps) = s\<^sub>j" + unfolding step_in_def by auto + then have "0 < k+1 \<and> k+1 < length (s\<^sub>k#ps)" + "last (take (k+1) (s\<^sub>k#ps)) = s\<^sub>i" "hd (drop (k+1) (s\<^sub>k#ps)) = s\<^sub>j" + by auto + then show ?thesis + by (auto simp: step_in_def) +qed + +lemma step_in_append: "step_in ps s\<^sub>i s\<^sub>j \<Longrightarrow> step_in (ps@ps') s\<^sub>i s\<^sub>j" +proof - + assume "step_in ps s\<^sub>i s\<^sub>j" + then obtain k where "0 < k \<and> k < length ps" "last (take k ps) = s\<^sub>i" "hd (drop k ps) = s\<^sub>j" + unfolding step_in_def by auto + then have "0 < k \<and> k < length (ps@ps')" + "last (take k (ps@ps')) = s\<^sub>i" "hd (drop k (ps@ps')) = s\<^sub>j" + by auto + then show ?thesis + by (auto simp: step_in_def) +qed + +lemma step_in_prepend: "step_in ps s\<^sub>i s\<^sub>j \<Longrightarrow> step_in (ps'@ps) s\<^sub>i s\<^sub>j" + using step_in_Cons by (induction ps' arbitrary: ps) auto + +lemma step_in_valid_step: "knights_path b ps \<Longrightarrow> step_in ps s\<^sub>i s\<^sub>j \<Longrightarrow> valid_step s\<^sub>i s\<^sub>j" +proof - + assume assms: "knights_path b ps" "step_in ps s\<^sub>i s\<^sub>j" + then obtain k where k_prems: "0 < k \<and> k < length ps" "last (take k ps) = s\<^sub>i" "hd (drop k ps) = s\<^sub>j" + unfolding step_in_def by auto + then have "k = 1 \<or> k > 1" by auto + then show ?thesis + proof (elim disjE) + assume "k = 1" + then obtain ps' where "ps = s\<^sub>i#s\<^sub>j#ps'" + using k_prems list_len_g_1_split by fastforce + then show ?thesis + using assms by (auto elim: knights_path.cases) + next + assume "k > 1" + then have "0 < k-1 \<and> k-1 < length ps" + using k_prems by auto + then obtain b where "knights_path b (drop (k-1) ps)" + using assms knights_path_split by blast + + obtain ps' where "drop (k-1) ps = s\<^sub>i#s\<^sub>j#ps'" + using k_prems \<open>0 < k - 1 \<and> k - 1 < length ps\<close> + by (metis Cons_nth_drop_Suc Suc_diff_1 hd_drop_conv_nth last_snoc take_hd_drop) + then show ?thesis + using \<open>knights_path b (drop (k-1) ps)\<close> by (auto elim: knights_path.cases) + qed +qed + +lemma trans_step_in: + "step_in ps (i,j) (i',j') \<Longrightarrow> step_in (trans_path (k\<^sub>1,k\<^sub>2) ps) (i+k\<^sub>1,j+k\<^sub>2) (i'+k\<^sub>1,j'+k\<^sub>2)" +proof - + let ?ps'="trans_path (k\<^sub>1,k\<^sub>2) ps" + assume "step_in ps (i,j) (i',j')" + then obtain k where "0 < k \<and> k < length ps" "last (take k ps) = (i,j)" "hd (drop k ps) = (i',j')" + unfolding step_in_def by auto + then have "take k ps \<noteq> []" "drop k ps \<noteq> []" by fastforce+ + then have "0 < k \<and> k < length ?ps'" + "last (take k ?ps') = (i+k\<^sub>1,j+k\<^sub>2)" "hd (drop k ?ps') = (i'+k\<^sub>1,j'+k\<^sub>2)" + using trans_path_length + last_trans_path[OF \<open>take k ps \<noteq> []\<close> \<open>last (take k ps) = (i,j)\<close>] take_trans + hd_trans_path[OF \<open>drop k ps \<noteq> []\<close> \<open>hd (drop k ps) = (i',j')\<close>] drop_trans + by auto + then show ?thesis + by (auto simp: step_in_def) +qed + +lemma transpose_step_in: + "step_in ps s\<^sub>i s\<^sub>j \<Longrightarrow> step_in (transpose ps) (transpose_square s\<^sub>i) (transpose_square s\<^sub>j)" + (is "_ \<Longrightarrow> step_in ?psT ?s\<^sub>iT ?s\<^sub>jT") +proof - + assume "step_in ps s\<^sub>i s\<^sub>j" + then obtain k where + k_prems: "0 < k" "k < length ps" "last (take k ps) = s\<^sub>i" "hd (drop k ps) = s\<^sub>j" + unfolding step_in_def by auto + then have non_nil: "take k ps \<noteq> []" "drop k ps \<noteq> []" by fastforce+ + have "take k ?psT = transpose (take k ps)" "drop k ?psT = transpose (drop k ps)" + using take_transpose drop_transpose by auto + then have "last (take k ?psT) = ?s\<^sub>iT" "hd (drop k ?psT) = ?s\<^sub>jT" + using non_nil k_prems hd_transpose last_transpose by auto + then show "step_in ?psT ?s\<^sub>iT ?s\<^sub>jT" + unfolding step_in_def using k_prems transpose_length by auto +qed + +lemma hd_take: "0 < k \<Longrightarrow> hd xs = hd (take k xs)" + by (induction xs) auto + +lemma last_drop: "k < length xs \<Longrightarrow> last xs = last (drop k xs)" + by (induction xs) auto + +subsection \<open>Concatenate Knight's Paths and Circuits\<close> + +text \<open>Concatenate two knight's path on a \<open>n\<times>m\<close>-board along the 2nd axis if the first path contains +the step \<open>s\<^sub>i \<rightarrow> s\<^sub>j\<close> and there are valid steps \<open>s\<^sub>i \<rightarrow> hd ps\<^sub>2'\<close> and \<open>s\<^sub>j \<rightarrow> last ps\<^sub>2'\<close>, where +\<open>ps\<^sub>2'\<close> is \<open>ps\<^sub>2\<close> is translated by \<open>m\<^sub>1\<close>. An arbitrary step in \<open>ps\<^sub>2\<close> is preserved.\<close> +corollary knights_path_split_concat_si_prev: + assumes "knights_path (board n m\<^sub>1) ps\<^sub>1" "knights_path (board n m\<^sub>2) ps\<^sub>2" + "step_in ps\<^sub>1 s\<^sub>i s\<^sub>j" "hd ps\<^sub>2 = (i\<^sub>h,j\<^sub>h)" "last ps\<^sub>2 = (i\<^sub>l,j\<^sub>l)" "step_in ps\<^sub>2 (i,j) (i',j')" + "valid_step s\<^sub>i (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" "valid_step (i\<^sub>l,int m\<^sub>1+j\<^sub>l) s\<^sub>j" + shows "\<exists>ps. knights_path (board n (m\<^sub>1+m\<^sub>2)) ps \<and> hd ps = hd ps\<^sub>1 + \<and> last ps = last ps\<^sub>1 \<and> step_in ps (i,int m\<^sub>1+j) (i',int m\<^sub>1+j')" + using assms +proof - + let ?b\<^sub>1="board n m\<^sub>1" + let ?b\<^sub>2="board n m\<^sub>2" + let ?ps\<^sub>2'="trans_path (0,int m\<^sub>1) ps\<^sub>2" + let ?b'="trans_board (0,int m\<^sub>1) ?b\<^sub>2" + have kp2': "knights_path ?b' ?ps\<^sub>2'" using assms trans_knights_path by auto + then have "?ps\<^sub>2' \<noteq> []" using knights_path_non_nil by auto + + obtain k where k_prems: + "0 < k" "k < length ps\<^sub>1" "last (take k ps\<^sub>1) = s\<^sub>i" "hd (drop k ps\<^sub>1) = s\<^sub>j" + using assms unfolding step_in_def by auto + let ?ps="(take k ps\<^sub>1) @ ?ps\<^sub>2' @ (drop k ps\<^sub>1)" + obtain b\<^sub>1 b\<^sub>2 where b_prems: "knights_path b\<^sub>1 (take k ps\<^sub>1)" "knights_path b\<^sub>2 (drop k ps\<^sub>1)" + "b\<^sub>1 \<union> b\<^sub>2 = ?b\<^sub>1" "b\<^sub>1 \<inter> b\<^sub>2 = {}" + using assms \<open>0 < k\<close> \<open>k < length ps\<^sub>1\<close> knights_path_split by blast + + have "hd ?ps\<^sub>2' = (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" "last ?ps\<^sub>2' = (i\<^sub>l,int m\<^sub>1+j\<^sub>l)" + using assms knights_path_non_nil hd_trans_path last_trans_path by auto + then have "hd ?ps\<^sub>2' = (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" "last ((take k ps\<^sub>1) @ ?ps\<^sub>2') = (i\<^sub>l,int m\<^sub>1+j\<^sub>l)" + using \<open>?ps\<^sub>2' \<noteq> []\<close> by auto + then have vs: "valid_step (last (take k ps\<^sub>1)) (hd ?ps\<^sub>2')" + "valid_step (last ((take k ps\<^sub>1) @ ?ps\<^sub>2')) (hd (drop k ps\<^sub>1))" + using assms k_prems by auto + + have "?b\<^sub>1 \<inter> ?b' = {}" unfolding board_def trans_board_def by auto + then have "b\<^sub>1 \<inter> ?b' = {} \<and> (b\<^sub>1 \<union> ?b') \<inter> b\<^sub>2 = {}" using b_prems by blast + then have inter_empty: "b\<^sub>1 \<inter> ?b' = {}" "(b\<^sub>1 \<union> ?b') \<inter> b\<^sub>2 = {}" by auto + + have "knights_path (b\<^sub>1 \<union> ?b') ((take k ps\<^sub>1) @ ?ps\<^sub>2')" + using kp2' b_prems inter_empty vs knights_path_append by auto + then have "knights_path (b\<^sub>1 \<union> ?b' \<union> b\<^sub>2) ?ps" + using b_prems inter_empty vs knights_path_append[where ps\<^sub>1="(take k ps\<^sub>1) @ ?ps\<^sub>2'"] by auto + then have "knights_path (?b\<^sub>1 \<union> ?b') ?ps" + using b_prems Un_commute Un_assoc by metis + then have kp: "knights_path (board n (m\<^sub>1+m\<^sub>2)) ?ps" + using board_concat[of n m\<^sub>1 m\<^sub>2] by auto + + have hd: "hd ?ps = hd ps\<^sub>1" + using assms \<open>0 < k\<close> knights_path_non_nil hd_take by auto + + have last: "last ?ps = last ps\<^sub>1" + using assms \<open>k < length ps\<^sub>1\<close> knights_path_non_nil last_drop by auto + + have m_simps: "j+int m\<^sub>1 = int m\<^sub>1+j" "j'+int m\<^sub>1 = int m\<^sub>1+j'" by auto + have si: "step_in ?ps (i,int m\<^sub>1+j) (i',int m\<^sub>1+j')" + using assms step_in_append[OF step_in_prepend[OF trans_step_in], + of ps\<^sub>2 i j i' j' "take k ps\<^sub>1" 0 "int m\<^sub>1" "drop k ps\<^sub>1"] + by (auto simp: m_simps) + + show ?thesis using kp hd last si by auto +qed + +lemma len1_hd_last: "length xs = 1 \<Longrightarrow> hd xs = last xs" + by (induction xs) auto + +text \<open>Weaker version of @{thm knights_path_split_concat_si_prev}.\<close> +corollary knights_path_split_concat: + assumes "knights_path (board n m\<^sub>1) ps\<^sub>1" "knights_path (board n m\<^sub>2) ps\<^sub>2" + "step_in ps\<^sub>1 s\<^sub>i s\<^sub>j" "hd ps\<^sub>2 = (i\<^sub>h,j\<^sub>h)" "last ps\<^sub>2 = (i\<^sub>l,j\<^sub>l)" + "valid_step s\<^sub>i (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" "valid_step (i\<^sub>l,int m\<^sub>1+j\<^sub>l) s\<^sub>j" + shows "\<exists>ps. knights_path (board n (m\<^sub>1+m\<^sub>2)) ps \<and> hd ps = hd ps\<^sub>1 \<and> last ps = last ps\<^sub>1" +proof - + have "length ps\<^sub>2 = 1 \<or> length ps\<^sub>2 > 1" + using assms knights_path_non_nil by (meson length_0_conv less_one linorder_neqE_nat) + then show ?thesis + proof (elim disjE) + let ?s\<^sub>k="(i\<^sub>h,int m\<^sub>1+j\<^sub>h)" + assume "length ps\<^sub>2 = 1" + (* contradiction *) + then have "(i\<^sub>h,j\<^sub>h) = (i\<^sub>l,j\<^sub>l)" + using assms len1_hd_last by metis + then have "valid_step s\<^sub>i ?s\<^sub>k" "valid_step ?s\<^sub>k s\<^sub>j" "valid_step s\<^sub>i s\<^sub>j" + using assms step_in_valid_step by auto + then show ?thesis + using valid_step_non_transitive by blast + next + assume "length ps\<^sub>2 > 1" + then obtain i\<^sub>1 j\<^sub>1 i\<^sub>2 j\<^sub>2 ps\<^sub>2' where "ps\<^sub>2 = (i\<^sub>1,j\<^sub>1)#(i\<^sub>2,j\<^sub>2)#ps\<^sub>2'" + using list_len_g_1_split by fastforce + then have "last (take 1 ps\<^sub>2) = (i\<^sub>1,j\<^sub>1)" "hd (drop 1 ps\<^sub>2) = (i\<^sub>2,j\<^sub>2)" by auto + then have "step_in ps\<^sub>2 (i\<^sub>1,j\<^sub>1) (i\<^sub>2,j\<^sub>2)" using \<open>length ps\<^sub>2 > 1\<close> by (auto simp: step_in_def) + then show ?thesis + using assms knights_path_split_concat_si_prev by blast + qed +qed + +text \<open>Concatenate two knight's path on a \<open>n\<times>m\<close>-board along the 1st axis.\<close> +corollary knights_path_split_concatT: + assumes "knights_path (board n\<^sub>1 m) ps\<^sub>1" "knights_path (board n\<^sub>2 m) ps\<^sub>2" + "step_in ps\<^sub>1 s\<^sub>i s\<^sub>j" "hd ps\<^sub>2 = (i\<^sub>h,j\<^sub>h)" "last ps\<^sub>2 = (i\<^sub>l,j\<^sub>l)" + "valid_step s\<^sub>i (int n\<^sub>1+i\<^sub>h,j\<^sub>h)" "valid_step (int n\<^sub>1+i\<^sub>l,j\<^sub>l) s\<^sub>j" + shows "\<exists>ps. knights_path (board (n\<^sub>1+n\<^sub>2) m) ps \<and> hd ps = hd ps\<^sub>1 \<and> last ps = last ps\<^sub>1" + using assms +proof - + let ?ps\<^sub>1T="transpose ps\<^sub>1" + let ?ps\<^sub>2T="transpose ps\<^sub>2" + have kps: "knights_path (board m n\<^sub>1) ?ps\<^sub>1T" "knights_path (board m n\<^sub>2) ?ps\<^sub>2T" + using assms transpose_knights_path by auto + + let ?s\<^sub>iT="transpose_square s\<^sub>i" + let ?s\<^sub>jT="transpose_square s\<^sub>j" + have si: "step_in ?ps\<^sub>1T ?s\<^sub>iT ?s\<^sub>jT" + using assms transpose_step_in by auto + + have "ps\<^sub>1 \<noteq> []" "ps\<^sub>2 \<noteq> []" + using assms knights_path_non_nil by auto + then have hd_last2: "hd ?ps\<^sub>2T = (j\<^sub>h,i\<^sub>h)" "last ?ps\<^sub>2T = (j\<^sub>l,i\<^sub>l)" + using assms hd_transpose last_transpose by (auto simp: transpose_square_def) + + have vs: "valid_step ?s\<^sub>iT (j\<^sub>h,int n\<^sub>1+i\<^sub>h)" "valid_step (j\<^sub>l,int n\<^sub>1+i\<^sub>l) ?s\<^sub>jT" + using assms transpose_valid_step by (auto simp: transpose_square_def split: prod.splits) + + then obtain ps where + ps_prems: "knights_path (board m (n\<^sub>1+n\<^sub>2)) ps" "hd ps = hd ?ps\<^sub>1T" "last ps = last ?ps\<^sub>1T" + using knights_path_split_concat[OF kps si hd_last2 vs] by auto + then have "ps \<noteq> []" using knights_path_non_nil by auto + let ?psT="transpose ps" + have "knights_path (board (n\<^sub>1+n\<^sub>2) m) ?psT" "hd ?psT = hd ps\<^sub>1" "last ?psT = last ps\<^sub>1" + using \<open>ps\<^sub>1 \<noteq> []\<close> \<open>ps \<noteq> []\<close> ps_prems transpose_knights_path hd_transpose last_transpose + by (auto simp: transpose2) + then show ?thesis by auto +qed + +text \<open>Concatenate two Knight's path along the 2nd axis. There is a valid step from the last square +in the first Knight's path \<open>ps\<^sub>1\<close> to the first square in the second Knight's path \<open>ps\<^sub>2\<close>.\<close> +corollary knights_path_concat: + assumes "knights_path (board n m\<^sub>1) ps\<^sub>1" "knights_path (board n m\<^sub>2) ps\<^sub>2" + "hd ps\<^sub>2 = (i\<^sub>h,j\<^sub>h)" "valid_step (last ps\<^sub>1) (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" + shows "knights_path (board n (m\<^sub>1+m\<^sub>2)) (ps\<^sub>1 @ (trans_path (0,int m\<^sub>1) ps\<^sub>2))" +proof - + let ?ps\<^sub>2'="trans_path (0,int m\<^sub>1) ps\<^sub>2" + let ?b="trans_board (0,int m\<^sub>1) (board n m\<^sub>2)" + have inter_empty: "board n m\<^sub>1 \<inter> ?b = {}" + unfolding board_def trans_board_def by auto + have "hd ?ps\<^sub>2' = (i\<^sub>h,int m\<^sub>1+j\<^sub>h)" + using assms knights_path_non_nil hd_trans_path by auto + then have kp: "knights_path (board n m\<^sub>1) ps\<^sub>1" "knights_path ?b ?ps\<^sub>2'" and + vs: "valid_step (last ps\<^sub>1) (hd ?ps\<^sub>2')" + using assms trans_knights_path by auto + then show "knights_path (board n (m\<^sub>1+m\<^sub>2)) (ps\<^sub>1 @ ?ps\<^sub>2')" + using knights_path_append[OF kp inter_empty vs] board_concat by auto +qed + +text \<open>Concatenate two Knight's path along the 2nd axis. The first Knight's path end in +\<open>(2,m\<^sub>1-1)\<close> (lower-right) and the second Knight's paths start in \<open>(1,1)\<close> (lower-left).\<close> +corollary knights_path_lr_concat: + assumes "knights_path (board n m\<^sub>1) ps\<^sub>1" "knights_path (board n m\<^sub>2) ps\<^sub>2" + "last ps\<^sub>1 = (2,int m\<^sub>1-1)" "hd ps\<^sub>2 = (1,1)" + shows "knights_path (board n (m\<^sub>1+m\<^sub>2)) (ps\<^sub>1 @ (trans_path (0,int m\<^sub>1) ps\<^sub>2))" +proof - + have "valid_step (last ps\<^sub>1) (1,int m\<^sub>1+1)" + using assms unfolding valid_step_def by auto + then show ?thesis + using assms knights_path_concat by auto +qed + +text \<open>Concatenate two Knight's circuits along the 2nd axis. In the first Knight's path the +squares \<open>(2,m\<^sub>1-1)\<close> and \<open>(4,m\<^sub>1)\<close> are adjacent and the second Knight's cirucit starts in \<open>(1,1)\<close> +(lower-left) and end in \<open>(3,2)\<close>.\<close> +corollary knights_circuit_lr_concat: + assumes "knights_circuit (board n m\<^sub>1) ps\<^sub>1" "knights_circuit (board n m\<^sub>2) ps\<^sub>2" + "step_in ps\<^sub>1 (2,int m\<^sub>1-1) (4,int m\<^sub>1)" + "hd ps\<^sub>2 = (1,1)" "last ps\<^sub>2 = (3,2)" "step_in ps\<^sub>2 (2,int m\<^sub>2-1) (4,int m\<^sub>2)" + shows "\<exists>ps. knights_circuit (board n (m\<^sub>1+m\<^sub>2)) ps \<and> step_in ps (2,int (m\<^sub>1+m\<^sub>2)-1) (4,int (m\<^sub>1+m\<^sub>2))" +proof - + have kp1: "knights_path (board n m\<^sub>1) ps\<^sub>1" and kp2: "knights_path (board n m\<^sub>2) ps\<^sub>2" + and vs: "valid_step (last ps\<^sub>1) (hd ps\<^sub>1)" + using assms unfolding knights_circuit_def by auto + + have m_simps: "int m\<^sub>1 + (int m\<^sub>2-1) = int (m\<^sub>1+m\<^sub>2)-1" "int m\<^sub>1 + int m\<^sub>2 = int (m\<^sub>1+m\<^sub>2)" by auto + + have "valid_step (2,int m\<^sub>1-1) (1,int m\<^sub>1+1)" "valid_step (3,int m\<^sub>1+2) (4,int m\<^sub>1)" + unfolding valid_step_def by auto + then obtain ps where "knights_path (board n (m\<^sub>1+m\<^sub>2)) ps" "hd ps = hd ps\<^sub>1" "last ps = last ps\<^sub>1" and + si: "step_in ps (2,int (m\<^sub>1+m\<^sub>2)-1) (4,int (m\<^sub>1+m\<^sub>2))" + using assms kp1 kp2 + knights_path_split_concat_si_prev[of n m\<^sub>1 ps\<^sub>1 m\<^sub>2 ps\<^sub>2 "(2,int m\<^sub>1-1)" + "(4,int m\<^sub>1)" 1 1 3 2 2 "int m\<^sub>2-1" 4 "int m\<^sub>2"] + by (auto simp only: m_simps) + then have "knights_circuit (board n (m\<^sub>1+m\<^sub>2)) ps" + using vs by (auto simp: knights_circuit_def) + then show ?thesis + using si by auto +qed + +section \<open>Parsing Paths\<close> + +text \<open>In this section functions are implemented to parse and construct paths. The parser converts +the matrix representation (\<open>(nat list) list\<close>) used in @{cite "cull_decurtins_1987" } to a path +(\<open>path\<close>).\<close> + +text \<open>for debugging\<close> +fun test_path :: "path \<Rightarrow> bool" where + "test_path (s\<^sub>i#s\<^sub>j#xs) = (step_checker s\<^sub>i s\<^sub>j \<and> test_path (s\<^sub>j#xs))" +| "test_path _ = True" + +fun f_opt :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a option \<Rightarrow> 'a option" where + "f_opt _ None = None" +| "f_opt f (Some a) = Some (f a)" + +fun add_opt_fst_sq :: "int \<Rightarrow> square option \<Rightarrow> square option" where + "add_opt_fst_sq _ None = None" +| "add_opt_fst_sq k (Some (i,j)) = Some (k+i,j)" + +fun find_k_in_col :: "nat \<Rightarrow> nat list \<Rightarrow> int option" where + "find_k_in_col k [] = None" +| "find_k_in_col k (c#cs) = (if c = k then Some 1 else f_opt ((+) 1) (find_k_in_col k cs))" + +fun find_k_sqr :: "nat \<Rightarrow> (nat list) list \<Rightarrow> square option" where + "find_k_sqr k [] = None" +| "find_k_sqr k (r#rs) = (case find_k_in_col k r of + None \<Rightarrow> f_opt (\<lambda>(i,j). (i+1,j)) (find_k_sqr k rs) + | Some j \<Rightarrow> Some (1,j))" + +text \<open>Auxiliary function to easily parse pre-computed boards from paper.\<close> +fun to_sqrs :: "nat \<Rightarrow> (nat list) list \<Rightarrow> path option" where + "to_sqrs 0 rs = Some []" +| "to_sqrs k rs = (case find_k_sqr k rs of + None \<Rightarrow> None + | Some s\<^sub>i \<Rightarrow> f_opt (\<lambda>ps. ps@[s\<^sub>i]) (to_sqrs (k-1) rs))" + +fun num_elems :: "(nat list) list \<Rightarrow> nat" where + "num_elems (r#rs) = length r * length (r#rs)" + +text \<open>Convert a matrix (\<open>nat list list\<close>) to a path (\<open>path\<close>). With this function we implicitly +define the lower-left corner to be \<open>(1,1)\<close> and the upper-right corner to be \<open>(n,m)\<close>.\<close> +definition "to_path rs \<equiv> to_sqrs (num_elems rs) (rev rs)" + +text \<open>Example\<close> +value "to_path + [[3,22,13,16,5], + [12,17,4,21,14], + [23,2,15,6,9], + [18,11,8,25,20], + [1,24,19,10,7::nat]]" + +section \<open>Knight's Paths for \<open>5\<times>m\<close>-Boards\<close> + +text \<open>Given here are knight's paths, \<open>kp5xmlr\<close> and \<open>kp5xmur\<close>, for the \<open>(5\<times>m)\<close>-board that start +in the lower-left corner for \<open>m\<in>{5,6,7,8,9}\<close>. The path \<open>kp5xmlr\<close> ends in the lower-right corner, +whereas the path \<open>kp5xmur\<close> ends in the upper-right corner. +The tables show the visited squares numbered in ascending order.\<close> + +abbreviation "b5x5 \<equiv> board 5 5" + +text \<open>A Knight's path for the \<open>(5\<times>5)\<close>-board that starts in the lower-left and ends in the +lower-right. + \begin{table}[H] + \begin{tabular}{lllll} + 3 & 22 & 13 & 16 & 5 \\ + 12 & 17 & 4 & 21 & 14 \\ + 23 & 2 & 15 & 6 & 9 \\ + 18 & 11 & 8 & 25 & 20 \\ + 1 & 24 & 19 & 10 & 7 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x5lr \<equiv> the (to_path + [[3,22,13,16,5], + [12,17,4,21,14], + [23,2,15,6,9], + [18,11,8,25,20], + [1,24,19,10,7]])" +lemma kp_5x5_lr: "knights_path b5x5 kp5x5lr" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x5_lr_hd: "hd kp5x5lr = (1,1)" by eval + +lemma kp_5x5_lr_last: "last kp5x5lr = (2,4)" by eval + +lemma kp_5x5_lr_non_nil: "kp5x5lr \<noteq> []" by eval + +text \<open>A Knight's path for the \<open>(5\<times>5)\<close>-board that starts in the lower-left and ends in the +upper-right. + \begin{table}[H] + \begin{tabular}{lllll} + 7 & 12 & 15 & 20 & 5 \\ + 16 & 21 & 6 & 25 & 14 \\ + 11 & 8 & 13 & 4 & 19 \\ + 22 & 17 & 2 & 9 & 24 \\ + 1 & 10 & 23 & 18 & 3 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x5ur \<equiv> the (to_path + [[7,12,15,20,5], + [16,21,6,25,14], + [11,8,13,4,19], + [22,17,2,9,24], + [1,10,23,18,3]])" +lemma kp_5x5_ur: "knights_path b5x5 kp5x5ur" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x5_ur_hd: "hd kp5x5ur = (1,1)" by eval + +lemma kp_5x5_ur_last: "last kp5x5ur = (4,4)" by eval + +lemma kp_5x5_ur_non_nil: "kp5x5ur \<noteq> []" by eval + +abbreviation "b5x6 \<equiv> board 5 6" + +text \<open>A Knight's path for the \<open>(5\<times>6)\<close>-board that starts in the lower-left and ends in the +lower-right. + \begin{table}[H] + \begin{tabular}{llllll} + 7 & 14 & 21 & 28 & 5 & 12 \\ + 22 & 27 & 6 & 13 & 20 & 29 \\ + 15 & 8 & 17 & 24 & 11 & 4 \\ + 26 & 23 & 2 & 9 & 30 & 19 \\ + 1 & 16 & 25 & 18 & 3 & 10 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x6lr \<equiv> the (to_path + [[7,14,21,28,5,12], + [22,27,6,13,20,29], + [15,8,17,24,11,4], + [26,23,2,9,30,19], + [1,16,25,18,3,10]])" +lemma kp_5x6_lr: "knights_path b5x6 kp5x6lr" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x6_lr_hd: "hd kp5x6lr = (1,1)" by eval + +lemma kp_5x6_lr_last: "last kp5x6lr = (2,5)" by eval + +lemma kp_5x6_lr_non_nil: "kp5x6lr \<noteq> []" by eval + +text \<open>A Knight's path for the \<open>(5\<times>6)\<close>-board that starts in the lower-left and ends in the +upper-right. + \begin{table}[H] + \begin{tabular}{llllll} + 3 & 10 & 29 & 20 & 5 & 12 \\ + 28 & 19 & 4 & 11 & 30 & 21 \\ + 9 & 2 & 17 & 24 & 13 & 6 \\ + 18 & 27 & 8 & 15 & 22 & 25 \\ + 1 & 16 & 23 & 26 & 7 & 14 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x6ur \<equiv> the (to_path + [[3,10,29,20,5,12], + [28,19,4,11,30,21], + [9,2,17,24,13,6], + [18,27,8,15,22,25], + [1,16,23,26,7,14]])" +lemma kp_5x6_ur: "knights_path b5x6 kp5x6ur" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x6_ur_hd: "hd kp5x6ur = (1,1)" by eval + +lemma kp_5x6_ur_last: "last kp5x6ur = (4,5)" by eval + +lemma kp_5x6_ur_non_nil: "kp5x6ur \<noteq> []" by eval + +abbreviation "b5x7 \<equiv> board 5 7" + +text \<open>A Knight's path for the \<open>(5\<times>7)\<close>-board that starts in the lower-left and ends in the +lower-right. + \begin{table}[H] + \begin{tabular}{lllllll} + 3 & 12 & 21 & 30 & 5 & 14 & 23 \\ + 20 & 29 & 4 & 13 & 22 & 31 & 6 \\ + 11 & 2 & 19 & 32 & 7 & 24 & 15 \\ + 28 & 33 & 10 & 17 & 26 & 35 & 8 \\ + 1 & 18 & 27 & 34 & 9 & 16 & 25 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x7lr \<equiv> the (to_path + [[3,12,21,30,5,14,23], + [20,29,4,13,22,31,6], + [11,2,19,32,7,24,15], + [28,33,10,17,26,35,8], + [1,18,27,34,9,16,25]])" +lemma kp_5x7_lr: "knights_path b5x7 kp5x7lr" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x7_lr_hd: "hd kp5x7lr = (1,1)" by eval + +lemma kp_5x7_lr_last: "last kp5x7lr = (2,6)" by eval + +lemma kp_5x7_lr_non_nil: "kp5x7lr \<noteq> []" by eval + +text \<open>A Knight's path for the \<open>(5\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-right. + \begin{table}[H] + \begin{tabular}{lllllll} + 3 & 32 & 11 & 34 & 5 & 26 & 13 \\ + 10 & 19 & 4 & 25 & 12 & 35 & 6 \\ + 31 & 2 & 33 & 20 & 23 & 14 & 27 \\ + 18 & 9 & 24 & 29 & 16 & 7 & 22 \\ + 1 & 30 & 17 & 8 & 21 & 28 & 15 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x7ur \<equiv> the (to_path + [[3,32,11,34,5,26,13], + [10,19,4,25,12,35,6], + [31,2,33,20,23,14,27], + [18,9,24,29,16,7,22], + [1,30,17,8,21,28,15]])" +lemma kp_5x7_ur: "knights_path b5x7 kp5x7ur" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x7_ur_hd: "hd kp5x7ur = (1,1)" by eval + +lemma kp_5x7_ur_last: "last kp5x7ur = (4,6)" by eval + +lemma kp_5x7_ur_non_nil: "kp5x7ur \<noteq> []" by eval + +abbreviation "b5x8 \<equiv> board 5 8" + +text \<open>A Knight's path for the \<open>(5\<times>8)\<close>-board that starts in the lower-left and ends in the +lower-right. + \begin{table}[H] + \begin{tabular}{llllllll} + 3 & 12 & 37 & 26 & 5 & 14 & 17 & 28 \\ + 34 & 23 & 4 & 13 & 36 & 27 & 6 & 15 \\ + 11 & 2 & 35 & 38 & 25 & 16 & 29 & 18 \\ + 22 & 33 & 24 & 9 & 20 & 31 & 40 & 7 \\ + 1 & 10 & 21 & 32 & 39 & 8 & 19 & 30 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x8lr \<equiv> the (to_path + [[3,12,37,26,5,14,17,28], + [34,23,4,13,36,27,6,15], + [11,2,35,38,25,16,29,18], + [22,33,24,9,20,31,40,7], + [1,10,21,32,39,8,19,30]])" +lemma kp_5x8_lr: "knights_path b5x8 kp5x8lr" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x8_lr_hd: "hd kp5x8lr = (1,1)" by eval + +lemma kp_5x8_lr_last: "last kp5x8lr = (2,7)" by eval + +lemma kp_5x8_lr_non_nil: "kp5x8lr \<noteq> []" by eval + +text \<open>A Knight's path for the \<open>(5\<times>8)\<close>-board that starts in the lower-left and ends in the +upper-right. + \begin{table}[H] + \begin{tabular}{llllllll} + 33 & 8 & 17 & 38 & 35 & 6 & 15 & 24 \\ + 18 & 37 & 34 & 7 & 16 & 25 & 40 & 5 \\ + 9 & 32 & 29 & 36 & 39 & 14 & 23 & 26 \\ + 30 & 19 & 2 & 11 & 28 & 21 & 4 & 13 \\ + 1 & 10 & 31 & 20 & 3 & 12 & 27 & 22 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x8ur \<equiv> the (to_path + [[33,8,17,38,35,6,15,24], + [18,37,34,7,16,25,40,5], + [9,32,29,36,39,14,23,26], + [30,19,2,11,28,21,4,13], + [1,10,31,20,3,12,27,22]])" +lemma kp_5x8_ur: "knights_path b5x8 kp5x8ur" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x8_ur_hd: "hd kp5x8ur = (1,1)" by eval + +lemma kp_5x8_ur_last: "last kp5x8ur = (4,7)" by eval + +lemma kp_5x8_ur_non_nil: "kp5x8ur \<noteq> []" by eval + +abbreviation "b5x9 \<equiv> board 5 9" + +text \<open> + A Knight's path for the \<open>(5\<times>9)\<close>-board that starts in the lower-left and ends in the lower-right. + \begin{table}[H] + \begin{tabular}{lllllllll} + 9 & 4 & 11 & 16 & 23 & 42 & 33 & 36 & 25 \\ + 12 & 17 & 8 & 3 & 32 & 37 & 24 & 41 & 34 \\ + 5 & 10 & 15 & 20 & 43 & 22 & 35 & 26 & 29 \\ + 18 & 13 & 2 & 7 & 38 & 31 & 28 & 45 & 40 \\ + 1 & 6 & 19 & 14 & 21 & 44 & 39 & 30 & 27 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x9lr \<equiv> the (to_path + [[9,4,11,16,23,42,33,36,25], + [12,17,8,3,32,37,24,41,34], + [5,10,15,20,43,22,35,26,29], + [18,13,2,7,38,31,28,45,40], + [1,6,19,14,21,44,39,30,27]])" +lemma kp_5x9_lr: "knights_path b5x9 kp5x9lr" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x9_lr_hd: "hd kp5x9lr = (1,1)" by eval + +lemma kp_5x9_lr_last: "last kp5x9lr = (2,8)" by eval + +lemma kp_5x9_lr_non_nil: "kp5x9lr \<noteq> []" by eval + +text \<open> + A Knight's path for the \<open>(5\<times>9)\<close>-board that starts in the lower-left and ends in the upper-right. + \begin{table}[H] + \begin{tabular}{lllllllll} + 9 & 4 & 11 & 16 & 27 & 32 & 35 & 40 & 25 \\ + 12 & 17 & 8 & 3 & 36 & 41 & 26 & 45 & 34 \\ + 5 & 10 & 15 & 20 & 31 & 28 & 33 & 24 & 39 \\ + 18 & 13 & 2 & 7 & 42 & 37 & 22 & 29 & 44 \\ + 1 & 6 & 19 & 14 & 21 & 30 & 43 & 38 & 23 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x9ur \<equiv> the (to_path + [[9,4,11,16,27,32,35,40,25], + [12,17,8,3,36,41,26,45,34], + [5,10,15,20,31,28,33,24,39], + [18,13,2,7,42,37,22,29,44], + [1,6,19,14,21,30,43,38,23]])" +lemma kp_5x9_ur: "knights_path b5x9 kp5x9ur" + by (simp only: knights_path_exec_simp) eval + +lemma kp_5x9_ur_hd: "hd kp5x9ur = (1,1)" by eval + +lemma kp_5x9_ur_last: "last kp5x9ur = (4,8)" by eval + +lemma kp_5x9_ur_non_nil: "kp5x9ur \<noteq> []" by eval + +lemmas kp_5xm_lr = + kp_5x5_lr kp_5x5_lr_hd kp_5x5_lr_last kp_5x5_lr_non_nil + kp_5x6_lr kp_5x6_lr_hd kp_5x6_lr_last kp_5x6_lr_non_nil + kp_5x7_lr kp_5x7_lr_hd kp_5x7_lr_last kp_5x7_lr_non_nil + kp_5x8_lr kp_5x8_lr_hd kp_5x8_lr_last kp_5x8_lr_non_nil + kp_5x9_lr kp_5x9_lr_hd kp_5x9_lr_last kp_5x9_lr_non_nil + +lemmas kp_5xm_ur = + kp_5x5_ur kp_5x5_ur_hd kp_5x5_ur_last kp_5x5_ur_non_nil + kp_5x6_ur kp_5x6_ur_hd kp_5x6_ur_last kp_5x6_ur_non_nil + kp_5x7_ur kp_5x7_ur_hd kp_5x7_ur_last kp_5x7_ur_non_nil + kp_5x8_ur kp_5x8_ur_hd kp_5x8_ur_last kp_5x8_ur_non_nil + kp_5x9_ur kp_5x9_ur_hd kp_5x9_ur_last kp_5x9_ur_non_nil + +text \<open>For every \<open>5\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's path that starts in +\<open>(1,1)\<close> (bottom-left) and ends in \<open>(2,m-1)\<close> (bottom-right).\<close> +lemma knights_path_5xm_lr_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_path (board 5 m) ps \<and> hd ps = (1,1) \<and> last ps = (2,int m-1)" + using assms +proof (induction m rule: less_induct) + case (less m) + then have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" by auto + then show ?case + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kp_5xm_lr by fastforce + next + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then obtain ps\<^sub>1 where ps\<^sub>1_IH: "knights_path (board 5 (m-5)) ps\<^sub>1" "hd ps\<^sub>1 = (1,1)" + "last ps\<^sub>1 = (2,int (m-5)-1)" "ps\<^sub>1 \<noteq> []" + using less.IH[of "m-5"] knights_path_non_nil by auto + + let ?ps\<^sub>2="kp5x5lr" + let ?ps\<^sub>2'="ps\<^sub>1 @ trans_path (0,int (m-5)) ?ps\<^sub>2" + have "knights_path b5x5 ?ps\<^sub>2" "hd ?ps\<^sub>2 = (1, 1)" "?ps\<^sub>2 \<noteq> []" "last ?ps\<^sub>2 = (2,4)" + using kp_5xm_lr by auto + then have 1: "knights_path (board 5 m) ?ps\<^sub>2'" + using m_ge ps\<^sub>1_IH knights_path_lr_concat[of 5 "m-5" ps\<^sub>1 5 ?ps\<^sub>2] by auto + + have 2: "hd ?ps\<^sub>2' = (1,1)" using ps\<^sub>1_IH by auto + + have "last (trans_path (0,int (m-5)) ?ps\<^sub>2) = (2,int m-1)" + using m_ge last_trans_path[OF \<open>?ps\<^sub>2 \<noteq> []\<close> \<open>last ?ps\<^sub>2 = (2,4)\<close>] by auto + then have 3: "last ?ps\<^sub>2' = (2,int m-1)" + using last_appendR[OF trans_path_non_nil[OF \<open>?ps\<^sub>2 \<noteq> []\<close>],symmetric] by metis + + show ?thesis using 1 2 3 by auto + qed +qed + +text \<open>For every \<open>5\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's path that starts in +\<open>(1,1)\<close> (bottom-left) and ends in \<open>(4,m-1)\<close> (top-right).\<close> +lemma knights_path_5xm_ur_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_path (board 5 m) ps \<and> hd ps = (1,1) \<and> last ps = (4,int m-1)" + using assms +proof - + have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" using assms by auto + then show ?thesis + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kp_5xm_ur by fastforce + next + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then obtain ps\<^sub>1 where ps_prems: "knights_path (board 5 (m-5)) ps\<^sub>1" "hd ps\<^sub>1 = (1,1)" + "last ps\<^sub>1 = (2,int (m-5)-1)" "ps\<^sub>1 \<noteq> []" + using knights_path_5xm_lr_exists[of "(m-5)"] knights_path_non_nil by auto + let ?ps\<^sub>2="kp5x5ur" + let ?ps'="ps\<^sub>1 @ trans_path (0,int (m-5)) ?ps\<^sub>2" + have "knights_path b5x5 ?ps\<^sub>2" "hd ?ps\<^sub>2 = (1, 1)" "?ps\<^sub>2 \<noteq> []" + "last ?ps\<^sub>2 = (4,4)" + using kp_5xm_ur by auto + then have 1: "knights_path (board 5 m) ?ps'" + using m_ge ps_prems knights_path_lr_concat[of 5 "m-5" ps\<^sub>1 5 ?ps\<^sub>2] by auto + + have 2: "hd ?ps' = (1,1)" using ps_prems by auto + + have "last (trans_path (0,int (m-5)) ?ps\<^sub>2) = (4,int m-1)" + using m_ge last_trans_path[OF \<open>?ps\<^sub>2 \<noteq> []\<close> \<open>last ?ps\<^sub>2 = (4,4)\<close>] by auto + then have 3: "last ?ps' = (4,int m-1)" + using last_appendR[OF trans_path_non_nil[OF \<open>?ps\<^sub>2 \<noteq> []\<close>],symmetric] by metis + + show ?thesis using 1 2 3 by auto + qed +qed + +text \<open>@{thm knights_path_5xm_lr_exists} and @{thm knights_path_5xm_lr_exists} formalize Lemma 1 +from @{cite "cull_decurtins_1987"}.\<close> +lemmas knights_path_5xm_exists = knights_path_5xm_lr_exists knights_path_5xm_ur_exists + +section \<open>Knight's Paths and Circuits for \<open>6\<times>m\<close>-Boards\<close> + +abbreviation "b6x5 \<equiv> board 6 5" + +text \<open> + A Knight's path for the \<open>(6\<times>5)\<close>-board that starts in the lower-left and ends in the upper-left. + \begin{table}[H] + \begin{tabular}{lllll} + 10 & 19 & 4 & 29 & 12 \\ + 3 & 30 & 11 & 20 & 5 \\ + 18 & 9 & 24 & 13 & 28 \\ + 25 & 2 & 17 & 6 & 21 \\ + 16 & 23 & 8 & 27 & 14 \\ + 1 & 26 & 15 & 22 & 7 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x5ul \<equiv> the (to_path + [[10,19,4,29,12], + [3,30,11,20,5], + [18,9,24,13,28], + [25,2,17,6,21], + [16,23,8,27,14], + [1,26,15,22,7]])" +lemma kp_6x5_ul: "knights_path b6x5 kp6x5ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_6x5_ul_hd: "hd kp6x5ul = (1,1)" by eval + +lemma kp_6x5_ul_last: "last kp6x5ul = (5,2)" by eval + +lemma kp_6x5_ul_non_nil: "kp6x5ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(6\<times>5)\<close>-board. + \begin{table}[H] + \begin{tabular}{lllll} + 16 & 9 & 6 & 27 & 18 \\ + 7 & 26 & 17 & 14 & 5 \\ + 10 & 15 & 8 & 19 & 28 \\ + 25 & 30 & 23 & 4 & 13 \\ + 22 & 11 & 2 & 29 & 20 \\ + 1 & 24 & 21 & 12 & 3 + \end{tabular} + \end{table}\<close> +abbreviation "kc6x5 \<equiv> the (to_path + [[16,9,6,27,18], + [7,26,17,14,5], + [10,15,8,19,28], + [25,30,23,4,13], + [22,11,2,29,20], + [1,24,21,12,3]])" +lemma kc_6x5: "knights_circuit b6x5 kc6x5" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_6x5_hd: "hd kc6x5 = (1,1)" by eval + +lemma kc_6x5_non_nil: "kc6x5 \<noteq> []" by eval + +abbreviation "b6x6 \<equiv> board 6 6" + +text \<open>The path given for the \<open>6\<times>6\<close>-board that ends in the upper-left is wrong. The Knight cannot +move from square 26 to square 27. + \begin{table}[H] + \begin{tabular}{llllll} + 14 & 23 & 6 & 28 & 12 & 21 \\ + 7 & 36 & 13 & 22 & 5 & \color{red}{27} \\ + 24 & 15 & 29 & 35 & 20 & 11 \\ + 30 & 8 & 17 & \color{red}{26} & 34 & 4 \\ + 16 & 25 & 2 & 32 & 10 & 19 \\ + 1 & 31 & 9 & 18 & 3 & 33 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x6ul_false \<equiv> the (to_path + [[14,23,6,28,12,21], + [7,36,13,22,5,27], + [24,15,29,35,20,11], + [30,8,17,26,34,4], + [16,25,2,32,10,19], + [1,31,9,18,3,33]])" + +lemma "\<not>knights_path b6x6 kp6x6ul_false" + by (simp only: knights_path_exec_simp) eval + +text \<open>I have computed a correct Knight's path for the \<open>6\<times>6\<close>-board that ends in the upper-left. +A Knight's path for the \<open>(6\<times>6)\<close>-board that starts in the lower-left and ends in the upper-left. + \begin{table}[H] + \begin{tabular}{llllll} + 8 & 25 & 10 & 21 & 6 & 23 \\ + 11 & 36 & 7 & 24 & 33 & 20 \\ + 26 & 9 & 34 & 3 & 22 & 5 \\ + 35 & 12 & 15 & 30 & 19 & 32 \\ + 14 & 27 & 2 & 17 & 4 & 29 \\ + 1 & 16 & 13 & 28 & 31 & 18 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x6ul \<equiv> the (to_path + [[8,25,10,21,6,23], + [11,36,7,24,33,20], + [26,9,34,3,22,5], + [35,12,15,30,19,32], + [14,27,2,17,4,29], + [1,16,13,28,31,18]])" +lemma kp_6x6_ul: "knights_path b6x6 kp6x6ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_6x6_ul_hd: "hd kp6x6ul = (1,1)" by eval + +lemma kp_6x6_ul_last: "last kp6x6ul = (5,2)" by eval + +lemma kp_6x6_ul_non_nil: "kp6x6ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(6\<times>6)\<close>-board. + \begin{table}[H] + \begin{tabular}{llllll} + 4 & 25 & 34 & 15 & 18 & 7 \\ + 35 & 14 & 5 & 8 & 33 & 16 \\ + 24 & 3 & 26 & 17 & 6 & 19 \\ + 13 & 36 & 23 & 30 & 9 & 32 \\ + 22 & 27 & 2 & 11 & 20 & 29 \\ + 1 & 12 & 21 & 28 & 31 & 10 + \end{tabular} + \end{table}\<close> +abbreviation "kc6x6 \<equiv> the (to_path + [[4,25,34,15,18,7], + [35,14,5,8,33,16], + [24,3,26,17,6,19], + [13,36,23,30,9,32], + [22,27,2,11,20,29], + [1,12,21,28,31,10]])" +lemma kc_6x6: "knights_circuit b6x6 kc6x6" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_6x6_hd: "hd kc6x6 = (1,1)" by eval + +lemma kc_6x6_non_nil: "kc6x6 \<noteq> []" by eval + +abbreviation "b6x7 \<equiv> board 6 7" + +text \<open>A Knight's path for the \<open>(6\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllll} + 18 & 23 & 8 & 39 & 16 & 25 & 6 \\ + 9 & 42 & 17 & 24 & 7 & 40 & 15 \\ + 22 & 19 & 32 & 41 & 38 & 5 & 26 \\ + 33 & 10 & 21 & 28 & 31 & 14 & 37 \\ + 20 & 29 & 2 & 35 & 12 & 27 & 4 \\ + 1 & 34 & 11 & 30 & 3 & 36 & 13 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x7ul \<equiv> the (to_path + [[18,23,8,39,16,25,6], + [9,42,17,24,7,40,15], + [22,19,32,41,38,5,26], + [33,10,21,28,31,14,37], + [20,29,2,35,12,27,4], + [1,34,11,30,3,36,13]])" +lemma kp_6x7_ul: "knights_path b6x7 kp6x7ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_6x7_ul_hd: "hd kp6x7ul = (1,1)" by eval + +lemma kp_6x7_ul_last: "last kp6x7ul = (5,2)" by eval + +lemma kp_6x7_ul_non_nil: "kp6x7ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(6\<times>7)\<close>-board. + \begin{table}[H] + \begin{tabular}{lllllll} + 26 & 37 & 8 & 17 & 28 & 31 & 6 \\ + 9 & 18 & 27 & 36 & 7 & 16 & 29 \\ + 38 & 25 & 10 & 19 & 30 & 5 & 32 \\ + 11 & 42 & 23 & 40 & 35 & 20 & 15 \\ + 24 & 39 & 2 & 13 & 22 & 33 & 4 \\ + 1 & 12 & 41 & 34 & 3 & 14 & 21 + \end{tabular} + \end{table}\<close> +abbreviation "kc6x7 \<equiv> the (to_path + [[26,37,8,17,28,31,6], + [9,18,27,36,7,16,29], + [38,25,10,19,30,5,32], + [11,42,23,40,35,20,15], + [24,39,2,13,22,33,4], + [1,12,41,34,3,14,21]])" +lemma kc_6x7: "knights_circuit b6x7 kc6x7" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_6x7_hd: "hd kc6x7 = (1,1)" by eval + +lemma kc_6x7_non_nil: "kc6x7 \<noteq> []" by eval + +abbreviation "b6x8 \<equiv> board 6 8" + +text \<open>A Knight's path for the \<open>(6\<times>8)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{llllllll} + 18 & 31 & 8 & 35 & 16 & 33 & 6 & 45 \\ + 9 & 48 & 17 & 32 & 7 & 46 & 15 & 26 \\ + 30 & 19 & 36 & 47 & 34 & 27 & 44 & 5 \\ + 37 & 10 & 21 & 28 & 43 & 40 & 25 & 14 \\ + 20 & 29 & 2 & 39 & 12 & 23 & 4 & 41 \\ + 1 & 38 & 11 & 22 & 3 & 42 & 13 & 24 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x8ul \<equiv> the (to_path + [[18,31,8,35,16,33,6,45], + [9,48,17,32,7,46,15,26], + [30,19,36,47,34,27,44,5], + [37,10,21,28,43,40,25,14], + [20,29,2,39,12,23,4,41], + [1,38,11,22,3,42,13,24]])" +lemma kp_6x8_ul: "knights_path b6x8 kp6x8ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_6x8_ul_hd: "hd kp6x8ul = (1,1)" by eval + +lemma kp_6x8_ul_last: "last kp6x8ul = (5,2)" by eval + +lemma kp_6x8_ul_non_nil: "kp6x8ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(6\<times>8)\<close>-board. + \begin{table}[H] + \begin{tabular}{llllllll} + 30 & 35 & 8 & 15 & 28 & 39 & 6 & 13 \\ + 9 & 16 & 29 & 36 & 7 & 14 & 27 & 38 \\ + 34 & 31 & 10 & 23 & 40 & 37 & 12 & 5 \\ + 17 & 48 & 33 & 46 & 11 & 22 & 41 & 26 \\ + 32 & 45 & 2 & 19 & 24 & 43 & 4 & 21 \\ + 1 & 18 & 47 & 44 & 3 & 20 & 25 & 42 + \end{tabular} + \end{table}\<close> +abbreviation "kc6x8 \<equiv> the (to_path + [[30,35,8,15,28,39,6,13], + [9,16,29,36,7,14,27,38], + [34,31,10,23,40,37,12,5], + [17,48,33,46,11,22,41,26], + [32,45,2,19,24,43,4,21], + [1,18,47,44,3,20,25,42]])" +lemma kc_6x8: "knights_circuit b6x8 kc6x8" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_6x8_hd: "hd kc6x8 = (1,1)" by eval + +lemma kc_6x8_non_nil: "kc6x8 \<noteq> []" by eval + +abbreviation "b6x9 \<equiv> board 6 9" + +text \<open>A Knight's path for the \<open>(6\<times>9)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllllll} + 22 & 45 & 10 & 53 & 20 & 47 & 8 & 35 & 18 \\ + 11 & 54 & 21 & 46 & 9 & 36 & 19 & 48 & 7 \\ + 44 & 23 & 42 & 37 & 52 & 49 & 32 & 17 & 34 \\ + 41 & 12 & 25 & 50 & 27 & 38 & 29 & 6 & 31 \\ + 24 & 43 & 2 & 39 & 14 & 51 & 4 & 33 & 16 \\ + 1 & 40 & 13 & 26 & 3 & 28 & 15 & 30 & 5 + \end{tabular} + \end{table}\<close> +abbreviation "kp6x9ul \<equiv> the (to_path + [[22,45,10,53,20,47,8,35,18], + [11,54,21,46,9,36,19,48,7], + [44,23,42,37,52,49,32,17,34], + [41,12,25,50,27,38,29,6,31], + [24,43,2,39,14,51,4,33,16], + [1,40,13,26,3,28,15,30,5]])" +lemma kp_6x9_ul: "knights_path b6x9 kp6x9ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_6x9_ul_hd: "hd kp6x9ul = (1,1)" by eval + +lemma kp_6x9_ul_last: "last kp6x9ul = (5,2)" by eval + +lemma kp_6x9_ul_non_nil: "kp6x9ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(6\<times>9)\<close>-board. + \begin{table}[H] + \begin{tabular}{lllllllll} + 14 & 49 & 4 & 51 & 24 & 39 & 6 & 29 & 22 \\ + 3 & 52 & 13 & 40 & 5 & 32 & 23 & 42 & 7 \\ + 48 & 15 & 50 & 25 & 38 & 41 & 28 & 21 & 30 \\ + 53 & 2 & 37 & 12 & 33 & 26 & 31 & 8 & 43 \\ + 16 & 47 & 54 & 35 & 18 & 45 & 10 & 27 & 20 \\ + 1 & 36 & 17 & 46 & 11 & 34 & 19 & 44 & 9 + \end{tabular} + \end{table}\<close> +abbreviation "kc6x9 \<equiv> the (to_path + [[14,49,4,51,24,39,6,29,22], + [3,52,13,40,5,32,23,42,7], + [48,15,50,25,38,41,28,21,30], + [53,2,37,12,33,26,31,8,43], + [16,47,54,35,18,45,10,27,20], + [1,36,17,46,11,34,19,44,9]])" +lemma kc_6x9: "knights_circuit b6x9 kc6x9" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_6x9_hd: "hd kc6x9 = (1,1)" by eval + +lemma kc_6x9_non_nil: "kc6x9 \<noteq> []" by eval + +lemmas kp_6xm_ul = + kp_6x5_ul kp_6x5_ul_hd kp_6x5_ul_last kp_6x5_ul_non_nil + kp_6x6_ul kp_6x6_ul_hd kp_6x6_ul_last kp_6x6_ul_non_nil + kp_6x7_ul kp_6x7_ul_hd kp_6x7_ul_last kp_6x7_ul_non_nil + kp_6x8_ul kp_6x8_ul_hd kp_6x8_ul_last kp_6x8_ul_non_nil + kp_6x9_ul kp_6x9_ul_hd kp_6x9_ul_last kp_6x9_ul_non_nil + +lemmas kc_6xm = + kc_6x5 kc_6x5_hd kc_6x5_non_nil + kc_6x6 kc_6x6_hd kc_6x6_non_nil + kc_6x7 kc_6x7_hd kc_6x7_non_nil + kc_6x8 kc_6x8_hd kc_6x8_non_nil + kc_6x9 kc_6x9_hd kc_6x9_non_nil + +text \<open>For every \<open>6\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's path that starts in +\<open>(1,1)\<close> (bottom-left) and ends in \<open>(5,2)\<close> (top-left).\<close> +lemma knights_path_6xm_ul_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_path (board 6 m) ps \<and> hd ps = (1,1) \<and> last ps = (5,2)" + using assms +proof (induction m rule: less_induct) + case (less m) + then have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" by auto + then show ?case + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kp_6xm_ul by fastforce + next + let ?ps\<^sub>1="kp6x5ul" + let ?b\<^sub>1="board 6 5" + have ps\<^sub>1_prems: "knights_path ?b\<^sub>1 ?ps\<^sub>1" "hd ?ps\<^sub>1 = (1,1)" "last ?ps\<^sub>1 = (5,2)" + using kp_6xm_ul by auto + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then obtain ps\<^sub>2 where ps\<^sub>2_IH: "knights_path (board 6 (m-5)) ps\<^sub>2" "hd ps\<^sub>2 = (1,1)" + "last ps\<^sub>2 = (5,2)" + using less.IH[of "m-5"] knights_path_non_nil by auto + + have "27 < length ?ps\<^sub>1" "last (take 27 ?ps\<^sub>1) = (2,4)" "hd (drop 27 ?ps\<^sub>1) = (4,5)" by eval+ + then have "step_in ?ps\<^sub>1 (2,4) (4,5)" + unfolding step_in_def using zero_less_numeral by blast + then have "step_in ?ps\<^sub>1 (2,4) (4,5)" + "valid_step (2,4) (1,int 5+1)" + "valid_step (5,int 5+2) (4,5)" + unfolding valid_step_def by auto + then show ?thesis + using \<open>5 \<le> m-5\<close> ps\<^sub>1_prems ps\<^sub>2_IH knights_path_split_concat[of 6 5 ?ps\<^sub>1 "m-5" ps\<^sub>2] by auto + qed +qed + +text \<open>For every \<open>6\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's circuit.\<close> +lemma knights_circuit_6xm_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_circuit (board 6 m) ps" + using assms +proof - + have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" using assms by auto + then show ?thesis + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kc_6xm by fastforce + next + let ?ps\<^sub>1="rev kc6x5" + have "knights_circuit b6x5 ?ps\<^sub>1" "last ?ps\<^sub>1 = (1,1)" + using kc_6xm knights_circuit_rev by (auto simp: last_rev) + then have ps\<^sub>1_prems: "knights_path b6x5 ?ps\<^sub>1" "valid_step (last ?ps\<^sub>1) (hd ?ps\<^sub>1)" + unfolding knights_circuit_def using valid_step_rev by auto + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then obtain ps\<^sub>2 where ps2_prems: "knights_path (board 6 (m-5)) ps\<^sub>2" "hd ps\<^sub>2 = (1,1)" + "last ps\<^sub>2 = (5,2)" + using knights_path_6xm_ul_exists[of "(m-5)"] knights_path_non_nil by auto + + have "2 < length ?ps\<^sub>1" "last (take 2 ?ps\<^sub>1) = (2,4)" "hd (drop 2 ?ps\<^sub>1) = (4,5)" by eval+ + then have "step_in ?ps\<^sub>1 (2,4) (4,5)" + unfolding step_in_def using zero_less_numeral by blast + then have "step_in ?ps\<^sub>1 (2,4) (4,5)" + "valid_step (2,4) (1,int 5+1)" + "valid_step (5,int 5+2) (4,5)" + unfolding valid_step_def by auto + then have "\<exists>ps. knights_path (board 6 m) ps \<and> hd ps = hd ?ps\<^sub>1 \<and> last ps = last ?ps\<^sub>1" + using m_ge ps\<^sub>1_prems ps2_prems knights_path_split_concat[of 6 5 ?ps\<^sub>1 "m-5" ps\<^sub>2] by auto + then show ?thesis using ps\<^sub>1_prems by (auto simp: knights_circuit_def) + qed +qed + +text \<open>@{thm knights_path_6xm_ul_exists} and @{thm knights_circuit_6xm_exists} formalize Lemma 2 +from @{cite "cull_decurtins_1987"}.\<close> +lemmas knights_path_6xm_exists = knights_path_6xm_ul_exists knights_circuit_6xm_exists + +section \<open>Knight's Paths and Circuits for \<open>8\<times>m\<close>-Boards\<close> + +abbreviation "b8x5 \<equiv> board 8 5" + +text \<open>A Knight's path for the \<open>(8\<times>5)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllll} + 28 & 7 & 22 & 39 & 26 \\ + 23 & 40 & 27 & 6 & 21 \\ + 8 & 29 & 38 & 25 & 14 \\ + 37 & 24 & 15 & 20 & 5 \\ + 16 & 9 & 30 & 13 & 34 \\ + 31 & 36 & 33 & 4 & 19 \\ + 10 & 17 & 2 & 35 & 12 \\ + 1 & 32 & 11 & 18 & 3 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x5ul \<equiv> the (to_path + [[28,7,22,39,26], + [23,40,27,6,21], + [8,29,38,25,14], + [37,24,15,20,5], + [16,9,30,13,34], + [31,36,33,4,19], + [10,17,2,35,12], + [1,32,11,18,3]])" +lemma kp_8x5_ul: "knights_path b8x5 kp8x5ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_8x5_ul_hd: "hd kp8x5ul = (1,1)" by eval + +lemma kp_8x5_ul_last: "last kp8x5ul = (7,2)" by eval + +lemma kp_8x5_ul_non_nil: "kp8x5ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(8\<times>5)\<close>-board. + \begin{table}[H] + \begin{tabular}{lllll} + 26 & 7 & 28 & 15 & 24 \\ + 31 & 16 & 25 & 6 & 29 \\ + 8 & 27 & 30 & 23 & 14 \\ + 17 & 32 & 39 & 34 & 5 \\ + 38 & 9 & 18 & 13 & 22 \\ + 19 & 40 & 33 & 4 & 35 \\ + 10 & 37 & 2 & 21 & 12 \\ + 1 & 20 & 11 & 36 & 3 + \end{tabular} + \end{table}\<close> +abbreviation "kc8x5 \<equiv> the (to_path + [[26,7,28,15,24], + [31,16,25,6,29], + [8,27,30,23,14], + [17,32,39,34,5], + [38,9,18,13,22], + [19,40,33,4,35], + [10,37,2,21,12], + [1,20,11,36,3]])" +lemma kc_8x5: "knights_circuit b8x5 kc8x5" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_8x5_hd: "hd kc8x5 = (1,1)" by eval + +lemma kc_8x5_last: "last kc8x5 = (3,2)" by eval + +lemma kc_8x5_non_nil: "kc8x5 \<noteq> []" by eval + +lemma kc_8x5_si: "step_in kc8x5 (2,4) (4,5)" (is "step_in ?ps _ _") +proof - + have "0 < (21::nat)" "21 < length ?ps" "last (take 21 ?ps) = (2,4)" "hd (drop 21 ?ps) = (4,5)" + by eval+ + then show ?thesis unfolding step_in_def by blast +qed + +abbreviation "b8x6 \<equiv> board 8 6" + +text \<open>A Knight's path for the \<open>(8\<times>6)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{llllll} + 42 & 11 & 26 & 9 & 34 & 13 \\ + 25 & 48 & 43 & 12 & 27 & 8 \\ + 44 & 41 & 10 & 33 & 14 & 35 \\ + 47 & 24 & 45 & 20 & 7 & 28 \\ + 40 & 19 & 32 & 3 & 36 & 15 \\ + 23 & 46 & 21 & 6 & 29 & 4 \\ + 18 & 39 & 2 & 31 & 16 & 37 \\ + 1 & 22 & 17 & 38 & 5 & 30 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x6ul \<equiv> the (to_path + [[42,11,26,9,34,13], + [25,48,43,12,27,8], + [44,41,10,33,14,35], + [47,24,45,20,7,28], + [40,19,32,3,36,15], + [23,46,21,6,29,4], + [18,39,2,31,16,37], + [1,22,17,38,5,30]])" +lemma kp_8x6_ul: "knights_path b8x6 kp8x6ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_8x6_ul_hd: "hd kp8x6ul = (1,1)" by eval + +lemma kp_8x6_ul_last: "last kp8x6ul = (7,2)" by eval + +lemma kp_8x6_ul_non_nil: "kp8x6ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(8\<times>6)\<close>-board. I have reversed circuit s.t. the circuit steps +from \<open>(2,5)\<close> to \<open>(4,6)\<close> and not the other way around. This makes the proofs easier. + \begin{table}[H] + \begin{tabular}{llllll} + 8 & 29 & 24 & 45 & 12 & 37 \\ + 25 & 46 & 9 & 38 & 23 & 44 \\ + 30 & 7 & 28 & 13 & 36 & 11 \\ + 47 & 26 & 39 & 10 & 43 & 22 \\ + 6 & 31 & 4 & 27 & 14 & 35 \\ + 3 & 48 & 17 & 40 & 21 & 42 \\ + 32 & 5 & 2 & 19 & 34 & 15 \\ + 1 & 18 & 33 & 16 & 41 & 20 + \end{tabular} + \end{table}\<close> +abbreviation "kc8x6 \<equiv> the (to_path + [[8,29,24,45,12,37], + [25,46,9,38,23,44], + [30,7,28,13,36,11], + [47,26,39,10,43,22], + [6,31,4,27,14,35], + [3,48,17,40,21,42], + [32,5,2,19,34,15], + [1,18,33,16,41,20]])" +lemma kc_8x6: "knights_circuit b8x6 kc8x6" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_8x6_hd: "hd kc8x6 = (1,1)" by eval + +lemma kc_8x6_non_nil: "kc8x6 \<noteq> []" by eval + +lemma kc_8x6_si: "step_in kc8x6 (2,5) (4,6)" (is "step_in ?ps _ _") +proof - + have "0 < (34::nat)" "34 < length ?ps" + "last (take 34 ?ps) = (2,5)" "hd (drop 34 ?ps) = (4,6)" by eval+ + then show ?thesis unfolding step_in_def by blast +qed + +abbreviation "b8x7 \<equiv> board 8 7" + +text \<open>A Knight's path for the \<open>(8\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllll} + 38 & 19 & 6 & 55 & 46 & 21 & 8 \\ + 5 & 56 & 39 & 20 & 7 & 54 & 45 \\ + 18 & 37 & 4 & 47 & 34 & 9 & 22 \\ + 3 & 48 & 35 & 40 & 53 & 44 & 33 \\ + 36 & 17 & 52 & 49 & 32 & 23 & 10 \\ + 51 & 2 & 29 & 14 & 41 & 26 & 43 \\ + 16 & 13 & 50 & 31 & 28 & 11 & 24 \\ + 1 & 30 & 15 & 12 & 25 & 42 & 27 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x7ul \<equiv> the (to_path + [[38,19,6,55,46,21,8], + [5,56,39,20,7,54,45], + [18,37,4,47,34,9,22], + [3,48,35,40,53,44,33], + [36,17,52,49,32,23,10], + [51,2,29,14,41,26,43], + [16,13,50,31,28,11,24], + [1,30,15,12,25,42,27]])" +lemma kp_8x7_ul: "knights_path b8x7 kp8x7ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_8x7_ul_hd: "hd kp8x7ul = (1,1)" by eval + +lemma kp_8x7_ul_last: "last kp8x7ul = (7,2)" by eval + +lemma kp_8x7_ul_non_nil: "kp8x7ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(8\<times>7)\<close>-board. I have reversed circuit s.t. the circuit steps +from \<open>(2,6)\<close> to \<open>(4,7)\<close> and not the other way around. This makes the proofs easier. + \begin{table}[H] + \begin{tabular}{lllllll} + 36 & 31 & 18 & 53 & 20 & 29 & 44 \\ + 17 & 54 & 35 & 30 & 45 & 52 & 21 \\ + 32 & 37 & 46 & 19 & 8 & 43 & 28 \\ + 55 & 16 & 7 & 34 & 27 & 22 & 51 \\ + 38 & 33 & 26 & 47 & 6 & 9 & 42 \\ + 3 & 56 & 15 & 12 & 25 & 50 & 23 \\ + 14 & 39 & 2 & 5 & 48 & 41 & 10 \\ + 1 & 4 & 13 & 40 & 11 & 24 & 49 + \end{tabular} + \end{table}\<close> +abbreviation "kc8x7 \<equiv> the (to_path + [[36,31,18,53,20,29,44], + [17,54,35,30,45,52,21], + [32,37,46,19,8,43,28], + [55,16,7,34,27,22,51], + [38,33,26,47,6,9,42], + [3,56,15,12,25,50,23], + [14,39,2,5,48,41,10], + [1,4,13,40,11,24,49]])" +lemma kc_8x7: "knights_circuit b8x7 kc8x7" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_8x7_hd: "hd kc8x7 = (1,1)" by eval + +lemma kc_8x7_non_nil: "kc8x7 \<noteq> []" by eval + +lemma kc_8x7_si: "step_in kc8x7 (2,6) (4,7)" (is "step_in ?ps _ _") +proof - + have "0 < (41::nat)" "41 < length ?ps" + "last (take 41 ?ps) = (2,6)" "hd (drop 41 ?ps) = (4,7)" by eval+ + then show ?thesis unfolding step_in_def by blast +qed + +abbreviation "b8x8 \<equiv> board 8 8" + +text \<open>The path given for the \<open>8\<times>8\<close>-board that ends in the upper-left is wrong. The Knight cannot +move from square 27 to square 28. + \begin{table}[H] + \begin{tabular}{llllllll} + 24 & 11 & 37 & 9 & 26 & 21 & 39 & 7 \\ + 36 & 64 & 24 & 22 & 38 & 8 & \color{red}{27} & 20 \\ + 12 & 23 & 10 & 53 & 58 & 49 & 6 & \color{red}{28} \\ + 63 & 35 & 61 & 50 & 55 & 52 & 19 & 40 \\ + 46 & 13 & 54 & 57 & 48 & 59 & 29 & 5 \\ + 34 & 62 & 47 & 60 & 51 & 56 & 41 & 18 \\ + 14 & 45 & 2 & 32 & 16 & 43 & 4 & 30 \\ + 1 & 33 & 15 & 44 & 3 & 31 & 17 & 42 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x8ul_false \<equiv> the (to_path + [[24,11,37,9,26,21,39,7], + [36,64,25,22,38,8,27,20], + [12,23,10,53,58,49,6,28], + [63,35,61,50,55,52,19,40], + [46,13,54,57,48,59,29,5], + [34,62,47,60,51,56,41,18], + [14,45,2,32,16,43,4,30], + [1,33,15,44,3,31,17,42]])" + +lemma "\<not>knights_path b8x8 kp8x8ul_false" + by (simp only: knights_path_exec_simp) eval + +text \<open>I have computed a correct Knight's path for the \<open>8\<times>8\<close>-board that ends in the upper-left. + \begin{table}[H] + \begin{tabular}{llllllll} + 38 & 41 & 36 & 27 & 32 & 43 & 20 & 25 \\ + 35 & 64 & 39 & 42 & 21 & 26 & 29 & 44 \\ + 40 & 37 & 6 & 33 & 28 & 31 & 24 & 19 \\ + 5 & 34 & 63 & 14 & 7 & 22 & 45 & 30 \\ + 62 & 13 & 4 & 9 & 58 & 49 & 18 & 23 \\ + 3 & 10 & 61 & 52 & 15 & 8 & 57 & 46 \\ + 12 & 53 & 2 & 59 & 48 & 55 & 50 & 17 \\ + 1 & 60 & 11 & 54 & 51 & 16 & 47 & 56 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x8ul \<equiv> the (to_path + [[38,41,36,27,32,43,20,25], + [35,64,39,42,21,26,29,44], + [40,37,6,33,28,31,24,19], + [5,34,63,14,7,22,45,30], + [62,13,4,9,58,49,18,23], + [3,10,61,52,15,8,57,46], + [12,53,2,59,48,55,50,17], + [1,60,11,54,51,16,47,56]])" + +lemma kp_8x8_ul: "knights_path b8x8 kp8x8ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_8x8_ul_hd: "hd kp8x8ul = (1,1)" by eval + +lemma kp_8x8_ul_last: "last kp8x8ul = (7,2)" by eval + +lemma kp_8x8_ul_non_nil: "kp8x8ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(8\<times>8)\<close>-board. + \begin{table}[H] + \begin{tabular}{llllllll} + 48 & 13 & 30 & 9 & 56 & 45 & 28 & 7 \\ + 31 & 10 & 47 & 50 & 29 & 8 & 57 & 44 \\ + 14 & 49 & 12 & 55 & 46 & 59 & 6 & 27 \\ + 11 & 32 & 37 & 60 & 51 & 54 & 43 & 58 \\ + 36 & 15 & 52 & 63 & 38 & 61 & 26 & 5 \\ + 33 & 64 & 35 & 18 & 53 & 40 & 23 & 42 \\ + 16 & 19 & 2 & 39 & 62 & 21 & 4 & 25 \\ + 1 & 34 & 17 & 20 & 3 & 24 & 41 & 22 + \end{tabular} + \end{table}\<close> +abbreviation "kc8x8 \<equiv> the (to_path + [[48,13,30,9,56,45,28,7], + [31,10,47,50,29,8,57,44], + [14,49,12,55,46,59,6,27], + [11,32,37,60,51,54,43,58], + [36,15,52,63,38,61,26,5], + [33,64,35,18,53,40,23,42], + [16,19,2,39,62,21,4,25], + [1,34,17,20,3,24,41,22]])" +lemma kc_8x8: "knights_circuit b8x8 kc8x8" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_8x8_hd: "hd kc8x8 = (1,1)" by eval + +lemma kc_8x8_non_nil: "kc8x8 \<noteq> []" by eval + +lemma kc_8x8_si: "step_in kc8x8 (2,7) (4,8)" (is "step_in ?ps _ _") +proof - + have "0 < (4::nat)" "4 < length ?ps" + "last (take 4 ?ps) = (2,7)" "hd (drop 4 ?ps) = (4,8)" by eval+ + then show ?thesis unfolding step_in_def by blast +qed + +abbreviation "b8x9 \<equiv> board 8 9" + +text \<open>A Knight's path for the \<open>(8\<times>9)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllllll} + 32 & 47 & 6 & 71 & 30 & 45 & 8 & 43 & 26 \\ + 5 & 72 & 31 & 46 & 7 & 70 & 27 & 22 & 9 \\ + 48 & 33 & 4 & 29 & 64 & 23 & 44 & 25 & 42 \\ + 3 & 60 & 35 & 62 & 69 & 28 & 41 & 10 & 21 \\ + 34 & 49 & 68 & 65 & 36 & 63 & 24 & 55 & 40 \\ + 59 & 2 & 61 & 16 & 67 & 56 & 37 & 20 & 11 \\ + 50 & 15 & 66 & 57 & 52 & 13 & 18 & 39 & 54 \\ + 1 & 58 & 51 & 14 & 17 & 38 & 53 & 12 & 19 + \end{tabular} + \end{table}\<close> +abbreviation "kp8x9ul \<equiv> the (to_path + [[32,47,6,71,30,45,8,43,26], + [5,72,31,46,7,70,27,22,9], + [48,33,4,29,64,23,44,25,42], + [3,60,35,62,69,28,41,10,21], + [34,49,68,65,36,63,24,55,40], + [59,2,61,16,67,56,37,20,11], + [50,15,66,57,52,13,18,39,54], + [1,58,51,14,17,38,53,12,19]])" +lemma kp_8x9_ul: "knights_path b8x9 kp8x9ul" + by (simp only: knights_path_exec_simp) eval + +lemma kp_8x9_ul_hd: "hd kp8x9ul = (1,1)" by eval + +lemma kp_8x9_ul_last: "last kp8x9ul = (7,2)" by eval + +lemma kp_8x9_ul_non_nil: "kp8x9ul \<noteq> []" by eval + +text \<open>A Knight's circuit for the \<open>(8\<times>9)\<close>-board. + \begin{table}[H] + \begin{tabular}{lllllllll} + 42 & 19 & 38 & 5 & 36 & 21 & 34 & 7 & 60 \\ + 39 & 4 & 41 & 20 & 63 & 6 & 59 & 22 & 33 \\ + 18 & 43 & 70 & 37 & 58 & 35 & 68 & 61 & 8 \\ + 3 & 40 & 49 & 64 & 69 & 62 & 57 & 32 & 23 \\ + 50 & 17 & 44 & 71 & 48 & 67 & 54 & 9 & 56 \\ + 45 & 2 & 65 & 14 & 27 & 12 & 29 & 24 & 31 \\ + 16 & 51 & 72 & 47 & 66 & 53 & 26 & 55 & 10 \\ + 1 & 46 & 15 & 52 & 13 & 28 & 11 & 30 & 25 + \end{tabular} + \end{table}\<close> +abbreviation "kc8x9 \<equiv> the (to_path + [[42,19,38,5,36,21,34,7,60], + [39,4,41,20,63,6,59,22,33], + [18,43,70,37,58,35,68,61,8], + [3,40,49,64,69,62,57,32,23], + [50,17,44,71,48,67,54,9,56], + [45,2,65,14,27,12,29,24,31], + [16,51,72,47,66,53,26,55,10], + [1,46,15,52,13,28,11,30,25]])" +lemma kc_8x9: "knights_circuit b8x9 kc8x9" + by (simp only: knights_circuit_exec_simp) eval + +lemma kc_8x9_hd: "hd kc8x9 = (1,1)" by eval + +lemma kc_8x9_non_nil: "kc8x9 \<noteq> []" by eval + +lemma kc_8x9_si: "step_in kc8x9 (2,8) (4,9)" (is "step_in ?ps _ _") +proof - + have "0 < (55::nat)" "55 < length ?ps" + "last (take 55 ?ps) = (2,8)" "hd (drop 55 ?ps) = (4,9)" by eval+ + then show ?thesis unfolding step_in_def by blast +qed + +lemmas kp_8xm_ul = + kp_8x5_ul kp_8x5_ul_hd kp_8x5_ul_last kp_8x5_ul_non_nil + kp_8x6_ul kp_8x6_ul_hd kp_8x6_ul_last kp_8x6_ul_non_nil + kp_8x7_ul kp_8x7_ul_hd kp_8x7_ul_last kp_8x7_ul_non_nil + kp_8x8_ul kp_8x8_ul_hd kp_8x8_ul_last kp_8x8_ul_non_nil + kp_8x9_ul kp_8x9_ul_hd kp_8x9_ul_last kp_8x9_ul_non_nil + +lemmas kc_8xm = + kc_8x5 kc_8x5_hd kc_8x5_last kc_8x5_non_nil kc_8x5_si + kc_8x6 kc_8x6_hd kc_8x6_non_nil kc_8x6_si + kc_8x7 kc_8x7_hd kc_8x7_non_nil kc_8x7_si + kc_8x8 kc_8x8_hd kc_8x8_non_nil kc_8x8_si + kc_8x9 kc_8x9_hd kc_8x9_non_nil kc_8x9_si + +text \<open>For every \<open>8\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's circuit.\<close> +lemma knights_circuit_8xm_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_circuit (board 8 m) ps \<and> step_in ps (2,int m-1) (4,int m)" + using assms +proof (induction m rule: less_induct) + case (less m) + then have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" by auto + then show ?case + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kc_8xm by fastforce + next + let ?ps\<^sub>2="kc8x5" + let ?b\<^sub>2="board 8 5" + have ps\<^sub>2_prems: "knights_circuit ?b\<^sub>2 ?ps\<^sub>2" "hd ?ps\<^sub>2 = (1,1)" "last ?ps\<^sub>2 = (3,2)" + using kc_8xm by auto + have "21 < length ?ps\<^sub>2" "last (take 21 ?ps\<^sub>2) = (2,int 5-1)" "hd (drop 21 ?ps\<^sub>2) = (4,int 5)" + by eval+ + then have si: "step_in ?ps\<^sub>2 (2,int 5-1) (4,int 5)" + unfolding step_in_def using zero_less_numeral by blast + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then obtain ps\<^sub>1 where ps\<^sub>1_IH: "knights_circuit (board 8 (m-5)) ps\<^sub>1" + "step_in ps\<^sub>1 (2,int (m-5)-1) (4,int (m-5))" + using less.IH[of "m-5"] knights_path_non_nil by auto + then show ?thesis + using m_ge ps\<^sub>2_prems si knights_circuit_lr_concat[of 8 "m-5" ps\<^sub>1 5 ?ps\<^sub>2] by auto + qed +qed + +text \<open>For every \<open>8\<times>m\<close>-board with \<open>m \<ge> 5\<close> there exists a knight's path that starts in +\<open>(1,1)\<close> (bottom-left) and ends in \<open>(7,2)\<close> (top-left).\<close> +lemma knights_path_8xm_ul_exists: + assumes "m \<ge> 5" + shows "\<exists>ps. knights_path (board 8 m) ps \<and> hd ps = (1,1) \<and> last ps = (7,2)" + using assms +proof - + have "m \<in> {5,6,7,8,9} \<or> 5 \<le> m-5" using assms by auto + then show ?thesis + proof (elim disjE) + assume "m \<in> {5,6,7,8,9}" + then show ?thesis using kp_8xm_ul by fastforce + next + let ?ps\<^sub>1="kp8x5ul" + have ps\<^sub>1_prems: "knights_path b8x5 ?ps\<^sub>1" "hd ?ps\<^sub>1 = (1,1)" "last ?ps\<^sub>1 = (7,2)" + using kp_8xm_ul by auto + assume m_ge: "5 \<le> m-5" (* \<longleftrightarrow> 10 \<le> m *) + then have b_prems: "5 \<le> min 8 (m-5)" + unfolding board_def by auto + + obtain ps\<^sub>2 where "knights_circuit (board 8 (m-5)) ps\<^sub>2" + using m_ge knights_circuit_8xm_exists[of "(m-5)"] knights_path_non_nil by auto + then obtain ps\<^sub>2' where ps\<^sub>2'_prems': "knights_circuit (board 8 (m-5)) ps\<^sub>2'" + "hd ps\<^sub>2' = (1,1)" "last ps\<^sub>2' = (3,2)" + using b_prems \<open>5 \<le> min 8 (m-5)\<close> rotate_knights_circuit by blast + then have ps\<^sub>2'_path: "knights_path (board 8 (m-5)) (rev ps\<^sub>2')" + "valid_step (last ps\<^sub>2') (hd ps\<^sub>2')" "hd (rev ps\<^sub>2') = (3,2)" "last (rev ps\<^sub>2') = (1,1)" + unfolding knights_circuit_def using knights_path_rev by (auto simp: hd_rev last_rev) + + have "34 < length ?ps\<^sub>1" "last (take 34 ?ps\<^sub>1) = (4,5)" "hd (drop 34 ?ps\<^sub>1) = (2,4)" by eval+ + then have "step_in ?ps\<^sub>1 (4,5) (2,4)" + unfolding step_in_def using zero_less_numeral by blast + then have "step_in ?ps\<^sub>1 (4,5) (2,4)" + "valid_step (4,5) (3,int 5+2)" + "valid_step (1,int 5+1) (2,4)" + unfolding valid_step_def by auto + then have "\<exists>ps. knights_path (board 8 m) ps \<and> hd ps = hd ?ps\<^sub>1 \<and> last ps = last ?ps\<^sub>1" + using m_ge ps\<^sub>1_prems ps\<^sub>2'_prems' ps\<^sub>2'_path + knights_path_split_concat[of 8 5 ?ps\<^sub>1 "m-5" "rev ps\<^sub>2'"] by auto + then show ?thesis using ps\<^sub>1_prems by auto + qed +qed + +text \<open>@{thm knights_circuit_8xm_exists} and @{thm knights_path_8xm_ul_exists} formalize Lemma 3 +from @{cite "cull_decurtins_1987"}.\<close> +lemmas knights_path_8xm_exists = knights_circuit_8xm_exists knights_path_8xm_ul_exists + +section \<open>Knight's Paths and Circuits for \<open>n\<times>m\<close>-Boards\<close> + +text \<open>In this section the desired theorems are proved. The proof uses the previous lemmas to +construct paths and circuits for arbitrary \<open>n\<times>m\<close>-boards.\<close> + +text \<open>A Knight's path for the \<open>(5\<times>5)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllll} + 7 & 20 & 9 & 14 & 5 \\ + 10 & 25 & 6 & 21 & 16 \\ + 19 & 8 & 15 & 4 & 13 \\ + 24 & 11 & 2 & 17 & 22 \\ + 1 & 18 & 23 & 12 & 3 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x5ul \<equiv> the (to_path + [[7,20,9,14,5], + [10,25,6,21,16], + [19,8,15,4,13], + [24,11,2,17,22], + [1,18,23,12,3]])" +lemma kp_5x5_ul: "knights_path b5x5 kp5x5ul" + by (simp only: knights_path_exec_simp) eval + +text \<open>A Knight's path for the \<open>(5\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllll} + 17 & 14 & 25 & 6 & 19 & 8 & 29 \\ + 26 & 35 & 18 & 15 & 28 & 5 & 20 \\ + 13 & 16 & 27 & 24 & 7 & 30 & 9 \\ + 34 & 23 & 2 & 11 & 32 & 21 & 4 \\ + 1 & 12 & 33 & 22 & 3 & 10 & 31 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x7ul \<equiv> the (to_path + [[17,14,25,6,19,8,29], + [26,35,18,15,28,5,20], + [13,16,27,24,7,30,9], + [34,23,2,11,32,21,4], + [1,12,33,22,3,10,31]])" +lemma kp_5x7_ul: "knights_path b5x7 kp5x7ul" + by (simp only: knights_path_exec_simp) eval + +text \<open>A Knight's path for the \<open>(5\<times>9)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllllll} + 7 & 12 & 37 & 42 & 5 & 18 & 23 & 32 & 27 \\ + 38 & 45 & 6 & 11 & 36 & 31 & 26 & 19 & 24 \\ + 13 & 8 & 43 & 4 & 41 & 22 & 17 & 28 & 33 \\ + 44 & 39 & 2 & 15 & 10 & 35 & 30 & 25 & 20 \\ + 1 & 14 & 9 & 40 & 3 & 16 & 21 & 34 & 29 + \end{tabular} + \end{table}\<close> +abbreviation "kp5x9ul \<equiv> the (to_path + [[7,12,37,42,5,18,23,32,27], + [38,45,6,11,36,31,26,19,24], + [13,8,43,4,41,22,17,28,33], + [44,39,2,15,10,35,30,25,20], + [1,14,9,40,3,16,21,34,29]])" +lemma kp_5x9_ul: "knights_path b5x9 kp5x9ul" + by (simp only: knights_path_exec_simp) eval + +abbreviation "b7x7 \<equiv> board 7 7" + +text \<open>A Knight's path for the \<open>(7\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllll} + 9 & 30 & 19 & 42 & 7 & 32 & 17 \\ + 20 & 49 & 8 & 31 & 18 & 43 & 6 \\ + 29 & 10 & 41 & 36 & 39 & 16 & 33 \\ + 48 & 21 & 38 & 27 & 34 & 5 & 44 \\ + 11 & 28 & 35 & 40 & 37 & 26 & 15 \\ + 22 & 47 & 2 & 13 & 24 & 45 & 4 \\ + 1 & 12 & 23 & 46 & 3 & 14 & 25 + \end{tabular} + \end{table}\<close> +abbreviation "kp7x7ul \<equiv> the (to_path + [[9,30,19,42,7,32,17], + [20,49,8,31,18,43,6], + [29,10,41,36,39,16,33], + [48,21,38,27,34,5,44], + [11,28,35,40,37,26,15], + [22,47,2,13,24,45,4], + [1,12,23,46,3,14,25]])" +lemma kp_7x7_ul: "knights_path b7x7 kp7x7ul" + by (simp only: knights_path_exec_simp) eval + +abbreviation "b7x9 \<equiv> board 7 9" + +text \<open>A Knight's path for the \<open>(7\<times>9)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllllll} + 59 & 4 & 17 & 50 & 37 & 6 & 19 & 30 & 39 \\ + 16 & 63 & 58 & 5 & 18 & 51 & 38 & 7 & 20 \\ + 3 & 60 & 49 & 36 & 57 & 42 & 29 & 40 & 31 \\ + 48 & 15 & 62 & 43 & 52 & 35 & 56 & 21 & 8 \\ + 61 & 2 & 13 & 26 & 45 & 28 & 41 & 32 & 55 \\ + 14 & 47 & 44 & 11 & 24 & 53 & 34 & 9 & 22 \\ + 1 & 12 & 25 & 46 & 27 & 10 & 23 & 54 & 33 + \end{tabular} + \end{table}\<close> +abbreviation "kp7x9ul \<equiv> the (to_path + [[59,4,17,50,37,6,19,30,39], + [16,63,58,5,18,51,38,7,20], + [3,60,49,36,57,42,29,40,31], + [48,15,62,43,52,35,56,21,8], + [61,2,13,26,45,28,41,32,55], + [14,47,44,11,24,53,34,9,22], + [1,12,25,46,27,10,23,54,33]])" +lemma kp_7x9_ul: "knights_path b7x9 kp7x9ul" + by (simp only: knights_path_exec_simp) eval + +abbreviation "b9x7 \<equiv> board 9 7" + +text \<open>A Knight's path for the \<open>(9\<times>7)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllll} + 5 & 20 & 53 & 48 & 7 & 22 & 31 \\ + 52 & 63 & 6 & 21 & 32 & 55 & 8 \\ + 19 & 4 & 49 & 54 & 47 & 30 & 23 \\ + 62 & 51 & 46 & 33 & 56 & 9 & 58 \\ + 3 & 18 & 61 & 50 & 59 & 24 & 29 \\ + 14 & 43 & 34 & 45 & 28 & 57 & 10 \\ + 17 & 2 & 15 & 60 & 35 & 38 & 25 \\ + 42 & 13 & 44 & 27 & 40 & 11 & 36 \\ + 1 & 16 & 41 & 12 & 37 & 26 & 39 + \end{tabular} + \end{table}\<close> +abbreviation "kp9x7ul \<equiv> the (to_path + [[5,20,53,48,7,22,31], + [52,63,6,21,32,55,8], + [19,4,49,54,47,30,23], + [62,51,46,33,56,9,58], + [3,18,61,50,59,24,29], + [14,43,34,45,28,57,10], + [17,2,15,60,35,38,25], + [42,13,44,27,40,11,36], + [1,16,41,12,37,26,39]])" +lemma kp_9x7_ul: "knights_path b9x7 kp9x7ul" + by (simp only: knights_path_exec_simp) eval + +abbreviation "b9x9 \<equiv> board 9 9" + +text \<open>A Knight's path for the \<open>(9\<times>9)\<close>-board that starts in the lower-left and ends in the +upper-left. + \begin{table}[H] + \begin{tabular}{lllllllll} + 13 & 26 & 39 & 52 & 11 & 24 & 37 & 50 & 9 \\ + 40 & 81 & 12 & 25 & 38 & 51 & 10 & 23 & 36 \\ + 27 & 14 & 53 & 58 & 63 & 68 & 73 & 8 & 49 \\ + 80 & 41 & 64 & 67 & 72 & 57 & 62 & 35 & 22 \\ + 15 & 28 & 59 & 54 & 65 & 74 & 69 & 48 & 7 \\ + 42 & 79 & 66 & 71 & 76 & 61 & 56 & 21 & 34 \\ + 29 & 16 & 77 & 60 & 55 & 70 & 75 & 6 & 47 \\ + 78 & 43 & 2 & 31 & 18 & 45 & 4 & 33 & 20 \\ + 1 & 30 & 17 & 44 & 3 & 32 & 19 & 46 & 5 + \end{tabular} + \end{table}\<close> +abbreviation "kp9x9ul \<equiv> the (to_path + [[13,26,39,52,11,24,37,50,9], + [40,81,12,25,38,51,10,23,36], + [27,14,53,58,63,68,73,8,49], + [80,41,64,67,72,57,62,35,22], + [15,28,59,54,65,74,69,48,7], + [42,79,66,71,76,61,56,21,34], + [29,16,77,60,55,70,75,6,47], + [78,43,2,31,18,45,4,33,20], + [1,30,17,44,3,32,19,46,5]])" +lemma kp_9x9_ul: "knights_path b9x9 kp9x9ul" + by (simp only: knights_path_exec_simp) eval + +text \<open>The following lemma is a sub-proof used in Lemma 4 in @{cite "cull_decurtins_1987"}. +I moved the sub-proof out to a separate lemma.\<close> +lemma knights_circuit_exists_even_n_gr10: + assumes "even n" "n \<ge> 10" "m \<ge> 5" + "\<exists>ps. knights_path (board (n-5) m) ps \<and> hd ps = (int (n-5),1) + \<and> last ps = (int (n-5)-1,int m-1)" + shows "\<exists>ps. knights_circuit (board m n) ps" + using assms +proof - + let ?b\<^sub>2="board (n-5) m" + assume "n \<ge> 10" + then obtain ps\<^sub>2 where ps\<^sub>2_prems: "knights_path ?b\<^sub>2 ps\<^sub>2" "hd ps\<^sub>2 = (int (n-5),1)" + "last ps\<^sub>2 = (int (n-5)-1,int m-1)" + using assms by auto + let ?ps\<^sub>2_m2="mirror2 ps\<^sub>2" + have ps\<^sub>2_m2_prems: "knights_path ?b\<^sub>2 ?ps\<^sub>2_m2" "hd ?ps\<^sub>2_m2 = (int (n-5),int m)" + "last ?ps\<^sub>2_m2 = (int (n-5)-1,2)" + using ps\<^sub>2_prems mirror2_knights_path hd_mirror2 last_mirror2 by auto + + obtain ps\<^sub>1 where ps\<^sub>1_prems: "knights_path (board 5 m) ps\<^sub>1" "hd ps\<^sub>1 = (1,1)""last ps\<^sub>1 = (2,int m-1)" + using assms knights_path_5xm_exists by auto + let ?ps\<^sub>1'="trans_path (int (n-5),0) ps\<^sub>1" + let ?b\<^sub>1'="trans_board (int (n-5),0) (board 5 m)" + have ps\<^sub>1'_prems: "knights_path ?b\<^sub>1' ?ps\<^sub>1'" "hd ?ps\<^sub>1' = (int (n-5)+1,1)" + "last ?ps\<^sub>1' = (int (n-5)+2,int m-1)" + using ps\<^sub>1_prems trans_knights_path knights_path_non_nil hd_trans_path last_trans_path by auto + + let ?ps="?ps\<^sub>1'@?ps\<^sub>2_m2" + let ?psT="transpose ?ps" + + have "n-5 \<ge> 5" using \<open>n \<ge> 10\<close> by auto + have inter: "?b\<^sub>1' \<inter> ?b\<^sub>2 = {}" + unfolding trans_board_def board_def using \<open>n-5 \<ge> 5\<close> by auto + have union: "?b\<^sub>1' \<union> ?b\<^sub>2 = board n m" + using \<open>n-5 \<ge> 5\<close> board_concatT[of "n-5" m 5] by auto + + have vs: "valid_step (last ?ps\<^sub>1') (hd ?ps\<^sub>2_m2)" and "valid_step (last ?ps\<^sub>2_m2) (hd ?ps\<^sub>1')" + unfolding valid_step_def using ps\<^sub>1'_prems ps\<^sub>2_m2_prems by auto + then have vs_c: "valid_step (last ?ps) (hd ?ps)" + using ps\<^sub>1'_prems ps\<^sub>2_m2_prems knights_path_non_nil by auto + + have "knights_path (board n m) ?ps" + using ps\<^sub>1'_prems ps\<^sub>2_m2_prems inter vs union knights_path_append[of ?b\<^sub>1' ?ps\<^sub>1' ?b\<^sub>2 ?ps\<^sub>2_m2] + by auto + then have "knights_circuit (board n m) ?ps" + unfolding knights_circuit_def using vs_c by auto + then show ?thesis using transpose_knights_circuit by auto +qed + +text \<open>For every \<open>n\<times>m\<close>-board with \<open>min n m \<ge> 5\<close> and odd \<open>n\<close> there exists a Knight's path that +starts in \<open>(n,1)\<close> (top-left) and ends in \<open>(n-1,m-1)\<close> (top-right).\<close> +text \<open>This lemma formalizes Lemma 4 from @{cite "cull_decurtins_1987"}. Formalizing the proof of +this lemma was quite challenging as a lot of details on how to exactly combine the boards are +left out in the original proof in @{cite "cull_decurtins_1987"}.\<close> +lemma knights_path_odd_n_exists: + assumes "odd n" "min n m \<ge> 5" + shows "\<exists>ps. knights_path (board n m) ps \<and> hd ps = (int n,1) \<and> last ps = (int n-1,int m-1)" + using assms +proof - + obtain x where "x = n + m" by auto + then show ?thesis + using assms + proof (induction x arbitrary: n m rule: less_induct) + case (less x) + then have "m = 5 \<or> m = 6 \<or> m = 7 \<or> m = 8 \<or> m = 9 \<or> m \<ge> 10" by auto + then show ?case + proof (elim disjE) + assume [simp]: "m = 5" + have "odd n" "n \<ge> 5" using less by auto + then have "n = 5 \<or> n = 7 \<or> n = 9 \<or> n-5 \<ge> 5" by presburger + then show ?thesis + proof (elim disjE) + assume [simp]: "n = 5" + let ?ps="mirror1 (transpose kp5x5ul)" + have kp: "knights_path (board n m) ?ps" + using kp_5x5_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 5\<close> \<open>n = 5\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 7" + let ?ps="mirror1 (transpose kp5x7ul)" + have kp: "knights_path (board n m) ?ps" + using kp_5x7_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 5\<close> \<open>n = 7\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 9" + let ?ps="mirror1 (transpose kp5x9ul)" + have kp: "knights_path (board n m) ?ps" + using kp_5x9_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 5\<close> \<open>n = 9\<close> | eval)+ + then show ?thesis using kp by auto + next + let ?b\<^sub>2="board m (n-5)" + assume "n-5 \<ge> 5" + then have "\<exists>ps. knights_circuit ?b\<^sub>2 ps" + proof - + have "n-5 = 6 \<or> n-5 = 8 \<or> n-5 \<ge> 10" + using \<open>n-5 \<ge> 5\<close> less by presburger + then show ?thesis + proof (elim disjE) + assume "n-5 = 6" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_6xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 = 8" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_8xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 \<ge> 10" + then show ?thesis + using less less.IH[of "n-10+m" "n-10" m] + knights_circuit_exists_even_n_gr10[of "n-5" m] by auto + qed + qed + then obtain ps\<^sub>2 where "knights_circuit ?b\<^sub>2 ps\<^sub>2" "hd ps\<^sub>2 = (1,1)" "last ps\<^sub>2 = (3,2)" + using \<open>n-5 \<ge> 5\<close> rotate_knights_circuit[of m "n-5"] by auto + then have rev_ps\<^sub>2_prems: "knights_path ?b\<^sub>2 (rev ps\<^sub>2)" "valid_step (last ps\<^sub>2) (hd ps\<^sub>2)" + "hd (rev ps\<^sub>2) = (3,2)" "last (rev ps\<^sub>2) = (1,1)" + unfolding knights_circuit_def using knights_path_rev by (auto simp: hd_rev last_rev) + + let ?ps\<^sub>1="kp5x5ul" + have ps\<^sub>1_prems: "knights_path (board 5 5) ?ps\<^sub>1" "hd ?ps\<^sub>1 = (1,1)" "last ?ps\<^sub>1 = (4,2)" + using kp_5x5_ul by simp eval+ + + have "16 < length ?ps\<^sub>1" "last (take 16 ?ps\<^sub>1) = (4,5)" "hd (drop 16 ?ps\<^sub>1) = (2,4)" by eval+ + then have si: "step_in ?ps\<^sub>1 (4,5) (2,4)" + unfolding step_in_def using zero_less_numeral by blast + + have vs: "valid_step (4,5) (3,int 5+2)" "valid_step (1,int 5+1) (2,4)" + unfolding valid_step_def by auto + + obtain ps where "knights_path (board m n) ps" "hd ps = (1,1)" "last ps = (4,2)" + using \<open>n-5 \<ge> 5\<close> ps\<^sub>1_prems rev_ps\<^sub>2_prems si vs + knights_path_split_concat[of 5 5 ?ps\<^sub>1 "n-5" "rev ps\<^sub>2" "(4,5)" "(2,4)"] by auto + then show ?thesis + using rot90_knights_path hd_rot90_knights_path last_rot90_knights_path by fastforce + qed + next + assume [simp]: "m = 6" + then obtain ps where + ps_prems: "knights_path (board m n) ps" "hd ps = (1,1)" "last ps = (int m-1,2)" + using less knights_path_6xm_exists[of n] by auto + let ?ps'="mirror1 (transpose ps)" + have "knights_path (board n m) ?ps'" "hd ?ps' = (int n,1)" "last ?ps' = (int n-1,int m-1)" + using ps_prems rot90_knights_path hd_rot90_knights_path last_rot90_knights_path by auto + then show ?thesis by auto + next + assume [simp]: "m = 7" + have "odd n" "n \<ge> 5" using less by auto + then have "n = 5 \<or> n = 7 \<or> n = 9 \<or> n-5 \<ge> 5" by presburger + then show ?thesis + proof (elim disjE) + assume [simp]: "n = 5" + let ?ps="mirror1 kp5x7lr" + have kp: "knights_path (board n m) ?ps" + using kp_5x7_lr mirror1_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 7\<close> \<open>n = 5\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 7" + let ?ps="mirror1 (transpose kp7x7ul)" + have kp: "knights_path (board n m) ?ps" + using kp_7x7_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 7\<close> \<open>n = 7\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 9" + let ?ps="mirror1 (transpose kp7x9ul)" + have kp: "knights_path (board n m) ?ps" + using kp_7x9_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 7\<close> \<open>n = 9\<close> | eval)+ + then show ?thesis using kp by auto + next + let ?b\<^sub>2="board m (n-5)" + let ?b\<^sub>2T="board (n-5) m" + assume "n-5 \<ge> 5" + then have "\<exists>ps. knights_circuit ?b\<^sub>2 ps" + proof - + have "n-5 = 6 \<or> n-5 = 8 \<or> n-5 \<ge> 10" + using \<open>n-5 \<ge> 5\<close> less by presburger + then show ?thesis + proof (elim disjE) + assume "n-5 = 6" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_6xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 = 8" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_8xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 \<ge> 10" + then show ?thesis + using less less.IH[of "n-10+m" "n-10" m] + knights_circuit_exists_even_n_gr10[of "n-5" m] by auto + qed + qed + then obtain ps\<^sub>2 where ps\<^sub>2_prems: "knights_circuit ?b\<^sub>2 ps\<^sub>2" "hd ps\<^sub>2 = (1,1)" + "last ps\<^sub>2 = (3,2)" + using \<open>n-5 \<ge> 5\<close> rotate_knights_circuit[of m "n-5"] by auto + let ?ps\<^sub>2T="transpose ps\<^sub>2" + have ps\<^sub>2T_prems: "knights_path ?b\<^sub>2T ?ps\<^sub>2T" "hd ?ps\<^sub>2T = (1,1)" "last ?ps\<^sub>2T = (2,3)" + using ps\<^sub>2_prems transpose_knights_path knights_path_non_nil hd_transpose last_transpose + unfolding knights_circuit_def transpose_square_def by auto + + let ?ps\<^sub>1="kp5x7lr" + have ps\<^sub>1_prems: "knights_path b5x7 ?ps\<^sub>1" "hd ?ps\<^sub>1 = (1,1)" "last ?ps\<^sub>1 = (2,6)" + using kp_5x7_lr by simp eval+ + + have "29 < length ?ps\<^sub>1" "last (take 29 ?ps\<^sub>1) = (4,2)" "hd (drop 29 ?ps\<^sub>1) = (5,4)" by eval+ + then have si: "step_in ?ps\<^sub>1 (4,2) (5,4)" + unfolding step_in_def using zero_less_numeral by blast + + have vs: "valid_step (4,2) (int 5+1,1)" "valid_step (int 5+2,3) (5,4)" + unfolding valid_step_def by auto + + obtain ps where "knights_path (board n m) ps" "hd ps = (1,1)" "last ps = (2,6)" + using \<open>n-5 \<ge> 5\<close> ps\<^sub>1_prems ps\<^sub>2T_prems si vs + knights_path_split_concatT[of 5 m ?ps\<^sub>1 "n-5" ?ps\<^sub>2T "(4,2)" "(5,4)"] by auto + then show ?thesis + using mirror1_knights_path hd_mirror1 last_mirror1 by fastforce + qed + next + assume [simp]: "m = 8" + then obtain ps where ps_prems: "knights_path (board m n) ps" "hd ps = (1,1)" + "last ps = (int m-1,2)" + using less knights_path_8xm_exists[of n] by auto + let ?ps'="mirror1 (transpose ps)" + have "knights_path (board n m) ?ps'" "hd ?ps' = (int n,1)" "last ?ps' = (int n-1,int m-1)" + using ps_prems rot90_knights_path hd_rot90_knights_path last_rot90_knights_path by auto + then show ?thesis by auto + next + assume [simp]: "m = 9" + have "odd n" "n \<ge> 5" using less by auto + then have "n = 5 \<or> n = 7 \<or> n = 9 \<or> n-5 \<ge> 5" by presburger + then show ?thesis + proof (elim disjE) + assume [simp]: "n = 5" + let ?ps="mirror1 kp5x9lr" + have kp: "knights_path (board n m) ?ps" + using kp_5x9_lr mirror1_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 9\<close> \<open>n = 5\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 7" + let ?ps="mirror1 (transpose kp9x7ul)" + have kp: "knights_path (board n m) ?ps" + using kp_9x7_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 9\<close> \<open>n = 7\<close> | eval)+ + then show ?thesis using kp by auto + next + assume [simp]: "n = 9" + let ?ps="mirror1 (transpose kp9x9ul)" + have kp: "knights_path (board n m) ?ps" + using kp_9x9_ul rot90_knights_path by auto + have "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + by (simp only: \<open>m = 9\<close> \<open>n = 9\<close> | eval)+ + then show ?thesis using kp by auto + next + let ?b\<^sub>2="board m (n-5)" + let ?b\<^sub>2T="board (n-5) m" + assume "n-5 \<ge> 5" + then have "\<exists>ps. knights_circuit ?b\<^sub>2 ps" + proof - + have "n-5 = 6 \<or> n-5 = 8 \<or> n-5 \<ge> 10" + using \<open>n-5 \<ge> 5\<close> less by presburger + then show ?thesis + proof (elim disjE) + assume "n-5 = 6" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_6xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 = 8" + then obtain ps where "knights_circuit (board (n-5) m) ps" + using knights_path_8xm_exists[of m] by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n-5 \<ge> 10" + then show ?thesis + using less less.IH[of "n-10+m" "n-10" m] + knights_circuit_exists_even_n_gr10[of "n-5" m] by auto + qed + qed + then obtain ps\<^sub>2 where ps\<^sub>2_prems: "knights_circuit ?b\<^sub>2 ps\<^sub>2" "hd ps\<^sub>2 = (1,1)" + "last ps\<^sub>2 = (3,2)" + using \<open>n-5 \<ge> 5\<close> rotate_knights_circuit[of m "n-5"] by auto + let ?ps\<^sub>2T="transpose (rev ps\<^sub>2)" + have ps\<^sub>2T_prems: "knights_path ?b\<^sub>2T ?ps\<^sub>2T" "hd ?ps\<^sub>2T = (2,3)" "last ?ps\<^sub>2T = (1,1)" + using ps\<^sub>2_prems knights_path_rev transpose_knights_path knights_path_non_nil + hd_transpose last_transpose + unfolding knights_circuit_def transpose_square_def by (auto simp: hd_rev last_rev) + + let ?ps\<^sub>1="kp5x9lr" + have ps\<^sub>1_prems: "knights_path b5x9 ?ps\<^sub>1" "hd ?ps\<^sub>1 = (1,1)" "last ?ps\<^sub>1 = (2,8)" + using kp_5x9_lr by simp eval+ + + have "16 < length ?ps\<^sub>1" "last (take 16 ?ps\<^sub>1) = (5,4)" "hd (drop 16 ?ps\<^sub>1) = (4,2)" by eval+ + then have si: "step_in ?ps\<^sub>1 (5,4) (4,2)" + unfolding step_in_def using zero_less_numeral by blast + + have vs: "valid_step (5,4) (int 5+2,3)" "valid_step (int 5+1,1) (4,2)" + unfolding valid_step_def by auto + + obtain ps where "knights_path (board n m) ps" "hd ps = (1,1)" "last ps = (2,8)" + using \<open>n-5 \<ge> 5\<close> ps\<^sub>1_prems ps\<^sub>2T_prems si vs + knights_path_split_concatT[of 5 m ?ps\<^sub>1 "n-5" ?ps\<^sub>2T "(5,4)" "(4,2)"] by auto + then show ?thesis + using mirror1_knights_path hd_mirror1 last_mirror1 by fastforce + qed + next + let ?b\<^sub>1="board n 5" + let ?b\<^sub>2="board n (m-5)" + assume "m \<ge> 10" + then have "n+5 < x" "5 \<le> min n 5" "n+(m-5) < x" "5 \<le> min n (m-5)" + using less by auto + then obtain ps\<^sub>1 ps\<^sub>2 where kp_prems: + "knights_path ?b\<^sub>1 ps\<^sub>1" "hd ps\<^sub>1 = (int n,1)" "last ps\<^sub>1 = (int n-1,4)" + "knights_path (board n (m-5)) ps\<^sub>2" "hd ps\<^sub>2 = (int n,1)" "last ps\<^sub>2 = (int n-1,int (m-5)-1)" + using less.prems less.IH[of "n+5" n "5"] less.IH[of "n+(m-5)" n "m-5"] by auto + let ?ps="ps\<^sub>1@trans_path (0,int 5) ps\<^sub>2" + have "valid_step (last ps\<^sub>1) (int n,int 5+1)" + unfolding valid_step_def using kp_prems by auto + then have "knights_path (board n m) ?ps" "hd ?ps = (int n,1)" "last ?ps = (int n-1,int m-1)" + using \<open>m \<ge> 10\<close> kp_prems knights_path_concat[of n 5 ps\<^sub>1 "m-5" ps\<^sub>2] + knights_path_non_nil trans_path_non_nil last_trans_path by auto + then show ?thesis by auto + qed + qed +qed + +text \<open>Auxiliary lemma that constructs a Knight's circuit if \<open>m \<ge> 5\<close> and \<open>n \<ge> 10 \<and> even n\<close>.\<close> +lemma knights_circuit_exists_n_even_gr_10: + assumes "n \<ge> 10 \<and> even n" "m \<ge> 5" + shows "\<exists>ps. knights_circuit (board n m) ps" + using assms +proof - + obtain ps\<^sub>1 where ps\<^sub>1_prems: "knights_path (board 5 m) ps\<^sub>1" "hd ps\<^sub>1 = (1,1)" + "last ps\<^sub>1 = (2,int m-1)" + using assms knights_path_5xm_exists by auto + let ?ps\<^sub>1'="trans_path (int (n-5),0) ps\<^sub>1" + let ?b5xm'="trans_board (int (n-5),0) (board 5 m)" + have ps\<^sub>1'_prems: "knights_path ?b5xm' ?ps\<^sub>1'" "hd ?ps\<^sub>1' = (int (n-5)+1,1)" + "last ?ps\<^sub>1' = (int (n-5)+2,int m-1)" + using ps\<^sub>1_prems trans_knights_path knights_path_non_nil hd_trans_path last_trans_path by auto + + assume "n \<ge> 10 \<and> even n" + then have "odd (n-5)" "min (n-5) m \<ge> 5" using assms by auto + then obtain ps\<^sub>2 where ps\<^sub>2_prems: "knights_path (board (n-5) m) ps\<^sub>2" "hd ps\<^sub>2 = (int (n-5),1)" + "last ps\<^sub>2 = (int (n-5)-1,int m-1)" + using knights_path_odd_n_exists[of "n-5" m] by auto + let ?ps\<^sub>2'="mirror2 ps\<^sub>2" + have ps\<^sub>2'_prems: "knights_path (board (n-5) m) ?ps\<^sub>2'" "hd ?ps\<^sub>2' = (int (n-5),int m)" + "last ?ps\<^sub>2' = (int (n-5)-1,2)" + using ps\<^sub>2_prems mirror2_knights_path hd_mirror2 last_mirror2 by auto + + have inter: "?b5xm' \<inter> board (n-5) m = {}" + unfolding trans_board_def board_def by auto + + have union: "board n m = ?b5xm' \<union> board (n-5) m" + using \<open>n \<ge> 10 \<and> even n\<close> board_concatT[of "n-5" m 5] by auto + + have vs: "valid_step (last ?ps\<^sub>1') (hd ?ps\<^sub>2')" "valid_step (last ?ps\<^sub>2') (hd ?ps\<^sub>1')" + using ps\<^sub>1'_prems ps\<^sub>2'_prems unfolding valid_step_def by auto + + let ?ps="?ps\<^sub>1' @ ?ps\<^sub>2'" + have "last ?ps = last ?ps\<^sub>2'" "hd ?ps = hd ?ps\<^sub>1'" + using ps\<^sub>1'_prems ps\<^sub>2'_prems knights_path_non_nil by auto + then have vs_c: "valid_step (last ?ps) (hd ?ps)" + using vs by auto + + have "knights_path (board n m) ?ps" + using ps\<^sub>1'_prems ps\<^sub>2'_prems inter union vs knights_path_append by auto + then show ?thesis + using vs_c unfolding knights_circuit_def by blast +qed + +text \<open>Final Theorem 1: For every \<open>n\<times>m\<close>-board with \<open>min n m \<ge> 5\<close> and \<open>n*m\<close> even there exists a +Knight's circuit.\<close> +theorem knights_circuit_exists: + assumes "min n m \<ge> 5" "even (n*m)" + shows "\<exists>ps. knights_circuit (board n m) ps" + using assms +proof - + have "n = 6 \<or> m = 6 \<or> n = 8 \<or> m = 8 \<or> (n \<ge> 10 \<and> even n) \<or> (m \<ge> 10 \<and> even m)" + using assms by auto + then show ?thesis + proof (elim disjE) + assume "n = 6" + then show ?thesis + using assms knights_path_6xm_exists by auto + next + assume "m = 6" + then obtain ps where "knights_circuit (board m n) ps" + using assms knights_path_6xm_exists by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n = 8" + then show ?thesis + using assms knights_path_8xm_exists by auto + next + assume "m = 8" + then obtain ps where "knights_circuit (board m n) ps" + using assms knights_path_8xm_exists by auto + then show ?thesis + using transpose_knights_circuit by auto + next + assume "n \<ge> 10 \<and> even n" + then show ?thesis + using assms knights_circuit_exists_n_even_gr_10 by auto + next + assume "m \<ge> 10 \<and> even m" + then obtain ps where "knights_circuit (board m n) ps" + using assms knights_circuit_exists_n_even_gr_10 by auto + then show ?thesis + using transpose_knights_circuit by auto + qed +qed + +text \<open>Final Theorem 2: for every \<open>n\<times>m\<close>-board with \<open>min n m \<ge> 5\<close> there exists a Knight's path.\<close> +theorem knights_path_exists: + assumes "min n m \<ge> 5" + shows "\<exists>ps. knights_path (board n m) ps" + using assms +proof - + have "odd n \<or> odd m \<or> even (n*m)" by simp + then show ?thesis + proof (elim disjE) + assume "odd n" + then show ?thesis + using assms knights_path_odd_n_exists by auto + next + assume "odd m" + then obtain ps where "knights_path (board m n) ps" + using assms knights_path_odd_n_exists by auto + then show ?thesis + using transpose_knights_path by auto + next + assume "even (n*m)" + then show ?thesis + using assms knights_circuit_exists by (auto simp: knights_circuit_def) + qed +qed + +text \<open>THE END\<close> + +end \ No newline at end of file diff --git a/thys/Knights_Tour/ROOT b/thys/Knights_Tour/ROOT new file mode 100755 --- /dev/null +++ b/thys/Knights_Tour/ROOT @@ -0,0 +1,9 @@ +chapter AFP + +session Knights_Tour (AFP) = HOL + + options [timeout=300] + theories + KnightsTour + document_files + "root.bib" + "root.tex" diff --git a/thys/Knights_Tour/document/root.bib b/thys/Knights_Tour/document/root.bib new file mode 100755 --- /dev/null +++ b/thys/Knights_Tour/document/root.bib @@ -0,0 +1,9 @@ +@article{cull_decurtins_1987, + author = {Cull, Paul and De Curtins, Jeffey}, + title = {Knight's Tour Revisited}, + journal = {Fibonacci Quarterly}, + volume = {16}, + year = {1978}, + pages = {276--285}, + publisher = {Fibonacci Association} +} \ No newline at end of file diff --git a/thys/Knights_Tour/document/root.tex b/thys/Knights_Tour/document/root.tex new file mode 100755 --- /dev/null +++ b/thys/Knights_Tour/document/root.tex @@ -0,0 +1,74 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[T1]{fontenc} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +%\usepackage{amssymb} + %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>, + %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>, + %\<triangleq>, \<yen>, \<lozenge> + +%\usepackage{eurosym} + %for \<euro> + +%\usepackage[only,bigsqcap,bigparallel,fatsemi,interleave,sslash]{stmaryrd} + %for \<Sqinter>, \<Parallel>, \<Zsemi>, \<Parallel>, \<sslash> + +%\usepackage{eufrak} + %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb) + +%\usepackage{textcomp} + %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>, + %\<currency> + +\usepackage{amsmath} +\usepackage{float} + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + +\begin{document} + +\title{Knight's Tour Revisited Revisited} +\author{Lukas Koller\\Department of Informatics\\Technical University of Munich} +\maketitle + +\begin{abstract} +This is a formalization of the article ``Knight's Tour Revisited'' by +Cull and De Curtins where they prove the existence of a Knight's path for arbitrary $n\times m$-boards with +$\operatorname{min}(n,m) \geq 5$. If $n\cdot m$ is even, then there exists a Knight's circuit. + +A Knight's Path is a sequence of moves of a Knight on a chessboard s.t. the Knight visits every square of a chessboard exactly once. +Finding a Knight's path is a an instance of the Hamiltonian path problem. + +During the formalization two mistakes in the original proof were discovered. +These mistakes are corrected in this formalization. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/MDP-Algorithms/Algorithms.thy b/thys/MDP-Algorithms/Algorithms.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Algorithms.thy @@ -0,0 +1,10 @@ +(* Author: Maximilian Schäffeler *) + +theory Algorithms + imports + Value_Iteration + Policy_Iteration + Modified_Policy_Iteration + Splitting_Methods +begin +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/Blinfun_Matrix.thy b/thys/MDP-Algorithms/Blinfun_Matrix.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Blinfun_Matrix.thy @@ -0,0 +1,239 @@ +theory Blinfun_Matrix + imports + "MDP-Rewards.Blinfun_Util" + Matrix_Util +begin + +section \<open>Bounded Linear Functions and Matrices\<close> + +definition "blinfun_to_matrix (f :: ('b::finite \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('c::finite \<Rightarrow>\<^sub>b _)) = + matrix (\<lambda>v. (\<chi> j. f (Bfun (($) v)) j))" + +definition "matrix_to_blinfun X = Blinfun (\<lambda>v. Bfun (\<lambda>i. (X *v (\<chi> i. (apply_bfun v i))) $ i))" + +lemma plus_vec_eq: "(\<chi> i. f i + g i) = (\<chi> i. f i) + (\<chi> i. g i)" + by (simp add: Finite_Cartesian_Product.plus_vec_def) + +lemma matrix_to_blinfun_mult: "matrix_to_blinfun m (v :: 'c::finite \<Rightarrow>\<^sub>b real) i = (m *v (\<chi> i. v i)) $ i" +proof - + have [simp]: "(\<chi> i. c * x i) = c *\<^sub>R (\<chi> i. x i)" for c x + by (simp add: vector_scalar_mult_def scalar_mult_eq_scaleR[symmetric]) + + have "bounded_linear (\<lambda>v. bfun.Bfun (($) (m *v vec_lambda (apply_bfun v))))" + proof (rule bounded_linear_compose[of "\<lambda>x. bfun.Bfun (\<lambda>y. x $ y)"], goal_cases) + case 1 + then show ?case + using bounded_linear_bfun_nth[of id, simplified] bounded_linear_ident eq_id_iff + by metis + next + case 2 + then show ?case + using norm_vec_le_norm_bfun + by (auto simp: matrix_vector_right_distrib plus_vec_eq + intro!: bounded_linear_intro bounded_linear_compose[OF matrix_vector_mul_bounded_linear]) + qed + thus ?thesis + by (auto simp: Blinfun_inverse matrix_to_blinfun_def Bfun_inverse) +qed + +lemma blinfun_to_matrix_mult: "(blinfun_to_matrix f *v (\<chi> i. apply_bfun v i)) $ i = f v i" +proof - + have "(blinfun_to_matrix f *v (\<chi> i. v i)) $ i = (\<Sum>j\<in>UNIV. (f ((v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0)))) i)" + unfolding blinfun_to_matrix_def matrix_def + by (auto simp: matrix_vector_mult_def mult.commute axis_def blinfun.scaleR_right vec_lambda_inverse) + also have "\<dots> = (\<Sum>j\<in>UNIV. (f ((v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0))))) i" + by (auto intro: finite_induct) + also have "\<dots> = f (\<Sum>j\<in>UNIV. (v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0))) i" + by (auto simp: blinfun.sum_right) + also have "\<dots> = f v i" + proof - + have "(\<Sum>j\<in>UNIV. (v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0))) x = v x" for x + proof - + have "(\<Sum>j\<in>UNIV. (v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0))) x = + (\<Sum>j\<in>UNIV. (v j *\<^sub>R bfun.Bfun (\<lambda>i. if i = j then 1 else 0) x))" + by (auto intro: finite_induct) + also have "\<dots> = (\<Sum>j\<in>UNIV. (v j *\<^sub>R (\<lambda>i. if i = j then 1 else 0) x))" + by (subst Bfun_inverse) (metis vec_bfun vec_lambda_inverse[OF UNIV_I, symmetric])+ + also have "\<dots> = (\<Sum>j\<in>UNIV. ((if x = j then v j * 1 else v j * 0)))" + by (auto simp: if_distrib intro!: sum.cong) + also have "\<dots> = (\<Sum>j\<in>UNIV. ((if x = j then v j else 0)))" + by (meson more_arith_simps(6) mult_zero_right) + also have "\<dots> = v x" + by auto + finally show ?thesis. + qed + thus ?thesis + using bfun_eqI + by fastforce + qed + finally show ?thesis. +qed + +lemma blinfun_to_matrix_mult': "(blinfun_to_matrix f *v v) $ i = f (Bfun (\<lambda>i. v $ i)) i" + by (metis bfun.Bfun_inverse blinfun_to_matrix_mult vec_bfun vec_nth_inverse) + +lemma blinfun_to_matrix_mult'': "(blinfun_to_matrix f *v v) = (\<chi> i. f (Bfun (\<lambda>i. v $ i)) i)" + by (metis blinfun_to_matrix_mult' vec_lambda_unique) + +lemma matrix_to_blinfun_inv: "matrix_to_blinfun (blinfun_to_matrix f) = f" + by (auto simp: matrix_to_blinfun_mult blinfun_to_matrix_mult intro!: blinfun_eqI) + +lemma blinfun_to_matrix_add: "blinfun_to_matrix (f + g) = blinfun_to_matrix f + blinfun_to_matrix g" + by (simp add: matrix_eq blinfun_to_matrix_mult'' matrix_vector_mult_add_rdistrib blinfun.add_left plus_vec_eq) + +lemma blinfun_to_matrix_diff: "blinfun_to_matrix (f - g) = blinfun_to_matrix f - blinfun_to_matrix g" + using blinfun_to_matrix_add + by (metis add_right_imp_eq diff_add_cancel) + +lemma blinfun_to_matrix_scaleR: "blinfun_to_matrix (c *\<^sub>R f) = c *\<^sub>R blinfun_to_matrix f" + by (auto simp: matrix_eq blinfun_to_matrix_mult'' scaleR_matrix_vector_assoc[symmetric] + blinfun.scaleR_left vector_scalar_mult_def[of c, unfolded scalar_mult_eq_scaleR]) + +lemma matrix_to_blinfun_add: + "matrix_to_blinfun ((f :: real^_^_) + g) = matrix_to_blinfun f + matrix_to_blinfun g" + by (auto intro!: blinfun_eqI simp: matrix_to_blinfun_mult blinfun.add_left matrix_vector_mult_add_rdistrib) + +lemma matrix_to_blinfun_diff: + "matrix_to_blinfun ((f :: real^_^_) - g) = matrix_to_blinfun f - matrix_to_blinfun g" + using matrix_to_blinfun_add diff_eq_eq + by metis + +lemma matrix_to_blinfun_scaleR: + "matrix_to_blinfun (c *\<^sub>R (f :: real^_^_)) = c *\<^sub>R matrix_to_blinfun f" + by (auto intro!: blinfun_eqI simp: matrix_to_blinfun_mult blinfun.scaleR_left + matrix_vector_mult_add_rdistrib scaleR_matrix_vector_assoc[symmetric]) + +lemma matrix_to_blinfun_comp: "matrix_to_blinfun ((m:: real^_^_) ** n) = (matrix_to_blinfun m) o\<^sub>L (matrix_to_blinfun n)" + by (auto intro!: blinfun_eqI simp: matrix_vector_mul_assoc[symmetric] matrix_to_blinfun_mult) + +lemma blinfun_to_matrix_comp: "blinfun_to_matrix (f o\<^sub>L g) = (blinfun_to_matrix f) ** (blinfun_to_matrix g)" + by (simp add: matrix_eq apply_bfun_inverse blinfun_to_matrix_mult'' matrix_vector_mul_assoc[symmetric]) + +lemma blinfun_to_matrix_id: "blinfun_to_matrix id_blinfun = mat 1" + by (simp add: Bfun_inverse blinfun_to_matrix_mult'' matrix_eq) + +lemma matrix_to_blinfun_id: "matrix_to_blinfun (mat 1 :: (real ^_^_)) = id_blinfun" + by (auto intro!: blinfun_eqI simp: matrix_to_blinfun_mult) + +lemma matrix_to_blinfun_inv\<^sub>L: + assumes "invertible m" + shows "matrix_to_blinfun (matrix_inv (m :: real^_^_)) = inv\<^sub>L (matrix_to_blinfun m)" + "invertible\<^sub>L (matrix_to_blinfun m)" +proof - + have "m ** matrix_inv m = mat 1" "matrix_inv m ** m = mat 1" + using assms + by (auto simp: matrix_inv_right matrix_inv_left) + hence "matrix_to_blinfun (matrix_inv m) o\<^sub>L matrix_to_blinfun m = id_blinfun" + "matrix_to_blinfun m o\<^sub>L matrix_to_blinfun (matrix_inv m) = id_blinfun" + by (auto simp: matrix_to_blinfun_id matrix_to_blinfun_comp[symmetric]) + thus "matrix_to_blinfun (matrix_inv m) = inv\<^sub>L (matrix_to_blinfun m)" "invertible\<^sub>L (matrix_to_blinfun m)" + by (auto intro: inv\<^sub>L_I) +qed + + +lemma blinfun_to_matrix_inverse: + assumes "invertible\<^sub>L X" + shows "invertible (blinfun_to_matrix (X :: ('b::finite \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L 'c::finite \<Rightarrow>\<^sub>b real))" + "blinfun_to_matrix (inv\<^sub>L X) = matrix_inv (blinfun_to_matrix X)" +proof - + have "X o\<^sub>L inv\<^sub>L X = id_blinfun" + by (simp add: assms) + hence 1: "blinfun_to_matrix X ** blinfun_to_matrix (inv\<^sub>L X) = mat 1" + by (metis blinfun_to_matrix_comp blinfun_to_matrix_id) + have "inv\<^sub>L X o\<^sub>L X = id_blinfun" + by (simp add: assms) + hence 2: "blinfun_to_matrix (inv\<^sub>L X) ** blinfun_to_matrix (X) = mat 1" + by (metis blinfun_to_matrix_comp blinfun_to_matrix_id) + thus "invertible (blinfun_to_matrix X)" + using "1" invertible_def by blast + thus "blinfun_to_matrix (inv\<^sub>L X) = matrix_inv (blinfun_to_matrix X)" + using 1 2 matrix_inv_right matrix_mul_assoc matrix_mul_lid + by metis +qed + +lemma blinfun_to_matrix_inv[simp]: "blinfun_to_matrix (matrix_to_blinfun f) = f" + by (auto simp: matrix_eq blinfun_to_matrix_mult'' matrix_to_blinfun_mult bfun.Bfun_inverse) + +lemma invertible_invertible\<^sub>L_I: "invertible (blinfun_to_matrix f) \<Longrightarrow> invertible\<^sub>L f" + "invertible\<^sub>L (matrix_to_blinfun X) \<Longrightarrow> invertible (X :: real^_^_)" + using matrix_to_blinfun_inv\<^sub>L(2) blinfun_to_matrix_inverse(1) matrix_to_blinfun_inv blinfun_to_matrix_inv + by metis+ + +lemma bounded_linear_blinfun_to_matrix: "bounded_linear (blinfun_to_matrix :: ('a \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('b \<Rightarrow>\<^sub>b real) \<Rightarrow> real^'a^'b)" +proof (intro bounded_linear_intro[of _ "real CARD('a::finite) * real CARD('b::finite)"]) + show "\<And>x y. blinfun_to_matrix (x + y) = blinfun_to_matrix x + blinfun_to_matrix y" + by (auto simp: blinfun_to_matrix_add blinfun_to_matrix_scaleR) +next + show "\<And>r x. blinfun_to_matrix (r *\<^sub>R x) = r *\<^sub>R blinfun_to_matrix x" + by (auto simp: blinfun_to_matrix_def matrix_def blinfun.scaleR_left vec_eq_iff) +next + have *: "\<And>j. (\<lambda>i. if i = j then 1::real else 0) \<in> bfun" + by auto + hence **: "\<And>j. norm (Bfun (\<lambda>i. if i = j then 1::real else 0)) = 1" + by (auto simp: Bfun_inverse[OF *] norm_bfun_def' intro!: cSup_eq_maximum ) + show "norm (blinfun_to_matrix x) \<le> norm x * (real CARD('a) * real CARD('b))" for x :: "('a \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L 'b \<Rightarrow>\<^sub>b real" + proof - + have "norm (blinfun_to_matrix x) \<le> (\<Sum>i\<in>UNIV. \<Sum>ia\<in>UNIV. \<bar>(x (bfun.Bfun (\<lambda>i. if i = ia then 1 else 0))) i\<bar>)" + unfolding norm_vec_def blinfun_to_matrix_def matrix_def axis_def + by(auto simp: vec_lambda_inverse intro!: order.trans[OF L2_set_le_sum_abs] order.trans[OF sum_mono[OF L2_set_le_sum_abs]]) + also have "\<dots> \<le> (\<Sum>i\<in>(UNIV::'b set). \<Sum>ia\<in>(UNIV :: 'a set). norm x)" + using norm_blinfun abs_le_norm_bfun + by (fastforce simp: ** intro!: sum_mono intro: order.trans) + also have "\<dots> = norm x * (real CARD('a) * real CARD('b))" + by auto + finally show ?thesis. + qed +qed + +lemma summable_blinfun_to_matrix: + assumes "summable (f :: nat \<Rightarrow> ('c::finite \<Rightarrow>\<^sub>b _) \<Rightarrow>\<^sub>L ('c \<Rightarrow>\<^sub>b _))" + shows "summable (\<lambda>i. blinfun_to_matrix (f i))" + by (simp add: assms bounded_linear.summable bounded_linear_blinfun_to_matrix) + +abbreviation "nonneg_blinfun Q \<equiv> 0 \<le> (blinfun_to_matrix Q)" + +lemma nonneg_blinfun_mono: "nonneg_blinfun Q \<Longrightarrow> u \<le> v \<Longrightarrow> Q u \<le> Q v" + using nonneg_mat_mono[of "blinfun_to_matrix Q" "vec_lambda u" "vec_lambda v"] + by (fastforce simp: blinfun_to_matrix_mult'' apply_bfun_inverse Finite_Cartesian_Product.less_eq_vec_def) + +lemma nonneg_blinfun_nonneg: "nonneg_blinfun Q \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> Q v" + using nonneg_blinfun_mono blinfun.zero_right + by metis + +lemma nonneg_id_blinfun: "nonneg_blinfun id_blinfun" + by (auto simp: blinfun_to_matrix_id) + +lemma norm_nonneg_blinfun_one: + assumes "0 \<le> blinfun_to_matrix X" + shows "norm X = norm (blinfun_apply X 1)" + by (simp add: norm_blinfun_mono_eq_one assms nonneg_blinfun_nonneg) + +lemma matrix_le_norm_mono: + assumes "0 \<le> (blinfun_to_matrix C)" + and "(blinfun_to_matrix C) \<le> (blinfun_to_matrix D)" + shows "norm C \<le> norm D" +proof - + have "0 \<le> C 1" "0 \<le> D 1" + using assms zero_le_one + by (fastforce intro!: nonneg_blinfun_nonneg)+ + have "\<And>v. v \<ge> 0 \<Longrightarrow> blinfun_to_matrix C *v v \<le> blinfun_to_matrix D *v v" + using assms nonneg_mat_mono[of "blinfun_to_matrix D - blinfun_to_matrix C"] + by (fastforce simp: matrix_vector_mult_diff_rdistrib) + hence *: "\<And>v. v \<ge> 0 \<Longrightarrow> C v \<le> D v" + by (auto simp: less_eq_vec_def less_eq_bfun_def blinfun_to_matrix_mult[symmetric]) + show ?thesis + using assms(1) assms(2) \<open>0 \<le> C 1\<close> \<open>0 \<le> D 1\<close> less_eq_bfunD[OF *, of 1] + by (fastforce intro!: cSUP_mono simp: norm_nonneg_blinfun_one norm_bfun_def' less_eq_bfun_def) +qed + +lemma blinfun_to_matrix_matpow: "blinfun_to_matrix (X ^^ i) = matpow (blinfun_to_matrix X) i" + by (induction i) (auto simp: blinfun_to_matrix_id blinfun_to_matrix_comp blinfunpow_assoc simp del: blinfunpow.simps(2)) + +lemma nonneg_blinfun_iff: "nonneg_blinfun X \<longleftrightarrow> (\<forall>v\<ge>0. X v \<ge> 0)" + using nonneg_mat_iff[of "blinfun_to_matrix X"] nonneg_blinfun_nonneg + by (auto simp: blinfun_to_matrix_mult'' bfun.Bfun_inverse less_eq_vec_def less_eq_bfun_def) + +lemma blinfun_apply_mono: "(0::real^_^_) \<le> blinfun_to_matrix X \<Longrightarrow> 0 \<le> v \<Longrightarrow> blinfun_to_matrix X \<le> blinfun_to_matrix Y \<Longrightarrow> X v \<le> Y v" + by (metis blinfun.diff_left blinfun_to_matrix_diff diff_ge_0_iff_ge nonneg_blinfun_nonneg) + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/Matrix_Util.thy b/thys/MDP-Algorithms/Matrix_Util.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Matrix_Util.thy @@ -0,0 +1,194 @@ +theory Matrix_Util + imports "HOL-Analysis.Analysis" +begin + +section \<open>Matrices\<close> + +proposition scalar_matrix_assoc': + fixes C :: "('b::real_algebra_1)^'m^'n" + shows "k *\<^sub>R (C ** D) = C ** (k *\<^sub>R D)" + by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff scaleR_sum_right) + +subsection \<open>Nonnegative Matrices\<close> + +lemma nonneg_matrix_nonneg [dest]: "0 \<le> m \<Longrightarrow> 0 \<le> m $ i $ j" + by (simp add: Finite_Cartesian_Product.less_eq_vec_def) + +lemma matrix_mult_mono: + assumes "0 \<le> E" "0 \<le> C" "(E :: real^'c^'c) \<le> B" "C \<le> D" + shows "E ** C \<le> B ** D" + using order.trans[OF assms(1) assms(3)] assms + unfolding Finite_Cartesian_Product.less_eq_vec_def + by (auto intro!: sum_mono mult_mono simp: matrix_matrix_mult_def) + +lemma nonneg_matrix_mult: "0 \<le> (C :: ('b::{field, ordered_ring})^_^_) \<Longrightarrow> 0 \<le> D \<Longrightarrow> 0 \<le> C ** D" + unfolding Finite_Cartesian_Product.less_eq_vec_def + by (auto simp: matrix_matrix_mult_def intro!: sum_nonneg) + +lemma zero_le_mat_iff [simp]: "0 \<le> mat (x :: 'c :: {zero, order}) \<longleftrightarrow> 0 \<le> x" + by (auto simp: Finite_Cartesian_Product.less_eq_vec_def mat_def) + +lemma nonneg_mat_ge_zero: "0 \<le> Q \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> Q *v (v :: real^'c)" + unfolding Finite_Cartesian_Product.less_eq_vec_def + by (auto intro!: sum_nonneg simp: matrix_vector_mult_def) + +lemma nonneg_mat_mono: "0 \<le> Q \<Longrightarrow> u \<le> v \<Longrightarrow> Q *v u \<le> Q *v (v :: real^'c)" + using nonneg_mat_ge_zero[of Q "v - u"] + by (simp add: vec.diff) + +lemma nonneg_mult_imp_nonneg_mat: + assumes "\<And>v. v \<ge> 0 \<Longrightarrow> X *v v \<ge> 0" + shows "X \<ge> (0 :: real ^ _ ^_)" +proof - + { assume "\<not> (0 \<le> X)" + then obtain i j where neg: "X $ i $ j < 0" + by (metis less_eq_vec_def not_le zero_index) + let ?v = "\<chi> k. if j = k then 1::real else 0" + have "(X *v ?v) $ i < 0" + using neg + by (auto simp: matrix_vector_mult_def if_distrib cong: if_cong) + hence "?v \<ge> 0 \<and> \<not> ((X *v ?v) \<ge> 0)" + by (auto simp: less_eq_vec_def not_le) + hence "\<exists>v. v \<ge> 0 \<and> \<not> X *v v \<ge> 0" + by blast + } + thus ?thesis + using assms by auto +qed + +lemma nonneg_mat_iff: + "(X \<ge> (0 :: real ^ _ ^_)) \<longleftrightarrow> (\<forall>v. v \<ge> 0 \<longrightarrow> X *v v \<ge> 0)" + using nonneg_mat_ge_zero nonneg_mult_imp_nonneg_mat by auto + +lemma mat_le_iff: "(X \<le> Y) \<longleftrightarrow> (\<forall>x\<ge>0. (X::real^_^_) *v x \<le> Y *v x)" + by (metis diff_ge_0_iff_ge matrix_vector_mult_diff_rdistrib nonneg_mat_iff) + +subsection \<open>Matrix Powers\<close> + +(* copied from Perron-Frobenius *) +primrec matpow :: "'a::semiring_1^'n^'n \<Rightarrow> nat \<Rightarrow> 'a^'n^'n" where + matpow_0: "matpow A 0 = mat 1" | + matpow_Suc: "matpow A (Suc n) = (matpow A n) ** A" + +lemma nonneg_matpow: "0 \<le> X \<Longrightarrow> 0 \<le> matpow (X :: real ^ _ ^ _) i" + by (induction i) (auto simp: nonneg_matrix_mult) + +lemma matpow_mono: "0 \<le> C \<Longrightarrow> C \<le> D \<Longrightarrow> matpow (C :: real^_^_) n \<le> matpow D n" + by (induction n) (auto intro!: matrix_mult_mono nonneg_matpow) + +lemma matpow_scaleR: "matpow (c *\<^sub>R (X :: 'b :: real_algebra_1^_^_)) n = (c^n) *\<^sub>R (matpow X) n" +proof (induction n arbitrary: X c) + case (Suc n) + have "matpow (c *\<^sub>R X) (Suc n) = (c^n)*\<^sub>R (matpow X) n ** c *\<^sub>R X" + using Suc by auto + also have "\<dots> = c *\<^sub>R ((c^n) *\<^sub>R (matpow X) n ** X)" + using scalar_matrix_assoc' + by (auto simp: scalar_matrix_assoc') + finally show ?case + by (simp add: scalar_matrix_assoc) +qed auto + +lemma matrix_vector_mult_code': "(X *v x) $ i = (\<Sum>j\<in>UNIV. X $ i $ j * x $ j)" + by (simp add: matrix_vector_mult_def) + +lemma matrix_vector_mult_mono: "(0::real^_^_) \<le> X \<Longrightarrow> 0 \<le> v \<Longrightarrow> X \<le> Y \<Longrightarrow> X *v v \<le> Y *v v" + by (metis diff_ge_0_iff_ge matrix_vector_mult_diff_rdistrib nonneg_mat_iff) + +subsection \<open>Triangular Matrices\<close> + +definition "lower_triangular_mat X \<longleftrightarrow> (\<forall>i j. (i :: 'b::{finite, linorder}) < j \<longrightarrow> X $ i $ j = 0)" + +definition "strict_lower_triangular_mat X \<longleftrightarrow> (\<forall>i j. (i :: 'b::{finite, linorder}) \<le> j \<longrightarrow> X $ i $ j = 0)" + +definition "upper_triangular_mat X \<longleftrightarrow> (\<forall>i j. j X $ i $ j = 0)" + +lemma stlI: "strict_lower_triangular_mat X \<Longrightarrow> lower_triangular_mat X" + unfolding strict_lower_triangular_mat_def lower_triangular_mat_def + by auto + +lemma lower_triangular_mat_mat: "lower_triangular_mat (mat x)" + unfolding lower_triangular_mat_def mat_def + by auto + +lemma lower_triangular_mult: + assumes "lower_triangular_mat X" "lower_triangular_mat Y" + shows "lower_triangular_mat (X ** Y)" + using assms + unfolding matrix_matrix_mult_def lower_triangular_mat_def + by (auto intro!: sum.neutral) (metis mult_not_zero neqE less_trans) + +lemma lower_triangular_pow: + assumes "lower_triangular_mat X" + shows "lower_triangular_mat (matpow X i)" + using assms lower_triangular_mult lower_triangular_mat_mat + by (induction i) auto + +lemma lower_triangular_suminf: + assumes "\<And>i. lower_triangular_mat (f i)" "summable (f :: nat \<Rightarrow> 'b::real_normed_vector^_^_)" + shows "lower_triangular_mat (\<Sum>i. f i)" + using assms + unfolding lower_triangular_mat_def + by (subst bounded_linear.suminf) (auto intro: bounded_linear_compose) + +lemma lower_triangular_pow_eq: + assumes "lower_triangular_mat X" "lower_triangular_mat Y" "\<And>s'. s' \<le> s \<Longrightarrow> row s' X = row s' Y" "s' \<le> s" + shows "row s' (matpow X i) = row s' (matpow Y i)" + using assms +proof (induction i) + case (Suc i) + thus ?case + proof - + have ltX: "lower_triangular_mat (matpow X i)" + by (simp add: Suc(2) lower_triangular_pow) + have ltY: "lower_triangular_mat (matpow Y i)" + by (simp add: Suc(3) lower_triangular_pow) + have " (\<Sum>k\<in>UNIV. matpow X i $ s' $ k * X $ k $ j) = (\<Sum>k\<in>UNIV. matpow Y i $ s' $ k * Y $ k $ j)" for j + proof - + have "(\<Sum>k\<in>UNIV. matpow X i $ s' $ k * X $ k $ j) = (\<Sum>k\<in>UNIV. if s' < k then 0 else matpow Y i $ s' $ k * X $ k $ j)" + using Suc ltY + by (auto simp: row_def lower_triangular_mat_def intro!: sum.cong) + also have "\<dots> = (\<Sum>k \<in> UNIV . matpow Y i $ s' $ k * Y $ k $ j)" + using Suc ltY + by (auto simp: row_def lower_triangular_mat_def cong: if_cong intro!: sum.cong) + finally show ?thesis. + qed + thus ?thesis + by (auto simp: row_def matrix_matrix_mult_def) + qed +qed simp + +lemma lower_triangular_mat_mult: + assumes "lower_triangular_mat M" "\<And>i. i \<le> j \<Longrightarrow> v $ i = v' $ i" + shows "(M *v v) $ j = (M *v v') $ j" +proof - + have "(M *v v) $ j = (\<Sum>i\<in>UNIV. (if j = (\<Sum>i\<in>UNIV. (if j = (M *v v') $ j" + using assms unfolding lower_triangular_mat_def + by (auto simp: matrix_vector_mult_def intro!: sum.cong) + finally show ?thesis. +qed + +subsection \<open>Inverses\<close> + +(* from AFP/Rank_Nullity_Theorem *) +lemma matrix_inv: + assumes "invertible M" + shows matrix_inv_left: "matrix_inv M ** M = mat 1" + and matrix_inv_right: "M ** matrix_inv M = mat 1" + using \<open>invertible M\<close> and someI_ex [of "\<lambda> N. M ** N = mat 1 \<and> N ** M = mat 1"] + unfolding invertible_def and matrix_inv_def + by simp_all + +(* from AFP/Rank_Nullity_Theorem *) +lemma matrix_inv_unique: + fixes A::"'a::{semiring_1}^'n^'n" + assumes AB: "A ** B = mat 1" and BA: "B ** A = mat 1" + shows "matrix_inv A = B" + by (metis AB BA invertible_def matrix_inv_right matrix_mul_assoc matrix_mul_lid) + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/Modified_Policy_Iteration.thy b/thys/MDP-Algorithms/Modified_Policy_Iteration.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Modified_Policy_Iteration.thy @@ -0,0 +1,742 @@ +(* Author: Maximilian Schäffeler *) + +theory Modified_Policy_Iteration + imports + Policy_Iteration + Value_Iteration +begin + +section \<open>Modified Policy Iteration\<close> + +locale MDP_MPI = MDP_finite_type A K r l + MDP_act A K r l arb_act + for A and K :: "'s :: finite \<times> 'a :: finite \<Rightarrow> 's pmf" and r l arb_act +begin + +subsection \<open>The Advantage Function @{term B}\<close> + +definition "B v s = (\<Squnion>d \<in> D\<^sub>R. (r_dec d s + (l *\<^sub>R \\<^sub>1 d - id_blinfun) v s))" + +text "The function @{const B} denotes the advantage of choosing the optimal action vs. + the current value estimate" + +lemma B_eq_\<L>: "B v s = \<L> v s - v s" +proof - + have *: "B v s = (\<Squnion>d \<in> D\<^sub>R. L d v s - v s)" + unfolding B_def L_def + by (auto simp add: blinfun.bilinear_simps add_diff_eq) + show ?thesis + unfolding * + proof (rule antisym) + show "(\<Squnion>d\<in>D\<^sub>R. L d v s - v s) \<le> \<L> v s - v s" + unfolding \<L>_def + using ex_dec + by (fastforce intro!: cSUP_upper cSUP_least) + next + have "bdd_above ((\<lambda>d. L d v s - v s) ` D\<^sub>R)" + by (auto intro!: bounded_const bounded_minus_comp bounded_imp_bdd_above) + thus "\<L> v s - v s \<le> (\<Squnion>d \<in> D\<^sub>R. L d v s - v s)" + unfolding \<L>_def diff_le_eq + by (intro cSUP_least) (auto intro: cSUP_upper2 simp: diff_le_eq[symmetric]) + qed +qed + +text \<open>@{const B} is a bounded function.\<close> + +lift_definition B\<^sub>b :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> 's \<Rightarrow>\<^sub>b real" is "B" + using \<L>\<^sub>b.rep_eq[symmetric] B_eq_\<L> + by (auto intro!: bfun_normI order.trans[OF abs_triangle_ineq4] add_mono abs_le_norm_bfun) + +lemma B\<^sub>b_eq_\<L>\<^sub>b: "B\<^sub>b v = \<L>\<^sub>b v - v" + by (auto simp: \<L>\<^sub>b.rep_eq B\<^sub>b.rep_eq B_eq_\<L>) + +lemma \<L>\<^sub>b_eq_SUP_L\<^sub>a: "\<L>\<^sub>b v s = (\<Squnion>a \<in> A s. L\<^sub>a a v s)" + using L_eq_L\<^sub>a_det \<L>\<^sub>b_eq_SUP_det SUP_step_det_eq + by auto + +subsection \<open>Optimization of the Value Function over Multiple Steps\<close> + +definition "U m v s = (\<Squnion>d \<in> D\<^sub>R. (\<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d)^^m) v) s)" + +text \<open>@{const U} expresses the value estimate obtained by optimizing the first @{term m} steps and + afterwards using the current estimate.\<close> + +lemma U_zero [simp]: "U 0 v = v" + unfolding U_def \<L>_def + by (auto simp: \<nu>\<^sub>b_fin.rep_eq) + +lemma U_one_eq_\<L>: "U 1 v s = \<L> v s" + unfolding U_def \<L>_def + by (auto simp: \<nu>\<^sub>b_fin_eq_\\<^sub>X L_def blinfun.bilinear_simps) + +lift_definition U\<^sub>b :: "nat \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" is U +proof - + fix n v + have "norm (\<nu>\<^sub>b_fin (mk_stationary d) m) \<le> (\<Sum>i<m. l ^ i * r\<^sub>M)" for d m + using abs_\<nu>_fin_le \<nu>\<^sub>b_fin.rep_eq + by (auto intro!: norm_bound) + moreover have "norm (((l *\<^sub>R \\<^sub>1 d)^^m) v) \<le> l ^ m * norm v" for d m + by (auto simp: \\<^sub>X_const[symmetric] blinfun.bilinear_simps blincomp_scaleR_right simp del: \\<^sub>X_sconst + intro!: boundedI order.trans[OF abs_le_norm_bfun] mult_left_mono) + ultimately have *: "norm (\<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d)^^m) v) \<le> (\<Sum>i<m. l ^ i * r\<^sub>M) + l ^ m * norm v" for d m + using norm_triangle_mono by blast + show "U n v \<in> bfun" + using ex_dec order.trans[OF abs_le_norm_bfun *] + by (fastforce simp: U_def intro!: bfun_normI cSup_abs_le) +qed + +lemma U\<^sub>b_contraction: "dist (U\<^sub>b m v) (U\<^sub>b m u) \<le> l ^ m * dist v u" +proof - + have aux: "dist (U\<^sub>b m v s) (U\<^sub>b m u s) \<le> l ^ m * dist v u" if le: "U\<^sub>b m u s \<le> U\<^sub>b m v s" for s v u + proof - + let ?U = "\<lambda>m v d. (\<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d) ^^ m) v) s" + have "U\<^sub>b m v s - U\<^sub>b m u s \<le> (\<Squnion>d \<in> D\<^sub>R. ?U m v d - ?U m u d)" + using bounded_stationary_\<nu>\<^sub>b_fin bounded_disc_\\<^sub>1 le + unfolding U\<^sub>b.rep_eq U_def + by (intro le_SUP_diff') (auto intro: bounded_plus_comp) + also have "\<dots> = (\<Squnion>d \<in> D\<^sub>R. ((l *\<^sub>R \\<^sub>1 d) ^^ m) (v - u) s)" + by (simp add: L_def scale_right_diff_distrib blinfun.bilinear_simps) + also have "\<dots> = (\<Squnion>d \<in> D\<^sub>R. l^m * ((\\<^sub>1 d ^^ m) (v - u) s))" + by (simp add: blincomp_scaleR_right blinfun.scaleR_left) + also have "\<dots> = l^m * (\<Squnion>d \<in> D\<^sub>R. ((\\<^sub>1 d ^^ m) (v - u) s))" + using D\<^sub>R_ne bounded_P bounded_disc_\\<^sub>1' + by (auto intro: bounded_SUP_mul) + also have "\<dots> \<le> l^m * norm (\<Squnion>d \<in> D\<^sub>R. ((\\<^sub>1 d ^^ m) (v - u) s))" + by (simp add: mult_left_mono) + also have "\<dots> \<le> l^m * (\<Squnion>d \<in> D\<^sub>R. norm (((\\<^sub>1 d ^^ m) (v - u) s)))" + using D\<^sub>R_ne ex_dec bounded_norm_comp bounded_disc_\\<^sub>1' + by (fastforce intro!: mult_left_mono) + also have "\<dots> \<le> l^m * (\<Squnion>d \<in> D\<^sub>R. norm ((\\<^sub>1 d ^^ m) ((v - u))))" + using ex_dec + by (fastforce intro!: order.trans[OF norm_blinfun] abs_le_norm_bfun mult_left_mono cSUP_mono) + also have "\<dots> \<le> l^m * (\<Squnion>d \<in> D\<^sub>R. norm ((v - u)))" + using norm_\\<^sub>X_apply + by (auto simp: \\<^sub>X_const[symmetric] cSUP_least mult_left_mono) + also have "\<dots> = l ^m * dist v u" + by (auto simp: dist_norm) + finally have "U\<^sub>b m v s - U\<^sub>b m u s \<le> l^m * dist v u" . + thus ?thesis + by (simp add: dist_real_def le) + qed + moreover have "U\<^sub>b m v s \<le> U\<^sub>b m u s \<Longrightarrow> dist (U\<^sub>b m v s) (U\<^sub>b m u s) \<le> l^m * dist v u" for u v s + by (simp add: aux dist_commute) + ultimately have "dist (U\<^sub>b m v s) (U\<^sub>b m u s) \<le> l^m * dist v u" for u v s + using linear + by blast + thus "dist (U\<^sub>b m v) (U\<^sub>b m u) \<le> l^m * dist v u" + by (simp add: dist_bound) +qed + +lemma U\<^sub>b_conv: + "\<exists>!v. U\<^sub>b (Suc m) v = v" + "(\<lambda>n. (U\<^sub>b (Suc m) ^^ n) v) \<longlonglongrightarrow> (THE v. U\<^sub>b (Suc m) v = v)" +proof - + have *: "is_contraction (U\<^sub>b (Suc m))" + unfolding is_contraction_def + using U\<^sub>b_contraction[of "Suc m"] le_neq_trans[OF zero_le_disc] + by (cases "l = 0") + (auto intro!: power_Suc_less_one intro: exI[of _ "l^(Suc m)"]) + show "\<exists>!v. U\<^sub>b (Suc m) v = v" "(\<lambda>n. (U\<^sub>b (Suc m) ^^ n) v) \<longlonglongrightarrow> (THE v. U\<^sub>b (Suc m) v = v)" + using banach'[OF *] + by auto +qed + +lemma U\<^sub>b_convergent: "convergent (\<lambda>n. (U\<^sub>b (Suc m) ^^ n) v)" + by (intro convergentI[OF U\<^sub>b_conv(2)]) + +lemma U\<^sub>b_mono: + assumes "v \<le> u" + shows "U\<^sub>b m v \<le> U\<^sub>b m u" +proof - + have "U\<^sub>b m v s \<le> U\<^sub>b m u s" for s + unfolding U\<^sub>b.rep_eq U_def + proof (intro cSUP_mono, goal_cases) + case 2 + thus ?case + by (simp add: bounded_imp_bdd_above bounded_disc_\\<^sub>1 bounded_plus_comp bounded_stationary_\<nu>\<^sub>b_fin) + next + case (3 n) + thus ?case + using less_eq_bfunD[OF \\<^sub>X_mono[OF assms]] + by (auto simp: \\<^sub>X_const[symmetric] blincomp_scaleR_right blinfun.scaleR_left intro!: mult_left_mono exI) + qed auto + thus ?thesis + using assms + by auto +qed + +lemma U\<^sub>b_le_\<L>\<^sub>b: "U\<^sub>b m v \<le> (\<L>\<^sub>b ^^ m) v" +proof - + have "U\<^sub>b m v s = (\<Squnion>d \<in> D\<^sub>R. (L d^^ m) v s)" for m v s + by (auto simp: L_iter U\<^sub>b.rep_eq \<L>\<^sub>b.rep_eq U_def \<L>_def) + thus ?thesis + using L_iter_le_\<L>\<^sub>b ex_dec + by (fastforce intro!: cSUP_least) +qed + + +lemma L_iter_le_U\<^sub>b: + assumes "d \<in> D\<^sub>R" + shows "(L d^^m) v \<le> U\<^sub>b m v" + using assms + by (fastforce intro!: cSUP_upper bounded_imp_bdd_above + simp: L_iter U\<^sub>b.rep_eq U_def bounded_disc_\\<^sub>1 bounded_plus_comp bounded_stationary_\<nu>\<^sub>b_fin) + + +lemma lim_U\<^sub>b: "lim (\<lambda>n. (U\<^sub>b (Suc m) ^^ n) v) = \<nu>\<^sub>b_opt" +proof - + have le_U: "\<nu>\<^sub>b_opt \<le> U\<^sub>b m \<nu>\<^sub>b_opt" for m + proof - + obtain d where d: "\<nu>_improving \<nu>\<^sub>b_opt (mk_dec_det d)" "d \<in> D\<^sub>D" + using ex_improving_det by auto + have "\<nu>\<^sub>b_opt = (L (mk_dec_det d) ^^ m) \<nu>\<^sub>b_opt" + by (induction m) (metis L_\<nu>_fix_iff \<L>\<^sub>b_opt \<nu>_improving_imp_\<L>\<^sub>b d(1) funpow_swap1)+ + thus ?thesis + using \<open>d \<in> D\<^sub>D\<close> + by (auto intro!: order.trans[OF _ L_iter_le_U\<^sub>b]) + qed + have "U\<^sub>b m \<nu>\<^sub>b_opt \<le> \<nu>\<^sub>b_opt" for m + using \<L>_inc_le_opt + by (auto intro!: order.trans[OF U\<^sub>b_le_\<L>\<^sub>b] simp: funpow_swap1) + hence "U\<^sub>b (Suc m) \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using le_U + by (simp add: antisym) + moreover have "(lim (\<lambda>n. (U\<^sub>b (Suc m) ^^n) v)) = U\<^sub>b (Suc m) (lim (\<lambda>n. (U\<^sub>b (Suc m) ^^n) v))" + using limI[OF U\<^sub>b_conv(2)] theI'[OF U\<^sub>b_conv(1)] + by auto + ultimately show ?thesis + using U\<^sub>b_conv(1) + by metis +qed + +lemma U\<^sub>b_tendsto: "(\<lambda>n. (U\<^sub>b (Suc m) ^^ n) v) \<longlonglongrightarrow> \<nu>\<^sub>b_opt" + using lim_U\<^sub>b U\<^sub>b_convergent convergent_LIMSEQ_iff + by metis + +lemma U\<^sub>b_fix_unique: "U\<^sub>b (Suc m) v = v \<longleftrightarrow> v = \<nu>\<^sub>b_opt" + using theI'[OF U\<^sub>b_conv(1)] U\<^sub>b_conv(1) + by (auto simp: LIMSEQ_unique[OF U\<^sub>b_tendsto U\<^sub>b_conv(2)[of m]]) + +lemma dist_U\<^sub>b_opt: "dist (U\<^sub>b m v) \<nu>\<^sub>b_opt \<le> l^m * dist v \<nu>\<^sub>b_opt" +proof - + have "dist (U\<^sub>b m v) \<nu>\<^sub>b_opt = dist (U\<^sub>b m v) (U\<^sub>b m \<nu>\<^sub>b_opt)" + by (metis U\<^sub>b.abs_eq U\<^sub>b_fix_unique U_zero apply_bfun_inverse not0_implies_Suc) + also have "\<dots> \<le> l^m * dist v \<nu>\<^sub>b_opt" + by (meson U\<^sub>b_contraction) + finally show ?thesis . +qed + +subsection \<open>Expressing a Single Step of Modified Policy Iteration\<close> +text \<open>The function @{term W} equals the value computed by the Modified Policy Iteration Algorithm + in a single iteration. + The right hand addend in the definition describes the advantage of using the optimal action for + the first m steps. + \<close> +definition "W d m v = v + (\<Sum>i < m. (l *\<^sub>R \\<^sub>1 d)^^i) (B\<^sub>b v)" + + +lemma W_eq_L_iter: + assumes "\<nu>_improving v d" + shows "W d m v = (L d^^m) v" +proof - + have "(\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) (\<L>\<^sub>b v) = (\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) (L d v)" + using \<nu>_improving_imp_\<L>\<^sub>b assms by auto + hence "W d m v = v + ((\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) (L d v)) - (\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) v" + by (auto simp: W_def B\<^sub>b_eq_\<L>\<^sub>b blinfun.bilinear_simps algebra_simps ) + also have "\<dots> = v + \<nu>\<^sub>b_fin (mk_stationary d) m + (\<Sum>i<m. ((l *\<^sub>R \\<^sub>1 d)^^i) ((l *\<^sub>R \\<^sub>1 d) v)) - (\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) v" + unfolding L_def + by (auto simp: \<nu>\<^sub>b_fin_eq blinfun.bilinear_simps blinfun.sum_left scaleR_right.sum) + also have "\<dots> = v + \<nu>\<^sub>b_fin (mk_stationary d) m + (\<Sum>i<m. ((l *\<^sub>R \\<^sub>1 d)^^Suc i) v) - (\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^i) v" + by (auto simp del: blinfunpow.simps simp: blinfunpow_assoc) + also have "\<dots> = \<nu>\<^sub>b_fin (mk_stationary d) m + (\<Sum>i<Suc m. ((l *\<^sub>R \\<^sub>1 d)^^ i) v) - (\<Sum>i<m. (l *\<^sub>R \\<^sub>1 d)^^ i) v" + by (subst sum.lessThan_Suc_shift) auto + also have "\<dots> = \<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d)^^m) v" + by (simp add: blinfun.sum_left) + also have "\<dots> = (L d ^^ m) v" + using L_iter by auto + finally show ?thesis . +qed + +lemma W_le_U\<^sub>b: + assumes "v \<le> u" "\<nu>_improving v d" + shows "W d m v \<le> U\<^sub>b m u" +proof - + have "U\<^sub>b m u - W d m v \<ge> \<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d) ^^ m) u - (\<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d)^^m) v)" + using \<nu>_improving_D_MR assms(2) bounded_stationary_\<nu>\<^sub>b_fin bounded_disc_\\<^sub>1 + by (fastforce intro!: diff_mono bounded_imp_bdd_above cSUP_upper bounded_plus_comp simp: U\<^sub>b.rep_eq U_def L_iter W_eq_L_iter) + hence *: "U\<^sub>b m u - W d m v \<ge> ((l *\<^sub>R \\<^sub>1 d) ^^ m) (u - v)" + by (auto simp: blinfun.diff_right) + show "W d m v \<le> U\<^sub>b m u" + using order.trans[OF \\<^sub>1_n_disc_pos[unfolded blincomp_scaleR_right[symmetric]] *] assms + by auto +qed + +lemma W_ge_\<L>\<^sub>b: + assumes "v \<le> u" "0 \<le> B\<^sub>b u" "\<nu>_improving u d'" + shows "\<L>\<^sub>b v \<le> W d' (Suc m) u" +proof - + have "\<L>\<^sub>b v \<le> u + B\<^sub>b u" + using assms(1) \<L>\<^sub>b_mono B\<^sub>b_eq_\<L>\<^sub>b + by auto + also have "\<dots> \<le> W d' (Suc m) u" + using L_mono \<nu>_improving_imp_\<L>\<^sub>b assms(3) assms + by (induction m) (auto simp: W_eq_L_iter B\<^sub>b_eq_\<L>\<^sub>b) + finally show ?thesis . +qed + +lemma B\<^sub>b_le: + assumes "\<nu>_improving v d" + shows "B\<^sub>b v + (l *\<^sub>R \\<^sub>1 d - id_blinfun) (u - v) \<le> B\<^sub>b u" +proof - + have "r_dec\<^sub>b d + (l *\<^sub>R \\<^sub>1 d - id_blinfun) u \<le> B\<^sub>b u" + using L_def L_le_\<L>\<^sub>b assms + by (auto simp: B\<^sub>b_eq_\<L>\<^sub>b \<L>\<^sub>b.rep_eq \<L>_def blinfun.bilinear_simps) + moreover have "B\<^sub>b v = r_dec\<^sub>b d + (l *\<^sub>R \\<^sub>1 d - id_blinfun) v" + using assms + by (auto simp: B\<^sub>b_eq_\<L>\<^sub>b \<nu>_improving_imp_\<L>\<^sub>b[of _ d] L_def blinfun.bilinear_simps) + ultimately show ?thesis + by (simp add: blinfun.diff_right) +qed + +lemma \<L>\<^sub>b_W_ge: + assumes "u \<le> \<L>\<^sub>b u" "\<nu>_improving u d" + shows "W d m u \<le> \<L>\<^sub>b (W d m u)" +proof - + have "0 \<le> ((l *\<^sub>R \\<^sub>1 d) ^^ m) (B\<^sub>b u)" + by (metis B\<^sub>b_eq_\<L>\<^sub>b \\<^sub>1_n_disc_pos assms(1) blincomp_scaleR_right diff_ge_0_iff_ge) + also have "\<dots> = ((l *\<^sub>R \\<^sub>1 d)^^0 + (\<Sum>i < m. (l *\<^sub>R \\<^sub>1 d)^^(Suc i))) (B\<^sub>b u) - (\<Sum>i < m. (l *\<^sub>R \\<^sub>1 d)^^ i) (B\<^sub>b u)" + by (subst sum.lessThan_Suc_shift[symmetric]) (auto simp: blinfun.diff_left[symmetric]) + also have "\<dots> = B\<^sub>b u + ((l *\<^sub>R \\<^sub>1 d - id_blinfun) o\<^sub>L (\<Sum>i < m. (l *\<^sub>R \\<^sub>1 d)^^i)) (B\<^sub>b u)" + by (auto simp: blinfun.bilinear_simps sum_subtractf) + also have "\<dots> = B\<^sub>b u + (l *\<^sub>R \\<^sub>1 d - id_blinfun) (W d m u - u)" + by (auto simp: W_def sum.lessThan_Suc[unfolded lessThan_Suc_atMost]) + also have "\<dots> \<le> B\<^sub>b (W d m u)" + using B\<^sub>b_le assms(2) by blast + finally have "0 \<le> B\<^sub>b (W d m u)" . + thus ?thesis using B\<^sub>b_eq_\<L>\<^sub>b + by auto +qed + +subsection \<open>Computing the Bellman Operator over Multiple Steps\<close> +definition L_pow :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" where + "L_pow v d m = (L (mk_dec_det d) ^^ Suc m) v" + +lemma sum_telescope': "(\<Sum>i\<le>k. f (Suc i) - f i ) = f (Suc k) - (f 0 :: 'c :: ab_group_add)" + using sum_telescope[of "-f" k] + by auto + +(* eq 6.5.7 *) +lemma L_pow_eq: + assumes "\<nu>_improving v (mk_dec_det d)" + shows "L_pow v d m = v + (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 (mk_dec_det d))^^i)) (B\<^sub>b v)" +proof - + let ?d = "(mk_dec_det d)" + have "(\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (B\<^sub>b v) = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (L ?d v) - (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) v" + using assms + by (auto simp: B\<^sub>b_eq_\<L>\<^sub>b blinfun.bilinear_simps \<nu>_improving_imp_\<L>\<^sub>b) + also have "\<dots> = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (r_dec\<^sub>b ?d) + (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) ((l *\<^sub>R \\<^sub>1 ?d) v) - (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) v" + by (simp add: L_def blinfun.bilinear_simps) + also have "\<dots> = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (r_dec\<^sub>b ?d) + (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^Suc i)) v - (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) v" + by (auto simp: blinfun.sum_left blinfunpow_assoc simp del: blinfunpow.simps) + also have "\<dots> = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (r_dec\<^sub>b ?d) + (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^Suc i) - (l *\<^sub>R \\<^sub>1 ?d)^^i) v" + by (simp add: blinfun.diff_left sum_subtractf) + also have "\<dots> = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (r_dec\<^sub>b ?d) + ((l *\<^sub>R \\<^sub>1 ?d)^^Suc m) v - v" + by (subst sum_telescope') (auto simp: blinfun.bilinear_simps) + finally have "(\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (B\<^sub>b v) = (\<Sum>i \<le> m. ((l *\<^sub>R \\<^sub>1 ?d)^^i)) (r_dec\<^sub>b ?d) + ((l *\<^sub>R \\<^sub>1 ?d)^^Suc m) v - v" . + moreover have "L_pow v d m = \<nu>\<^sub>b_fin (mk_stationary_det d) (Suc m) + ((l *\<^sub>R \\<^sub>1 ?d)^^Suc m) v" + by (simp only: L_pow_def L_iter lessThan_Suc_atMost[symmetric]) + ultimately show ?thesis + by (auto simp: \<nu>\<^sub>b_fin_eq lessThan_Suc_atMost) +qed + +lemma L_pow_eq_W: + assumes "d \<in> D\<^sub>D" + shows "L_pow v (policy_improvement d v) m = W (mk_dec_det (policy_improvement d v)) (Suc m) v" + using assms policy_improvement_improving + by (auto simp: W_eq_L_iter L_pow_def) + +lemma L_pow_\<L>\<^sub>b_mono_inv: + assumes "d \<in> D\<^sub>D" "v \<le> \<L>\<^sub>b v" + shows "L_pow v (policy_improvement d v) m \<le> \<L>\<^sub>b (L_pow v (policy_improvement d v) m)" + using assms L_pow_eq_W \<L>\<^sub>b_W_ge policy_improvement_improving + by auto + +subsection \<open>The Modified Policy Iteration Algorithm\<close> +context + fixes d0 :: "'s \<Rightarrow> 'a" + fixes v0 :: "'s \<Rightarrow>\<^sub>b real" + fixes m :: "nat \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> nat" + assumes d0: "d0 \<in> D\<^sub>D" +begin + +text \<open>We first define a function that executes the algorithm for n steps.\<close> +fun mpi :: "nat \<Rightarrow> (('s \<Rightarrow> 'a) \<times> ('s \<Rightarrow>\<^sub>b real))" where + "mpi 0 = (policy_improvement d0 v0, v0)" | + "mpi (Suc n) = + (let (d, v) = mpi n; v' = L_pow v d (m n v) in + (policy_improvement d v', v'))" + +definition "mpi_val n = snd (mpi n)" +definition "mpi_pol n = fst (mpi n)" + +lemma mpi_pol_zero[simp]: "mpi_pol 0 = policy_improvement d0 v0" + unfolding mpi_pol_def + by auto + +lemma mpi_pol_Suc: "mpi_pol (Suc n) = policy_improvement (mpi_pol n) (mpi_val (Suc n))" + by (auto simp: case_prod_beta' Let_def mpi_pol_def mpi_val_def) + +lemma mpi_pol_is_dec_det: "mpi_pol n \<in> D\<^sub>D" + unfolding mpi_pol_def + using policy_improvement_is_dec_det d0 + by (induction n) (auto simp: Let_def split: prod.splits) + +lemma \<nu>_improving_mpi_pol: "\<nu>_improving (mpi_val n) (mk_dec_det (mpi_pol n))" + using d0 policy_improvement_improving mpi_pol_is_dec_det mpi_pol_Suc + by (cases n) (auto simp: mpi_pol_def mpi_val_def) + +lemma mpi_val_zero[simp]: "mpi_val 0 = v0" + unfolding mpi_val_def by auto + +lemma mpi_val_Suc: "mpi_val (Suc n) = L_pow (mpi_val n) (mpi_pol n) (m n (mpi_val n))" + unfolding mpi_val_def mpi_pol_def + by (auto simp: case_prod_beta' Let_def) + +lemma mpi_val_eq: "mpi_val (Suc n) = + mpi_val n + (\<Sum>i \<le> m n (mpi_val n). (l *\<^sub>R \\<^sub>1 (mk_dec_det (mpi_pol n))) ^^ i) (B\<^sub>b (mpi_val n))" + using L_pow_eq[OF \<nu>_improving_mpi_pol] mpi_val_Suc + by auto + + +text \<open>Value Iteration is a special case of MPI where @{term "\<forall>n v. m n v = 0"}.\<close> +lemma mpi_includes_value_it: + assumes "\<forall>n v. m n v = 0" + shows "mpi_val (Suc n) = \<L>\<^sub>b (mpi_val n)" + using assms B\<^sub>b_eq_\<L>\<^sub>b mpi_val_eq + by auto + +subsection \<open>Convergence Proof\<close> +text \<open>We define the sequence @{term w} as an upper bound for the values of MPI.\<close> +fun w where + "w 0 = v0" | + "w (Suc n) = U\<^sub>b (Suc (m n (mpi_val n))) (w n)" + +lemma dist_\<nu>\<^sub>b_opt: "dist (w (Suc n)) \<nu>\<^sub>b_opt \<le> l * dist (w n) \<nu>\<^sub>b_opt" + by (fastforce simp: algebra_simps intro: order.trans[OF dist_U\<^sub>b_opt] mult_left_mono power_le_one + mult_left_le_one_le order.strict_implies_order) + +lemma dist_\<nu>\<^sub>b_opt_n: "dist (w n) \<nu>\<^sub>b_opt \<le> l^n * dist v0 \<nu>\<^sub>b_opt" + by (induction n) (fastforce simp: algebra_simps intro: order.trans[OF dist_\<nu>\<^sub>b_opt] mult_left_mono)+ + +lemma w_conv: "w \<longlonglongrightarrow> \<nu>\<^sub>b_opt" +proof - + have "(\<lambda>n. l^n * dist v0 \<nu>\<^sub>b_opt) \<longlonglongrightarrow> 0" + using LIMSEQ_realpow_zero + by (cases "v0 = \<nu>\<^sub>b_opt") auto + then show ?thesis + by (fastforce intro: metric_LIMSEQ_I order.strict_trans1[OF dist_\<nu>\<^sub>b_opt_n] simp: LIMSEQ_def) +qed + +text \<open>MPI converges monotonically to the optimal value from below. + The iterates are sandwiched between @{const \<L>\<^sub>b} from below and @{const U\<^sub>b} from above.\<close> +theorem mpi_conv: + assumes "v0 \<le> \<L>\<^sub>b v0" + shows "mpi_val \<longlonglongrightarrow> \<nu>\<^sub>b_opt" and "\<And>n. mpi_val n \<le> mpi_val (Suc n)" +proof - + define y where "y n = (\<L>\<^sub>b^^n) v0" for n + have aux: "mpi_val n \<le> \<L>\<^sub>b (mpi_val n) \<and> mpi_val n \<le> mpi_val (Suc n) \<and> y n \<le> mpi_val n \<and> mpi_val n \<le> w n" for n + proof (induction n) + case 0 + show ?case + using assms B\<^sub>b_eq_\<L>\<^sub>b + unfolding y_def + by (auto simp: mpi_val_eq blinfun.sum_left \\<^sub>1_n_disc_pos blincomp_scaleR_right sum_nonneg) + next + case (Suc n) + have val_eq_W: "mpi_val (Suc n) = W (mk_dec_det (mpi_pol n)) (Suc (m n (mpi_val n))) (mpi_val n)" + using \<nu>_improving_mpi_pol mpi_val_Suc W_eq_L_iter L_pow_def + by auto + hence *: "mpi_val (Suc n) \<le> \<L>\<^sub>b (mpi_val (Suc n))" + using Suc.IH \<L>\<^sub>b_W_ge \<nu>_improving_mpi_pol by presburger + moreover have "mpi_val (Suc n) \<le> mpi_val (Suc (Suc n))" + using * + by (simp add: B\<^sub>b_eq_\<L>\<^sub>b mpi_val_eq \\<^sub>1_n_disc_pos blincomp_scaleR_right blinfun.sum_left sum_nonneg) + moreover have "mpi_val (Suc n) \<le> w (Suc n)" + using Suc.IH \<nu>_improving_mpi_pol + by (auto simp: val_eq_W intro: order.trans[OF _ W_le_U\<^sub>b]) + moreover have "y (Suc n) \<le> mpi_val (Suc n)" + using Suc.IH \<nu>_improving_mpi_pol W_ge_\<L>\<^sub>b + by (auto simp: y_def B\<^sub>b_eq_\<L>\<^sub>b val_eq_W) + ultimately show ?case + by auto + qed + thus "mpi_val n \<le> mpi_val (Suc n)" for n + by auto + have "y \<longlonglongrightarrow> \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_lim y_def by presburger + thus "mpi_val \<longlonglongrightarrow> \<nu>\<^sub>b_opt" + using aux + by (auto intro: tendsto_bfun_sandwich[OF _ w_conv]) +qed + +subsection \<open>$\epsilon$-Optimality\<close> +text \<open>This gives an upper bound on the error of MPI.\<close> +lemma mpi_pol_eps_opt: + assumes "2 * l * dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < eps * (1 - l)" "eps > 0" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (mpi_pol n))) (\<L>\<^sub>b (mpi_val n)) \<le> eps / 2" +proof - + let ?p = "mk_stationary_det (mpi_pol n)" + let ?d = "mk_dec_det (mpi_pol n)" + let ?v = "mpi_val n" + have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) = dist (L ?d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b ?v)" + using L_\<nu>_fix + by force + also have "\<dots> = dist (L ?d (\<nu>\<^sub>b ?p)) (L ?d ?v)" + by (metis \<nu>_improving_imp_\<L>\<^sub>b \<nu>_improving_mpi_pol) + also have "\<dots> \<le> dist (L ?d (\<nu>\<^sub>b ?p)) (L ?d (\<L>\<^sub>b ?v)) + dist (L ?d (\<L>\<^sub>b ?v)) (L ?d ?v)" + using dist_triangle + by blast + also have "\<dots> \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) + dist (L ?d (\<L>\<^sub>b ?v)) (L ?d ?v)" + using contraction_L by auto + also have "\<dots> \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) + l * dist (\<L>\<^sub>b ?v) ?v" + using contraction_L by auto + finally have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) + l * dist (\<L>\<^sub>b ?v) ?v". + hence *:"(1-l) * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) \<le> l * dist (\<L>\<^sub>b ?v) ?v" + by (auto simp: left_diff_distrib) + thus ?thesis + proof (cases "l = 0") + case True + thus ?thesis + using assms * + by auto + next + case False + have **: "dist (\<L>\<^sub>b ?v) (mpi_val n) < eps * (1 - l) / (2 * l)" + using False le_neq_trans[OF zero_le_disc False[symmetric]] assms + by (auto simp: dist_commute pos_less_divide_eq Groups.mult_ac(2)) + have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) \<le> (l/ (1-l)) * dist (\<L>\<^sub>b ?v) ?v" + using * + by (auto simp: mult.commute pos_le_divide_eq) + also have "\<dots> \<le> (l/ (1-l)) * (eps * (1 - l) / (2 * l))" + using ** + by (fastforce intro!: mult_left_mono simp: divide_nonneg_pos) + also have "\<dots> = eps / 2" + using False disc_lt_one + by (auto simp: order.strict_iff_order) + finally show "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b ?v) \<le> eps / 2". + qed +qed + +lemma mpi_pol_opt: + assumes "2 * l * dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < eps * (1 - l)" "eps > 0" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (mpi_pol n))) (\<nu>\<^sub>b_opt) < eps" +proof - + have "dist (\<nu>\<^sub>b (mk_stationary_det (mpi_pol n))) (\<nu>\<^sub>b_opt) \<le> eps/2 + dist (\<L>\<^sub>b (mpi_val n)) \<nu>\<^sub>b_opt" + by (metis mpi_pol_eps_opt[OF assms] dist_commute dist_triangle_le add_right_mono) + thus ?thesis + using dist_\<L>\<^sub>b_opt_eps assms + by fastforce +qed + +lemma mpi_val_term_ex: + assumes "v0 \<le> \<L>\<^sub>b v0" "eps > 0" + shows "\<exists>n. 2 * l * dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < eps * (1 - l)" +proof - + note dist_\<L>\<^sub>b_lt_dist_opt + have "(\<lambda>n. dist (mpi_val n) \<nu>\<^sub>b_opt) \<longlonglongrightarrow> 0" + using mpi_conv(1)[OF assms(1)] tendsto_dist_iff + by blast + hence "(\<lambda>n. dist (mpi_val n) (\<L>\<^sub>b (mpi_val n))) \<longlonglongrightarrow> 0" + using dist_\<L>\<^sub>b_lt_dist_opt + by (auto simp: metric_LIMSEQ_I intro: tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. 2 * dist (mpi_val n) \<nu>\<^sub>b_opt"]) + hence "\<forall>e >0. \<exists>n. dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < e" + by (fastforce dest!: metric_LIMSEQ_D) + hence "l \<noteq> 0 \<Longrightarrow> \<exists>n. dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < eps * (1 - l) / (2 * l)" + by (simp add: assms order.not_eq_order_implies_strict) + thus "\<exists>n. (2 * l) * dist (mpi_val n) (\<L>\<^sub>b (mpi_val n)) < eps * (1 - l)" + using assms le_neq_trans[OF zero_le_disc] + by (cases "l = 0") (auto simp: mult.commute pos_less_divide_eq) +qed +end + +subsection \<open>Unbounded MPI\<close> +context + fixes eps \<delta> :: real and M :: nat +begin + +function (domintros) mpi_algo where "mpi_algo d v m = ( + if 2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l) + then (policy_improvement d v, v) + else mpi_algo (policy_improvement d v) (L_pow v (policy_improvement d v) (m 0 v)) (\<lambda>n. m (Suc n)))" + by auto + +text \<open>We define a tailrecursive version of @{const mpi} which more closely resembles @{const mpi_algo}.\<close> +fun mpi' where + "mpi' d v 0 m = (policy_improvement d v, v)" | + "mpi' d v (Suc n) m = ( + let d' = policy_improvement d v; v' = L_pow v d' (m 0 v) in mpi' d' v' n (\<lambda>n. m (Suc n)))" + +lemma mpi_Suc': + assumes "d \<in> D\<^sub>D" + shows "mpi d v m (Suc n) = mpi (policy_improvement d v) (L_pow v (policy_improvement d v) (m 0 v)) (\<lambda>a. m (Suc a)) n" + using assms policy_improvement_is_dec_det + by (induction n rule: nat.induct) (auto simp: Let_def) + +lemma + assumes "d \<in> D\<^sub>D" + shows "mpi d v m n = mpi' d v n m" + using assms +proof (induction n arbitrary: d v m rule: nat.induct) + case (Suc nat) + thus ?case + using policy_improvement_is_dec_det + by (auto simp: Let_def mpi_Suc'[OF Suc(2)] Suc.IH[symmetric]) +qed auto + +lemma termination_mpi_algo: + assumes "eps > 0" "d \<in> D\<^sub>D" "v \<le> \<L>\<^sub>b v" + shows "mpi_algo_dom (d, v, m)" +proof - + define n where "n = (LEAST n. 2 * l * dist (mpi_val d v m n) (\<L>\<^sub>b (mpi_val d v m n)) < eps * (1 - l))" (is "n = (LEAST n. ?P d v m n)") + have least0: "\<exists>n. P n \<Longrightarrow> (LEAST n. P n) = (0 :: nat) \<Longrightarrow> P 0" for P + by (metis LeastI_ex) + from n_def assms show ?thesis + proof (induction n arbitrary: v d m) + case 0 + have "2 * l * dist (mpi_val d v m 0) (\<L>\<^sub>b (mpi_val d v m 0)) < eps * (1 - l)" + using least0 mpi_val_term_ex 0 + by (metis (no_types, lifting)) + thus ?case + using 0 mpi_algo.domintros mpi_val_zero + by (metis (no_types, opaque_lifting)) + next + case (Suc n v d m) + let ?d = "policy_improvement d v" + have "Suc n = Suc (LEAST n. 2 * l * dist (mpi_val d v m (Suc n)) (\<L>\<^sub>b (mpi_val d v m (Suc n))) < eps * (1 - l))" + using mpi_val_term_ex[OF Suc.prems(3) \<open>v \<le> \<L>\<^sub>b v\<close> \<open>0 < eps\<close>, of m] Suc.prems + by (subst Nat.Least_Suc[symmetric]) (auto intro: LeastI_ex) + hence "n = (LEAST n. 2 * l * dist (mpi_val d v m (Suc n)) (\<L>\<^sub>b (mpi_val d v m (Suc n))) < eps * (1 - l))" + by auto + hence n_eq: "n = + (LEAST n. 2 * l * dist (mpi_val ?d (L_pow v ?d (m 0 v)) (\<lambda>a. m (Suc a)) n) (\<L>\<^sub>b (mpi_val ?d (L_pow v ?d (m 0 v)) (\<lambda>a. m (Suc a)) n)) + < eps * (1 - l))" + using Suc.prems mpi_Suc' + by (auto simp: is_dec_det_pi mpi_val_def) + have "\<not> 2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l)" + using Suc mpi_val_zero by force + moreover have "mpi_algo_dom (?d, L_pow v ?d (m 0 v), \<lambda>a. m (Suc a))" + using Suc.IH[OF n_eq \<open>0 < eps\<close>] Suc.prems is_dec_det_pi L_pow_\<L>\<^sub>b_mono_inv by auto + ultimately show ?case + using mpi_algo.domintros + by blast + qed +qed + +abbreviation "mpi_alg_rec d v m \<equiv> + (if 2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l) then (policy_improvement d v, v) + else mpi_algo (policy_improvement d v) (L_pow v (policy_improvement d v) (m 0 v)) + (\<lambda>n. m (Suc n)))" + +lemma mpi_algo_def': + assumes "d \<in> D\<^sub>D" "v \<le> \<L>\<^sub>b v" "eps > 0" + shows "mpi_algo d v m = mpi_alg_rec d v m" + using mpi_algo.psimps termination_mpi_algo assms + by auto + +lemma mpi_algo_eq_mpi: + assumes "d \<in> D\<^sub>D" "v \<le> \<L>\<^sub>b v" "eps > 0" + shows "mpi_algo d v m = mpi d v m (LEAST n. 2 * l * dist (mpi_val d v m n) (\<L>\<^sub>b (mpi_val d v m n)) < eps * (1 - l))" +proof - + define n where "n = (LEAST n. 2 * l * dist (mpi_val d v m n) (\<L>\<^sub>b (mpi_val d v m n)) < eps * (1 - l))" (is "n = (LEAST n. ?P d v m n)") + from n_def assms show ?thesis + proof (induction n arbitrary: d v m) + case 0 + have "?P d v m 0" + by (metis (no_types, lifting) assms(3) LeastI_ex 0 mpi_val_term_ex) + thus ?case + using assms 0 + by (auto simp: mpi_val_def mpi_algo_def') + next + case (Suc n) + hence not0: "\<not> (2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l))" + using Suc(3) mpi_val_zero + by auto + obtain n' where "2 * l * dist (mpi_val d v m n') (\<L>\<^sub>b (mpi_val d v m n')) < eps * (1 - l)" + using mpi_val_term_ex[OF Suc(3) Suc(4), of _ m] assms by blast + hence "n = (LEAST n. ?P d v m (Suc n))" + using Suc(2) Suc + by (subst (asm) Least_Suc) auto + hence "n = (LEAST n. ?P (policy_improvement d v) (L_pow v (policy_improvement d v) (m 0 v)) (\<lambda>n. m (Suc n)) n)" + using Suc(3) policy_improvement_is_dec_det mpi_Suc' + by (auto simp: mpi_val_def) + hence "mpi_algo d v m = mpi d v m (Suc n)" + unfolding mpi_algo_def'[OF Suc.prems(2-4)] + using Suc(1) Suc.prems(2-4) is_dec_det_pi mpi_Suc' not0 L_pow_\<L>\<^sub>b_mono_inv by force + thus ?case + using Suc.prems(1) by presburger + qed +qed + +lemma mpi_algo_opt: + assumes "v0 \<le> \<L>\<^sub>b v0" "eps > 0" "d \<in> D\<^sub>D" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (fst (mpi_algo d v0 m)))) \<nu>\<^sub>b_opt < eps" +proof - + let ?P = "\<lambda>n. 2 * l * dist (mpi_val d v0 m n) (\<L>\<^sub>b (mpi_val d v0 m n)) < eps * (1 - l)" + let ?n = "Least ?P" + have "mpi_algo d v0 m = mpi d v0 m ?n" and "?P ?n" + using mpi_algo_eq_mpi LeastI_ex[OF mpi_val_term_ex] assms by auto + thus ?thesis + using assms + by (auto simp: mpi_pol_opt mpi_pol_def[symmetric]) +qed + +end + + +subsection \<open>Initial Value Estimate @{term v0_mpi}\<close> +text \<open>We define an initial estimate of the value function for which Modified Policy Iteration + always terminates.\<close> + +abbreviation "r_min \<equiv> (\<Sqinter>s' a. r (s', a))" +definition "v0_mpi s = r_min / (1 - l)" + +lift_definition v0_mpi\<^sub>b :: "'s \<Rightarrow>\<^sub>b real" is "v0_mpi" + by fastforce + +lemma v0_mpi\<^sub>b_le_\<L>\<^sub>b: "v0_mpi\<^sub>b \<le> \<L>\<^sub>b v0_mpi\<^sub>b" +proof (rule less_eq_bfunI) + fix x + have "r_min \<le> r (s, a)" for s a + by (fastforce intro: cInf_lower2) + hence "r_min \<le> (1-l) * r (s, a) + l * r_min" for s a + using disc_lt_one zero_le_disc + by (meson order_less_imp_le order_refl segment_bound_lemma) + hence "r_min / (1 - l) \<le> ((1-l) * r (s, a) + l * r_min) / (1 - l)" for s a + using order_less_imp_le[OF disc_lt_one] + by (auto intro!: divide_right_mono) + hence "r_min / (1 - l) \<le> r (s, a) + (l * r_min) / (1 - l)" for s a + using disc_lt_one + by (auto simp: add_divide_distrib) + thus "v0_mpi\<^sub>b x \<le> \<L>\<^sub>b v0_mpi\<^sub>b x" + unfolding \<L>\<^sub>b_eq_SUP_L\<^sub>a v0_mpi\<^sub>b.rep_eq v0_mpi_def + by (auto simp: A_ne intro: cSUP_upper2[where x = "arb_act (A x)"]) +qed + +subsection \<open>An Instance of Modified Policy Iteration with a Valid Conservative Initial Value Estimate\<close> +definition "mpi_user eps m = ( + if eps \<le> 0 then undefined else mpi_algo eps (\<lambda>x. arb_act (A x)) v0_mpi\<^sub>b m)" + +lemma mpi_user_eq: + assumes "eps > 0" + shows "mpi_user eps = mpi_alg_rec eps (\<lambda>x. arb_act (A x)) v0_mpi\<^sub>b" + using v0_mpi\<^sub>b_le_\<L>\<^sub>b assms + by (auto simp: mpi_user_def mpi_algo_def' A_ne is_dec_det_def) + +lemma mpi_user_opt: + assumes "eps > 0" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (fst (mpi_user eps n)))) \<nu>\<^sub>b_opt < eps" + unfolding mpi_user_def using assms + by (auto intro: mpi_algo_opt simp: is_dec_det_def A_ne v0_mpi\<^sub>b_le_\<L>\<^sub>b) + +end + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/Policy_Iteration.thy b/thys/MDP-Algorithms/Policy_Iteration.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Policy_Iteration.thy @@ -0,0 +1,319 @@ +(* Author: Maximilian Schäffeler *) + +theory Policy_Iteration + imports "MDP-Rewards.MDP_reward" + +begin + +section \<open>Policy Iteration\<close> +text \<open> +The Policy Iteration algorithms provides another way to find optimal policies under the expected +total reward criterion. +It differs from Value Iteration in that it continuously improves an initial guess for an optimal +decision rule. Its execution can be subdivided into two alternating steps: policy evaluation and +policy improvement. + +Policy evaluation means the calculation of the value of the current decision rule. + +During the improvement phase, we choose the decision rule with the maximum value for L, +while we prefer to keep the old action selection in case of ties. +\<close> + + +context MDP_att_\<L> begin +definition "policy_eval d = \<nu>\<^sub>b (mk_stationary_det d)" +end + +context MDP_act +begin + +definition "policy_improvement d v s = ( + if is_arg_max (\<lambda>a. L\<^sub>a a (apply_bfun v) s) (\<lambda>a. a \<in> A s) (d s) + then d s + else arb_act (opt_acts v s))" + +definition "policy_step d = policy_improvement d (policy_eval d)" + +(* todo: move check is_dec_det outside the recursion *) +function policy_iteration :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s \<Rightarrow> 'a)" where + "policy_iteration d = ( + let d' = policy_step d in + if d = d' \<or> \<not>is_dec_det d then d else policy_iteration d')" + by auto + +text \<open> +The policy iteration algorithm as stated above does require that the supremum in @{const \<L>\<^sub>b} is +always attained. +\<close> + +text \<open> +Each policy improvement returns a valid decision rule. +\<close> +lemma is_dec_det_pi: "is_dec_det (policy_improvement d v)" + unfolding policy_improvement_def is_dec_det_def is_arg_max_def + by (auto simp: some_opt_acts_in_A) + +lemma policy_improvement_is_dec_det: "d \<in> D\<^sub>D \<Longrightarrow> policy_improvement d v \<in> D\<^sub>D" + unfolding policy_improvement_def is_dec_det_def + using some_opt_acts_in_A + by auto + +lemma policy_improvement_improving: + assumes "d \<in> D\<^sub>D" + shows "\<nu>_improving v (mk_dec_det (policy_improvement d v))" +proof - + have "\<L>\<^sub>b v x = L (mk_dec_det (policy_improvement d v)) v x" for x + using is_opt_act_some + by (fastforce simp: thm_6_2_10_a_aux' L_eq_L\<^sub>a_det is_opt_act_def policy_improvement_def + arg_max_SUP[symmetric, of _ _ "(policy_improvement d v x)"] ) + thus ?thesis + using policy_improvement_is_dec_det assms + by (auto simp: \<nu>_improving_alt) +qed + +lemma eval_policy_step_L: + assumes "is_dec_det d" + shows "L (mk_dec_det (policy_step d)) (policy_eval d) = \<L>\<^sub>b (policy_eval d)" + unfolding policy_step_def + using assms + by (auto simp: \<nu>_improving_imp_\<L>\<^sub>b[OF policy_improvement_improving]) + +text \<open> The sequence of policies generated by policy iteration has monotonically increasing +discounted reward.\<close> +lemma policy_eval_mon: + assumes "is_dec_det d" + shows "policy_eval d \<le> policy_eval (policy_step d)" +proof - + let ?d' = "mk_dec_det (policy_step d)" + let ?dp = "mk_stationary_det d" + let ?P = "\<Sum>t. l ^ t *\<^sub>R \\<^sub>1 ?d' ^^ t" + + have "L (mk_dec_det d) (policy_eval d) \<le> L ?d' (policy_eval d)" + using assms + by (auto simp: L_le_\<L>\<^sub>b eval_policy_step_L) + hence "policy_eval d \<le> L ?d' (policy_eval d)" + using L_\<nu>_fix policy_eval_def + by auto + hence "\<nu>\<^sub>b ?dp \<le> r_dec\<^sub>b ?d' + l *\<^sub>R \\<^sub>1 ?d' (\<nu>\<^sub>b ?dp)" + unfolding policy_eval_def L_def + by auto + hence "(id_blinfun - l *\<^sub>R \\<^sub>1 ?d') (\<nu>\<^sub>b ?dp) \<le> r_dec\<^sub>b ?d'" + by (simp add: blinfun.diff_left diff_le_eq scaleR_blinfun.rep_eq) + hence "?P ((id_blinfun - l *\<^sub>R \\<^sub>1 ?d') (\<nu>\<^sub>b ?dp)) \<le> ?P (r_dec\<^sub>b ?d')" + using lemma_6_1_2_b + by auto + hence "\<nu>\<^sub>b ?dp \<le> ?P (r_dec\<^sub>b ?d')" + using inv_norm_le'(2)[OF norm_\\<^sub>1_l_less] blincomp_scaleR_right suminf_cong + by (metis (mono_tags, lifting)) + thus ?thesis + unfolding policy_eval_def + by (auto simp: \<nu>_stationary) +qed + +text \<open> +If policy iteration terminates, i.e. @{term "d = policy_step d"}, then it does so with optimal value. +\<close> +lemma policy_step_eq_imp_opt: + assumes "is_dec_det d" "d = policy_step d" + shows "\<nu>\<^sub>b (mk_stationary (mk_dec_det d)) = \<nu>\<^sub>b_opt" +proof - + have "policy_eval d = \<L>\<^sub>b (policy_eval d)" + unfolding policy_eval_def + using L_\<nu>_fix assms eval_policy_step_L[unfolded policy_eval_def] + by fastforce + thus ?thesis + unfolding policy_eval_def + using \<L>_fix_imp_opt + by blast +qed + +end + +text \<open>We prove termination of policy iteration only if both the state and action sets are finite.\<close> +locale MDP_PI_finite = MDP_act A K r l arb_act + for + A and + K :: "'s ::countable \<times> 'a ::countable \<Rightarrow> 's pmf" and r l arb_act + + assumes fin_states: "finite (UNIV :: 's set)" and fin_actions: "\<And>s. finite (A s)" +begin + +text \<open>If the state and action sets are both finite, + then so is the set of deterministic decision rules @{const "D\<^sub>D"}\<close> +lemma finite_D\<^sub>D[simp]: "finite D\<^sub>D" +proof - + let ?set = "{d. \<forall>x :: 's. (x \<in> UNIV \<longrightarrow> d x \<in> (\<Union>s. A s)) \<and> (x \<notin> UNIV \<longrightarrow> d x = undefined)}" + have "finite (\<Union>s. A s)" + using fin_actions fin_states by blast + hence "finite ?set" + using fin_states + by (fastforce intro: finite_set_of_finite_funs) + moreover have "D\<^sub>D \<subseteq> ?set" + unfolding is_dec_det_def + by auto + ultimately show ?thesis + using finite_subset + by auto +qed + +lemma finite_rel: "finite {(u, v). is_dec_det u \<and> is_dec_det v \<and> \<nu>\<^sub>b (mk_stationary_det u) > + \<nu>\<^sub>b (mk_stationary_det v)}" +proof- + have aux: "finite {(u, v). is_dec_det u \<and> is_dec_det v}" + by auto + show ?thesis + by (auto intro: finite_subset[OF _ aux]) +qed + +text \<open> +This auxiliary lemma shows that policy iteration terminates if no improvement to the value of +the policy could be made, as then the policy remains unchanged. +\<close> +lemma eval_eq_imp_policy_eq: + assumes "policy_eval d = policy_eval (policy_step d)" "is_dec_det d" + shows "d = policy_step d" +proof - + have "policy_eval d s = policy_eval (policy_step d) s" for s + using assms + by auto + have "policy_eval d = L (mk_dec_det d) (policy_eval (policy_step d))" + unfolding policy_eval_def + using L_\<nu>_fix + by (auto simp: assms(1)[symmetric, unfolded policy_eval_def]) + hence "policy_eval d = \<L>\<^sub>b (policy_eval d)" + by (metis L_\<nu>_fix policy_eval_def assms eval_policy_step_L) + hence "L (mk_dec_det d) (policy_eval d) s = \<L>\<^sub>b (policy_eval d) s" for s + using \<open>policy_eval d = L (mk_dec_det d) (policy_eval (policy_step d))\<close> assms(1) by auto + hence "is_arg_max (\<lambda>a. L\<^sub>a a (\<nu>\<^sub>b (mk_stationary (mk_dec_det d))) s) (\<lambda>a. a \<in> A s) (d s)" for s + unfolding L_eq_L\<^sub>a_det + unfolding policy_eval_def \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det SUP_step_det_eq + using assms(2) is_dec_det_def L\<^sub>a_le + by (auto simp del: \<nu>\<^sub>b.rep_eq simp: \<nu>\<^sub>b.rep_eq[symmetric] + intro!: SUP_is_arg_max boundedI[of _ "r\<^sub>M + l * norm _"] bounded_imp_bdd_above) + thus ?thesis + unfolding policy_eval_def policy_step_def policy_improvement_def + by auto +qed + +text \<open> +We are now ready to prove termination in the context of finite state-action spaces. +Intuitively, the algorithm terminates as there are only finitely many decision rules, +and in each recursive call the value of the decision rule increases. +\<close> +termination policy_iteration +proof (relation "{(u, v). u \<in> D\<^sub>D \<and> v \<in> D\<^sub>D \<and> \<nu>\<^sub>b (mk_stationary_det u) > \<nu>\<^sub>b (mk_stationary_det v)}") + show "wf {(u, v). u \<in> D\<^sub>D \<and> v \<in> D\<^sub>D \<and> \<nu>\<^sub>b (mk_stationary_det v) < \<nu>\<^sub>b (mk_stationary_det u)}" + using finite_rel + by (auto intro!: finite_acyclic_wf acyclicI_order) +next + fix d x + assume h: "x = policy_step d" "\<not> (d = x \<or> \<not> is_dec_det d)" + have "is_dec_det d \<Longrightarrow> \<nu>\<^sub>b (mk_stationary_det d) \<le> \<nu>\<^sub>b (mk_stationary_det (policy_step d))" + using policy_eval_mon + by (simp add: policy_eval_def) + hence "is_dec_det d \<Longrightarrow> d \<noteq> policy_step d \<Longrightarrow> + \<nu>\<^sub>b (mk_stationary_det d) < \<nu>\<^sub>b (mk_stationary_det (policy_step d))" + using eval_eq_imp_policy_eq policy_eval_def + by (force intro!: order.not_eq_order_implies_strict) + thus "(x, d) \<in> {(u, v). u \<in> D\<^sub>D \<and> v \<in> D\<^sub>D \<and> \<nu>\<^sub>b (mk_stationary_det v) < \<nu>\<^sub>b (mk_stationary_det u)}" + using is_dec_det_pi policy_step_def h + by auto +qed + +text \<open> +The termination proof gives us access to the induction rule/simplification lemmas associated +with the @{const policy_iteration} definition. +Thus we can prove that the algorithm finds an optimal policy. +\<close> + +lemma is_dec_det_pi': "d \<in> D\<^sub>D \<Longrightarrow> is_dec_det (policy_iteration d)" + using is_dec_det_pi + by (induction d rule: policy_iteration.induct) (auto simp: Let_def policy_step_def) + +lemma pi_pi[simp]: "d \<in> D\<^sub>D \<Longrightarrow> policy_step (policy_iteration d) = policy_iteration d" + using is_dec_det_pi + by (induction d rule: policy_iteration.induct) (auto simp: policy_step_def Let_def) + +lemma policy_iteration_correct: + "d \<in> D\<^sub>D \<Longrightarrow> \<nu>\<^sub>b (mk_stationary_det (policy_iteration d)) = \<nu>\<^sub>b_opt" + by (induction d rule: policy_iteration.induct) + (fastforce intro!: policy_step_eq_imp_opt is_dec_det_pi' simp del: policy_iteration.simps) +end + +context MDP_finite_type begin +text \<open> +The following proofs concern code generation, i.e. how to represent @{const \\<^sub>1} as a matrix. +\<close> + +sublocale MDP_att_\<L> + by (auto simp: A_ne finite_is_arg_max MDP_att_\<L>_def MDP_att_\<L>_axioms_def max_L_ex_def + has_arg_max_def MDP_reward_axioms) + +definition "fun_to_matrix f = matrix (\<lambda>v. (\<chi> j. f (vec_nth v) j))" +definition "Ek_mat d = fun_to_matrix (\<lambda>v. ((\\<^sub>1 d) (Bfun v)))" +definition "nu_inv_mat d = fun_to_matrix ((\<lambda>v. ((id_blinfun - l *\<^sub>R \\<^sub>1 d) (Bfun v))))" +definition "nu_mat d = fun_to_matrix (\<lambda>v. ((\<Sum>i. (l *\<^sub>R \\<^sub>1 d) ^^ i) (Bfun v)))" + +lemma apply_nu_inv_mat: + "(id_blinfun - l *\<^sub>R \\<^sub>1 d) v = Bfun (\<lambda>i. ((nu_inv_mat d) *v (vec_lambda v)) $ i)" +proof - + have eq_onpI: "P x \<Longrightarrow> eq_onp P x x" for P x + by(simp add: eq_onp_def) + + have "Real_Vector_Spaces.linear (\<lambda>v. vec_lambda (((id_blinfun - l *\<^sub>R \\<^sub>1 d) (bfun.Bfun (($) v)))))" + by (auto simp del: real_scaleR_def intro: linearI + simp: scaleR_vec_def eq_onpI plus_vec_def vec_lambda_inverse plus_bfun.abs_eq[symmetric] + scaleR_bfun.abs_eq[symmetric] blinfun.scaleR_right blinfun.add_right) + thus ?thesis + unfolding Ek_mat_def fun_to_matrix_def nu_inv_mat_def + by (auto simp: apply_bfun_inverse vec_lambda_inverse) +qed + +lemma bounded_linear_vec_lambda: "bounded_linear (\<lambda>x. vec_lambda (x :: 's \<Rightarrow>\<^sub>b real))" +proof (intro bounded_linear_intro) + fix x :: "'s \<Rightarrow>\<^sub>b real" + have "sqrt (\<Sum> i \<in> UNIV . (apply_bfun x i)\<^sup>2) \<le> (\<Sum> i \<in> UNIV . \<bar>(apply_bfun x i)\<bar>)" + using L2_set_le_sum_abs + unfolding L2_set_def + by auto + also have "(\<Sum> i \<in> UNIV . \<bar>(apply_bfun x i)\<bar>) \<le> (card (UNIV :: 's set) * (\<Squnion>xa. \<bar>apply_bfun x xa\<bar>))" + by (auto intro!: cSup_upper sum_bounded_above) + finally show "norm (vec_lambda (apply_bfun x)) \<le> norm x * CARD('s)" + unfolding norm_vec_def norm_bfun_def dist_bfun_def L2_set_def + by (auto simp add: mult.commute) +qed (auto simp: plus_vec_def scaleR_vec_def) + + +lemma bounded_linear_vec_lambda_blinfun: + fixes f :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('s \<Rightarrow>\<^sub>b real)" + shows "bounded_linear (\<lambda>v. vec_lambda (apply_bfun (blinfun_apply f (bfun.Bfun (($) v)))))" + using blinfun.bounded_linear_right + by (fastforce intro: bounded_linear_compose[OF bounded_linear_vec_lambda] + bounded_linear_bfun_nth bounded_linear_compose[of f]) + +lemma invertible_nu_inv_max: "invertible (nu_inv_mat d)" + unfolding nu_inv_mat_def fun_to_matrix_def + by (auto simp: matrix_invertible inv_norm_le' vec_lambda_inverse apply_bfun_inverse + bounded_linear.linear[OF bounded_linear_vec_lambda_blinfun] + intro!: exI[of _ "\<lambda>v. (\<chi> j. (\<lambda>v. (\<Sum>i. (l *\<^sub>R \\<^sub>1 d) ^^ i) (Bfun v)) (vec_nth v) j)"]) + +end + +definition "least_arg_max f P = (LEAST x. is_arg_max f P x)" + +locale MDP_ord = MDP_finite_type A K r l + for A and + K :: "'s :: {finite, wellorder} \<times> 'a :: {finite, wellorder} \<Rightarrow> 's pmf" + and r l +begin + +lemma \<L>_fin_eq_det: "\<L> v s = (\<Squnion>a \<in> A s. L\<^sub>a a v s)" + by (simp add: SUP_step_det_eq \<L>_eq_SUP_det) + +lemma \<L>\<^sub>b_fin_eq_det: "\<L>\<^sub>b v s = (\<Squnion>a \<in> A s. L\<^sub>a a v s)" + by (simp add: SUP_step_det_eq \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det) + +sublocale MDP_PI_finite A K r l "\<lambda>X. Least (\<lambda>x. x \<in> X)" + by unfold_locales (auto intro: LeastI) + +end +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/ROOT b/thys/MDP-Algorithms/ROOT new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/ROOT @@ -0,0 +1,15 @@ +chapter AFP +session "MDP-Algorithms" (AFP) = "MDP-Rewards" + + options [timeout = 600] + sessions + Gauss_Jordan + directories + code + examples + theories + Algorithms + Code_Mod + Examples + document_files + "root.bib" + "root.tex" diff --git a/thys/MDP-Algorithms/Splitting_Methods.thy b/thys/MDP-Algorithms/Splitting_Methods.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Splitting_Methods.thy @@ -0,0 +1,2046 @@ +(* Author: Maximilian Schäffeler *) + +theory Splitting_Methods + imports + Blinfun_Matrix + Value_Iteration + Policy_Iteration +begin + +section \<open>Value Iteration using Splitting Methods\<close> + +subsection \<open>Regular Splittings for Matrices and Bounded Linear Functions\<close> + +definition "is_splitting_mat X Q R \<longleftrightarrow> + X = Q - R \<and> invertible Q \<and> 0 \<le> matrix_inv Q \<and> 0 \<le> R" + +definition "is_splitting_blin X Q R \<longleftrightarrow> is_splitting_mat (blinfun_to_matrix X) (blinfun_to_matrix Q) (blinfun_to_matrix R)" + +lemma is_splitting_blin_def': "is_splitting_blin X Q R \<longleftrightarrow> + X = Q - R \<and> invertible\<^sub>L Q \<and> nonneg_blinfun (inv\<^sub>L Q) \<and> nonneg_blinfun R" +proof - + have "blinfun_to_matrix X = blinfun_to_matrix Q - blinfun_to_matrix R \<longleftrightarrow> X = Q - R" + using blinfun_to_matrix_diff matrix_to_blinfun_inv + by metis + thus ?thesis + unfolding is_splitting_blin_def is_splitting_mat_def + using blinfun_to_matrix_inverse[of Q] matrix_to_blinfun_inv + by (fastforce simp: invertible_invertible\<^sub>L_I(1)) +qed + +lemma is_splitting_blinD[dest]: + assumes "is_splitting_blin X Q R" + shows "X = Q - R" "invertible\<^sub>L Q" "nonneg_blinfun (inv\<^sub>L Q)" "nonneg_blinfun R" + using is_splitting_blin_def' assms by auto + +subsection \<open>Splitting Methods for MDPs\<close> + +locale MDP_QR = MDP_finite_type A K r l + for A :: "'s :: finite \<Rightarrow> ('a :: finite) set" + and K :: "('s \<times> 'a) \<Rightarrow> 's pmf" + and r l + + fixes Q :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('s \<Rightarrow>\<^sub>b real)" + fixes R :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('s \<Rightarrow>\<^sub>b real)" + assumes is_splitting: "\<And>d. d \<in> D\<^sub>D \<Longrightarrow> is_splitting_blin (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d)) (Q d) (R d)" + assumes QR_contraction: "(\<Squnion>d\<in>D\<^sub>D. norm (inv\<^sub>L (Q d) o\<^sub>L R d)) < 1" + assumes arg_max_ex_split: "\<exists>d. \<forall>s. is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s) (\<lambda>d. d \<in> D\<^sub>D) d" +begin + +lemma inv_Q_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (inv\<^sub>L (Q d)) u \<le> (inv\<^sub>L (Q d)) v" + using is_splitting + by (auto intro!: nonneg_blinfun_mono) + +lemma splitting_eq: "d \<in> D\<^sub>D \<Longrightarrow> Q d - R d = (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d))" + using is_splitting + by fastforce + +lemma Q_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> inv\<^sub>L (Q d) v" + using is_splitting nonneg_blinfun_nonneg + by auto + +lemma Q_invertible: "d \<in> D\<^sub>D \<Longrightarrow> invertible\<^sub>L (Q d)" + using is_splitting + by auto + +lemma R_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> R d v" + using is_splitting_blinD[OF is_splitting] + by (fastforce simp: nonneg_blinfun_nonneg intro: nonneg_blinfun_mono) + +lemma R_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (R d) u \<le> (R d) v" + using R_nonneg[of d "v - u"] + by (auto simp: blinfun.bilinear_simps) + +lemma QR_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) v" + by (simp add: Q_nonneg R_nonneg) + +lemma QR_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (inv\<^sub>L (Q d) o\<^sub>L R d) u \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) v" + using QR_nonneg[of d "v - u"] + by (auto simp: blinfun.bilinear_simps) + +lemma norm_QR_less_one: "d \<in> D\<^sub>D \<Longrightarrow> norm (inv\<^sub>L (Q d) o\<^sub>L R d) < 1" + using QR_contraction + by (auto intro!: cSUP_lessD[of "\<lambda>d. norm (inv\<^sub>L (Q d) o\<^sub>L R d)"]) + +lemma splitting: "d \<in> D\<^sub>D \<Longrightarrow> id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d) = Q d - R d" + using is_splitting + by auto + +subsection \<open>Discount Factor @{term "QR_disc"}\<close> +abbreviation "QR_disc \<equiv> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d) o\<^sub>L R d))" + +lemma QR_le_QR_disc: "d \<in> D\<^sub>D \<Longrightarrow> norm (inv\<^sub>L (Q d) o\<^sub>L (R d)) \<le> QR_disc" + by (auto intro: cSUP_upper) + +lemma a_nonneg: "0 \<le> QR_disc" + using QR_contraction norm_ge_zero ex_dec_det + by (fastforce intro!: cSUP_upper2) + +subsection \<open>Bellman-Operator\<close> +abbreviation "L_split d v \<equiv> inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v)" + +definition "\<L>_split v s = (\<Squnion>d \<in> D\<^sub>D. L_split d v s)" + +lemma \<L>_split_bfun_aux: + assumes "d \<in> D\<^sub>D" + shows "norm (L_split d v) \<le> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d))) * r\<^sub>M + norm v" +proof - + have "norm (L_split d v) \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm (inv\<^sub>L (Q d) (R d v))" + by (simp add: blinfun.add_right norm_triangle_ineq) + also have "\<dots> \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm (inv\<^sub>L (Q d) o\<^sub>L R d) * norm v" + by (auto simp: blinfun_apply_blinfun_compose[symmetric] norm_blinfun simp del: blinfun_apply_blinfun_compose) + also have "\<dots> \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm v" + using norm_QR_less_one assms + by (fastforce intro!: mult_left_le_one_le) + also have "\<dots> \<le> norm (inv\<^sub>L (Q d)) * r\<^sub>M + norm v" + by (auto intro!: order.trans[OF norm_blinfun] mult_left_mono simp: norm_r_dec_le) + also have "\<dots> \<le> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d))) * r\<^sub>M + norm v" + by (auto intro!: mult_right_mono cSUP_upper assms simp: r\<^sub>M_nonneg) + finally show ?thesis. +qed + +lift_definition \<L>\<^sub>b_split :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" is \<L>_split + by fastforce + +lemma \<L>\<^sub>b_split_def': "\<L>\<^sub>b_split v s = (\<Squnion>d\<in>D\<^sub>D. L_split d v s)" + unfolding \<L>\<^sub>b_split.rep_eq \<L>_split_def + by auto + +lemma \<L>\<^sub>b_split_contraction: "dist (\<L>\<^sub>b_split v) (\<L>\<^sub>b_split u) \<le> QR_disc * dist v u" +proof - + have aux: + "\<L>\<^sub>b_split v s - \<L>\<^sub>b_split u s \<le> QR_disc * norm (v - u)" if h: "\<L>\<^sub>b_split u s \<le> \<L>\<^sub>b_split v s" for u v s + proof - + obtain d where d: "is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s) (\<lambda>d. d \<in> D\<^sub>D) d" + using finite_is_arg_max[of "D\<^sub>D"] + by auto + have *: "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d u) s \<le> \<L>\<^sub>b_split u s" + using d + by (auto simp: \<L>\<^sub>b_split_def' is_arg_max_linorder intro!: cSUP_upper2) + have "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s = \<L>\<^sub>b_split v s" + by (auto simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF d]) + hence "\<L>\<^sub>b_split v s - \<L>\<^sub>b_split u s = inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s - \<L>\<^sub>b_split u s" + by auto + also have "\<dots> \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) (v - u) s" + using * + by (auto simp: blinfun.bilinear_simps) + also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L R d)) * norm (v - u)" + by (fastforce intro: order.trans[OF le_norm_bfun norm_blinfun]) + also have "\<dots> \<le> QR_disc * norm (v - u)" + using QR_contraction d + by (auto simp: is_arg_max_linorder intro!: mult_right_mono cSUP_upper2) + finally show ?thesis. + qed + have "\<bar>(\<L>\<^sub>b_split v - \<L>\<^sub>b_split u) s\<bar> \<le> QR_disc * dist v u" for s + using aux + by (cases "\<L>\<^sub>b_split v s \<le> \<L>\<^sub>b_split u s") (fastforce simp: dist_norm norm_minus_commute)+ + thus ?thesis + by (auto intro!: cSUP_least simp: dist_bfun.rep_eq dist_real_def) +qed + +lemma \<L>\<^sub>b_lim: + "\<exists>!v. \<L>\<^sub>b_split v = v" + "(\<lambda>n. (\<L>\<^sub>b_split ^^ n) v) \<longlonglongrightarrow> (THE v. \<L>\<^sub>b_split v = v)" + using banach'[of \<L>\<^sub>b_split] a_nonneg QR_contraction \<L>\<^sub>b_split_contraction + unfolding is_contraction_def + by auto + +lemma \<L>\<^sub>b_split_tendsto_opt: "(\<lambda>n. (\<L>\<^sub>b_split ^^ n) v) \<longlonglongrightarrow> \<nu>\<^sub>b_opt" +proof - + obtain L where l_fix: "\<L>\<^sub>b_split L = L" + using \<L>\<^sub>b_lim(1) + by auto + have "\<nu>\<^sub>b (mk_stationary_det d) \<le> L" if d: "d \<in> D\<^sub>D" for d + proof - + let ?QR = "inv\<^sub>L (Q d) o\<^sub>L R d" + have "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) \<le> \<L>\<^sub>b_split L" + using d l_fix + by (fastforce simp: \<L>\<^sub>b_split_def' intro!: cSUP_upper2) + hence "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) \<le> L" + using l_fix by auto + hence aux: "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d)) \<le> (id_blinfun - ?QR) L" + using that + by (auto simp: blinfun.bilinear_simps le_diff_eq) + have inv_eq: "inv\<^sub>L (id_blinfun - ?QR) = (\<Sum>i. ?QR ^^ i)" + using QR_contraction d norm_QR_less_one + by (auto intro!: inv\<^sub>L_inf_sum) + have summable_QR:"summable (\<lambda>i. norm (?QR ^^ i))" + using QR_contraction d + by (fastforce simp: a_nonneg + intro: summable_comparison_test'[where g = "\<lambda>i. QR_disc^i"] + intro!: cSUP_upper2 power_mono order.trans[OF norm_blinfunpow_le]) + have "summable (\<lambda>i. (?QR ^^ i) v s)" for v s + by (rule summable_comparison_test'[where g = "\<lambda>i. norm (?QR ^^ i) * norm v"]) + (auto intro!: summable_QR summable_norm_cancel order.trans[OF abs_le_norm_bfun] order.trans[OF norm_blinfun] summable_mult2) + moreover have "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i<n. (?QR ^^ i) v s)" for n v s + using blinfunpow_nonneg[OF QR_nonneg[OF d]] + by (induction n) (auto simp add: less_eq_bfun_def) + ultimately have "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i. ((?QR ^^ i) v s)) " for v s + by (auto intro!: summable_LIMSEQ LIMSEQ_le) + hence "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i. ((?QR ^^ i))) v s" for v s + using bounded_linear_apply_bfun summable_QR summable_comparison_test' + by (subst bounded_linear.suminf[where f = "(\<lambda>i. apply_bfun (blinfun_apply i v) s)"]) + (fastforce intro: bounded_linear_compose[of "\<lambda>s. apply_bfun s _"])+ + hence "0 \<le> v \<Longrightarrow> 0 \<le> inv\<^sub>L (id_blinfun - ?QR) v" for v + by (simp add: inv_eq less_eq_bfun_def) + hence "(inv\<^sub>L (id_blinfun - ?QR)) ((inv\<^sub>L (Q d)) (r_dec\<^sub>b (mk_dec_det d))) + \<le> (inv\<^sub>L (id_blinfun - ?QR)) ((id_blinfun - ?QR) L)" + by (metis aux blinfun.diff_right diff_ge_0_iff_ge) + hence "(inv\<^sub>L (id_blinfun - ?QR) o\<^sub>L inv\<^sub>L (Q d)) (r_dec\<^sub>b (mk_dec_det d)) \<le> L" + using invertible\<^sub>L_inf_sum[OF norm_QR_less_one[OF that]] + by auto + hence "(inv\<^sub>L (Q d o\<^sub>L (id_blinfun - ?QR))) (r_dec\<^sub>b (mk_dec_det d)) \<le> L" + using d norm_QR_less_one + by (auto simp: inv\<^sub>L_compose[OF Q_invertible invertible\<^sub>L_inf_sum]) + hence "(inv\<^sub>L (Q d - R d)) (r_dec\<^sub>b (mk_dec_det d)) \<le> L" + using Q_invertible d + by (auto simp: blinfun_compose_diff_right blinfun_compose_assoc[symmetric]) + thus "\<nu>\<^sub>b (mk_stationary_det d) \<le> L" + by (auto simp: \<nu>_stationary splitting[OF that, symmetric] inv\<^sub>L_inf_sum blincomp_scaleR_right) + qed + hence opt_le: "\<nu>\<^sub>b_opt \<le> L" + using thm_6_2_10 finite by auto + + obtain d where d: "is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) s) (\<lambda>d. d \<in> D\<^sub>D) d" for s + using arg_max_ex_split by blast + hence "d \<in> D\<^sub>D" + unfolding is_arg_max_linorder + by auto + have "L = inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L)" + by (subst l_fix[symmetric]) (fastforce simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF d]) + hence "Q d L = r_dec\<^sub>b (mk_dec_det d) + R d L" + by (metis Q_invertible \<open>d \<in> D\<^sub>D\<close> inv_app2') + hence "(id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d)) L = r_dec\<^sub>b (mk_dec_det d)" + using splitting[OF \<open>d \<in> D\<^sub>D\<close>] + by (simp add: blinfun.diff_left) + hence "L = inv\<^sub>L ((id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d))) (r_dec\<^sub>b (mk_dec_det d))" + using invertible\<^sub>L_inf_sum[OF norm_\\<^sub>1_l_less] inv_app1' + by metis + hence "L = \<nu>\<^sub>b (mk_stationary_det d)" + by (auto simp: inv\<^sub>L_inf_sum \<nu>_stationary blincomp_scaleR_right) + hence "\<nu>\<^sub>b_opt = L" + using opt_le \<open>d \<in> D\<^sub>D\<close> is_markovian_def + by (auto intro: order.antisym[OF _ \<nu>\<^sub>b_le_opt]) + thus ?thesis + using \<L>\<^sub>b_lim l_fix the1_equality[OF \<L>\<^sub>b_lim(1)] + by auto +qed + +lemma \<L>\<^sub>b_split_fix[simp]: "\<L>\<^sub>b_split \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_lim \<L>\<^sub>b_split_tendsto_opt the_equality limI + by (metis (mono_tags, lifting)) + +lemma dist_\<L>\<^sub>b_split_opt_eps: + assumes "eps > 0" "2 * QR_disc * dist v (\<L>\<^sub>b_split v) < eps * (1-QR_disc)" + shows "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2" +proof - + have "(1 - QR_disc) * dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b_split v)" + using dist_triangle \<L>\<^sub>b_split_contraction[of v "\<nu>\<^sub>b_opt"] + by (fastforce simp: algebra_simps intro: order.trans[OF _ add_left_mono[of "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt"]]) + hence "dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b_split v) / (1 - QR_disc)" + using QR_contraction + by (simp add: mult.commute pos_le_divide_eq) + hence "2 * QR_disc * dist v \<nu>\<^sub>b_opt \<le> 2 * QR_disc * (dist v (\<L>\<^sub>b_split v) / (1 - QR_disc))" + using \<L>\<^sub>b_split_contraction assms mult_le_cancel_left_pos[of "2 * QR_disc"] a_nonneg + by (fastforce intro!: mult_left_mono[of _ _ "2 * QR_disc"]) + hence "2 * QR_disc * dist v \<nu>\<^sub>b_opt < eps" + using a_nonneg QR_contraction + by (auto simp: assms(2) pos_divide_less_eq intro: order.strict_trans1) + hence "dist v \<nu>\<^sub>b_opt * QR_disc < eps / 2" + by argo + thus "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2" + using \<L>\<^sub>b_split_contraction[of v \<nu>\<^sub>b_opt] + by (auto simp: algebra_simps) +qed + +lemma L_split_fix: + assumes "d \<in> D\<^sub>D" + shows "L_split d (\<nu>\<^sub>b (mk_stationary_det d)) = \<nu>\<^sub>b (mk_stationary_det d)" +proof - + let ?d = "mk_dec_det d" + let ?p = "mk_stationary_det d" + have "(Q d - R d) (\<nu>\<^sub>b ?p) = r_dec\<^sub>b ?d" + using L_\<nu>_fix[of "mk_dec_det d"] + by (simp add: L_def splitting[OF assms, symmetric] blinfun.bilinear_simps diff_eq_eq) + thus ?thesis + using assms + by (auto simp: blinfun.bilinear_simps diff_eq_eq inv\<^sub>L_cancel_iff[OF Q_invertible]) +qed + +lemma L_split_contraction: + assumes "d \<in> D\<^sub>D" + shows "dist (L_split d v) (L_split d u) \<le> QR_disc * dist v u" +proof - + have aux: "L_split d v s - L_split d u s \<le> QR_disc * dist v u" if lea: "(L_split d u s) \<le> (L_split d v s)" for v s u + proof - + have "L_split d v s - L_split d u s = (inv\<^sub>L (Q d) o\<^sub>L (R d)) (v - u) s" + by (auto simp: blinfun.bilinear_simps) + also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L (R d)) (v - u))" + by (simp add: le_norm_bfun) + also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L (R d))) * dist v u" + by (auto simp only: dist_norm norm_blinfun) + also have "\<dots> \<le> QR_disc * dist v u" + using assms QR_le_QR_disc + by (auto intro!: mult_right_mono) + finally show ?thesis + by auto + qed + have "dist (L_split d v s) (L_split d u s) \<le> QR_disc * dist v u" for v s u + using aux aux[of v _ u] + by (cases "L_split d v s \<ge> L_split d u s") (auto simp: dist_real_def dist_commute) + thus "dist (L_split d v) (L_split d u) \<le> QR_disc * dist v u" + by (simp add: dist_bound) +qed + +lemma find_policy_QR_error_bound: + assumes "eps > 0" "2 * QR_disc * dist v (\<L>\<^sub>b_split v) < eps * (1-QR_disc)" + assumes am: "\<And>s. is_arg_max (\<lambda>d. L_split d (\<L>\<^sub>b_split v) s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "dist (\<nu>\<^sub>b (mk_stationary_det d)) \<nu>\<^sub>b_opt < eps" +proof - + let ?p = "mk_stationary_det d" + have L_eq_\<L>\<^sub>b: "L_split d (\<L>\<^sub>b_split v) = \<L>\<^sub>b_split (\<L>\<^sub>b_split v)" + by (auto simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF am]) + have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) = dist (L_split d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b_split v)" + using am + by (auto simp: is_arg_max_linorder L_split_fix) + also have "\<dots> \<le> dist (L_split d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) + dist (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) (\<L>\<^sub>b_split v)" + by (auto intro: dist_triangle) + also have "\<dots> = dist (L_split d (\<nu>\<^sub>b ?p)) (L_split d (\<L>\<^sub>b_split v)) + dist (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) (\<L>\<^sub>b_split v)" + by (auto simp: L_eq_\<L>\<^sub>b) + also have "\<dots> \<le> QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) + QR_disc * dist (\<L>\<^sub>b_split v) v" + using \<L>\<^sub>b_split_contraction L_split_contraction am unfolding is_arg_max_def + by (auto intro!: add_mono) + finally have aux: "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) + QR_disc * dist (\<L>\<^sub>b_split v) v" . + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) - QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> QR_disc * dist (\<L>\<^sub>b_split v) v" + by auto + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1 - QR_disc) \<le> QR_disc * dist (\<L>\<^sub>b_split v) v" + by argo + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1-QR_disc) \<le> 2 * (QR_disc * dist (\<L>\<^sub>b_split v) v)" + using mult_left_mono + by auto + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1 - QR_disc) \<le> eps * (1 - QR_disc)" + using assms + by (auto intro!: mult_left_mono simp: dist_commute pos_divide_le_eq) + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> eps" + using QR_contraction mult_right_le_imp_le + by auto + moreover have "2 * dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps" + using dist_\<L>\<^sub>b_split_opt_eps assms + by fastforce + ultimately show ?thesis + using dist_triangle[of "\<nu>\<^sub>b ?p" \<nu>\<^sub>b_opt "\<L>\<^sub>b_split v"] + by auto +qed +end + +context MDP_ord begin +lemma inv_one_sub_Q': + fixes Q :: "'c :: banach \<Rightarrow>\<^sub>L 'c" + assumes onorm_le: "norm (id_blinfun - Q) < 1" + shows "inv\<^sub>L Q = (\<Sum>i. (id_blinfun - Q)^^i)" + by (metis inv\<^sub>L_I inv_one_sub_Q assms) + +text \<open>An important theorem: allows to compare the rate of convergence for different splittings\<close> +lemma norm_splitting_le: + assumes "is_splitting_blin (id_blinfun - l *\<^sub>R \\<^sub>1 d) Q1 R1" + and "is_splitting_blin (id_blinfun - l *\<^sub>R \\<^sub>1 d) Q2 R2" + and "(blinfun_to_matrix R2) \<le> (blinfun_to_matrix R1)" + and "(blinfun_to_matrix R1) \<le> (blinfun_to_matrix (l *\<^sub>R \\<^sub>1 d))" + shows "norm (inv\<^sub>L Q2 o\<^sub>L R2) \<le> norm (inv\<^sub>L Q1 o\<^sub>L R1)" +proof - + let ?R1 = "blinfun_to_matrix R1" + let ?R2 = "blinfun_to_matrix R2" + let ?Q1 = "blinfun_to_matrix Q1" + let ?Q2 = "blinfun_to_matrix Q2" + have + inv_Q: "inv\<^sub>L Q = (\<Sum>i. (id_blinfun - Q)^^i)" "norm (id_blinfun - Q) < 1" and + splitting_eq: "id_blinfun - Q = l *\<^sub>R \\<^sub>1 d - R" and + nonneg_Q: "0 \<le> blinfun_to_matrix (id_blinfun - Q)" + if "(blinfun_to_matrix R) \<le> (blinfun_to_matrix (l *\<^sub>R \\<^sub>1 d))" + and "is_splitting_blin (id_blinfun - l *\<^sub>R \\<^sub>1 d) Q R" for Q R + proof - + let ?R = "blinfun_to_matrix R" + show splitting_eq: "id_blinfun - Q = l *\<^sub>R \\<^sub>1 d - R" + using that + by (auto simp: eq_diff_eq is_splitting_blin_def') + have R_nonneg: "0 \<le> ?R" + using that + by blast + show nonneg_Q: "0 \<le> blinfun_to_matrix (id_blinfun - Q)" + using that + by (auto simp: splitting_eq blinfun_to_matrix_diff) + moreover have "(blinfun_to_matrix (id_blinfun - Q)) \<le> (blinfun_to_matrix (l *\<^sub>R \\<^sub>1 d))" + using R_nonneg + by (auto simp: splitting_eq blinfun_to_matrix_diff) + ultimately have "norm (id_blinfun - Q) \<le> norm (l *\<^sub>R \\<^sub>1 d)" + using matrix_le_norm_mono by blast + thus "norm (id_blinfun - Q) < 1" + using norm_\\<^sub>1_l_less + by (simp add: order.strict_trans1) + thus "inv\<^sub>L Q = (\<Sum>i. (id_blinfun - Q) ^^ i)" + using inv_one_sub_Q' + by auto + qed + + have i1: "inv\<^sub>L Q1 = (\<Sum>i. (id_blinfun - Q1) ^^ i)" "norm (id_blinfun - Q1) < 1" + and i2: "inv\<^sub>L Q2 = (\<Sum>i. (id_blinfun - Q2) ^^ i)" "norm (id_blinfun - Q2) < 1" + using assms + by (auto intro: inv_Q[of R2 Q2] inv_Q[of R1 Q1]) + + have Q1_le_Q2: "blinfun_to_matrix (id_blinfun - Q1) \<le> blinfun_to_matrix (id_blinfun - Q2)" + using assms unfolding is_splitting_blin_def' + by (auto simp: blinfun_to_matrix_diff eq_diff_eq blinfun_to_matrix_add) + + have "blinfun_to_matrix (inv\<^sub>L Q1) = blinfun_to_matrix ((\<Sum>i. (id_blinfun - Q1) ^^ i))" + using i1 by auto + also have "\<dots> = ((\<Sum>i. blinfun_to_matrix ((id_blinfun - Q1) ^^ i)))" + using bounded_linear.suminf[OF bounded_linear_blinfun_to_matrix] summable_inv_Q i1(2) + by auto + also have "\<dots> \<le> (\<Sum>i. blinfun_to_matrix ((id_blinfun - Q2) ^^ i))" + proof - + have le_n: "\<And>n. 0 \<le> n \<Longrightarrow> (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q1) ^^ i)) \<le> (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q2) ^^ i))" + using assms nonneg_Q + by (auto intro!: sum_mono matpow_mono simp: blinfun_to_matrix_matpow Q1_le_Q2) + hence le_n_elem: "\<And>n. 0 \<le> n \<Longrightarrow> (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q1) ^^ i)) $ i $ j \<le> (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q2) ^^ i)) $ i $ j " for i j + by (auto simp: less_eq_vec_def) + have "(\<lambda>n. (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q1) ^^ i))) \<longlonglongrightarrow> (\<Sum>i. blinfun_to_matrix ((id_blinfun - Q1) ^^ i))" + by (auto intro!: bounded_linear.summable[of blinfun_to_matrix] summable_LIMSEQ simp add: bounded_linear_blinfun_to_matrix i1(2) summable_inv_Q) + hence le1: "(\<lambda>n. (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q1) ^^ i)) $ j $ k) \<longlonglongrightarrow> (\<Sum>i. blinfun_to_matrix ((id_blinfun - Q1) ^^ i)) $ j $ k" for j k + using tendsto_vec_nth + by metis + have "(\<lambda>n. (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q2) ^^ i))) \<longlonglongrightarrow> (\<Sum>i. blinfun_to_matrix ((id_blinfun - Q2) ^^ i))" + by (auto intro!: bounded_linear.summable[of blinfun_to_matrix] summable_LIMSEQ simp add: bounded_linear_blinfun_to_matrix i2(2) summable_inv_Q) + hence le2: "(\<lambda>n. (\<Sum>i<n. blinfun_to_matrix ((id_blinfun - Q2) ^^ i)) $ j $ k) \<longlonglongrightarrow> (\<Sum>i. blinfun_to_matrix ((id_blinfun - Q2) ^^ i)) $ j $ k" for j k + using tendsto_vec_nth + by metis + have "((\<Sum>i. blinfun_to_matrix ((id_blinfun - Q1) ^^ i))$ j $ k) \<le> ((\<Sum>i. blinfun_to_matrix ((id_blinfun - Q2) ^^ i)) $ j $ k)" for j k + by (fastforce intro: Topological_Spaces.lim_mono[OF le_n_elem le1 le2]) + thus ?thesis + by (simp add: less_eq_vec_def) + qed + also have "\<dots> = blinfun_to_matrix (inv\<^sub>L Q2)" + using summable_inv_Q i2(2) i2 + by (auto intro!: bounded_linear.suminf[OF bounded_linear_blinfun_to_matrix, symmetric]) + finally have Q1_le_Q2: "blinfun_to_matrix (inv\<^sub>L Q1) \<le> blinfun_to_matrix (inv\<^sub>L Q2)" . + + have *: "0 \<le> blinfun_to_matrix ((inv\<^sub>L Q1) o\<^sub>L R1)" "0 \<le> blinfun_to_matrix ((inv\<^sub>L Q2) o\<^sub>L R2)" + using assms is_splitting_blin_def' + by (auto simp: blinfun_to_matrix_comp intro: nonneg_matrix_mult) + + have "0 \<le> (id_blinfun - l *\<^sub>R \\<^sub>1 d) 1" + using less_imp_le[OF disc_lt_one] + by (auto simp: blinfun.diff_left less_eq_bfun_def blinfun.scaleR_left) + hence "(inv\<^sub>L Q1) ((id_blinfun - l *\<^sub>R \\<^sub>1 d) 1) \<le> (inv\<^sub>L Q2) ((id_blinfun - l *\<^sub>R \\<^sub>1 d) 1)" + by (metis Q1_le_Q2 blinfun.diff_left blinfun_to_matrix_diff diff_ge_0_iff_ge nonneg_blinfun_nonneg) + hence "(inv\<^sub>L Q1) ((Q1 - R1) 1) \<le> (inv\<^sub>L Q2) ((Q2 - R2) 1)" + by (metis (no_types, opaque_lifting) assms(1) assms(2) is_splitting_blin_def') + hence "(inv\<^sub>L Q1 o\<^sub>L Q1) 1 - (inv\<^sub>L Q1 o\<^sub>L R1) 1 \<le> (inv\<^sub>L Q2 o\<^sub>L Q2) 1 - (inv\<^sub>L Q2 o\<^sub>L R2) 1" + by (auto simp: blinfun.add_left blinfun.diff_right blinfun.diff_left) + hence "(inv\<^sub>L Q2 o\<^sub>L R2) 1 \<le> (inv\<^sub>L Q1 o\<^sub>L R1) 1" + using assms + unfolding is_splitting_blin_def' + by auto + moreover have "0 \<le> (inv\<^sub>L Q2 o\<^sub>L R2) 1" + using * + by (fastforce simp: less_eq_bfunI intro!: nonneg_blinfun_nonneg) + ultimately have "norm ((inv\<^sub>L Q2 o\<^sub>L R2) 1) \<le> norm ((inv\<^sub>L Q1 o\<^sub>L R1) 1)" + by (auto simp: less_eq_bfun_def norm_bfun_def' intro!: abs_ge_self cSUP_mono intro: order.trans) + thus "norm ((inv\<^sub>L Q2 o\<^sub>L R2)) \<le> norm ((inv\<^sub>L Q1 o\<^sub>L R1))" + by (auto simp: norm_nonneg_blinfun_one *) +qed + +subsection \<open>Gauss Seidel Splitting\<close> +subsubsection \<open>Definition of Upper and Lower Triangular Matrices\<close> +definition "P_dec d \<equiv> blinfun_to_matrix (\\<^sub>1 (mk_dec_det d))" +definition "P_upper d \<equiv> (\<chi> i j. if i \<le> j then P_dec d $ i $ j else 0)" +definition "P_lower d \<equiv> (\<chi> i j. if j \<^sub>U d = matrix_to_blinfun (P_upper d)" +definition "\\<^sub>L d = matrix_to_blinfun (P_lower d)" + +lemma P_dec_elem: "P_dec d $ i $ j = pmf (K (i, d i)) j" + unfolding blinfun_to_matrix_def matrix_def \\<^sub>1.rep_eq K_st_def P_dec_def push_exp.rep_eq vec_lambda_beta + by (subst pmf_expectation_bind[of "{d i}"]) + (auto split: if_splits simp: mk_dec_det_def axis_def vec_lambda_inverse integral_measure_pmf[of "{j}"]) + +lemma nonneg_\\<^sub>U: "nonneg_blinfun (\\<^sub>U d)" + unfolding \\<^sub>U_def Finite_Cartesian_Product.less_eq_vec_def blinfun_to_matrix_inv P_upper_def P_dec_elem + by auto + +lemma nonneg_P_dec: "0 \<le> P_dec d" + by (simp add: Finite_Cartesian_Product.less_eq_vec_def P_dec_elem) + +lemma nonneg_P_upper: "0 \<le> P_upper d" + using nonneg_P_dec + by (simp add: Finite_Cartesian_Product.less_eq_vec_def P_upper_def) + +lemma nonneg_P_lower: "0 \<le> P_lower d" + using nonneg_P_dec + by (simp add: Finite_Cartesian_Product.less_eq_vec_def P_lower_def) + +lemma nonneg_\\<^sub>L: "nonneg_blinfun (\\<^sub>L d)" + unfolding \\<^sub>L_def Finite_Cartesian_Product.less_eq_vec_def blinfun_to_matrix_inv P_lower_def P_dec_elem + by auto + +lemma nonneg_\\<^sub>1: "nonneg_blinfun (\\<^sub>1 d)" + unfolding blinfun_to_matrix_def matrix_def + by (auto simp: Finite_Cartesian_Product.less_eq_vec_def axis_def intro!: \\<^sub>1_pos less_eq_bfunD[of 0, simplified]) + +lemma norm_\\<^sub>L_le: "norm (\\<^sub>L d) \<le> norm (\\<^sub>1 (mk_dec_det d))" + using nonneg_\\<^sub>1 + by (fastforce intro!: matrix_le_norm_mono simp: Finite_Cartesian_Product.less_eq_vec_def P_dec_def P_lower_def \\<^sub>L_def) + +lemma norm_\\<^sub>L_le_one: "norm (\\<^sub>L d) \<le> 1" + using norm_\\<^sub>L_le norm_\\<^sub>1 by auto + +lemma norm_\\<^sub>L_less_one: "norm (l *\<^sub>R \\<^sub>L d) < 1" + using order.strict_trans1[OF mult_left_le disc_lt_one] zero_le_disc norm_\\<^sub>L_le_one + by auto + + +lemma \\<^sub>L_le_\\<^sub>1: "0 \<le> v \<Longrightarrow> \\<^sub>L d v \<le> \\<^sub>1 (mk_dec_det d) v" +proof - + assume "0 \<le> v" + moreover have "P_lower d \<le> P_dec d" + using nonneg_P_dec + by (auto simp: P_lower_def less_eq_vec_def) + ultimately show ?thesis + by (metis P_dec_def \\<^sub>L_def blinfun_apply_mono blinfun_to_matrix_inv nonneg_\\<^sub>L) +qed + +lemma \\<^sub>U_le_\\<^sub>1: "0 \<le> v \<Longrightarrow> \\<^sub>U d v \<le> \\<^sub>1 (mk_dec_det d) v" +proof - + assume "0 \<le> v" + moreover have "P_upper d \<le> P_dec d" + using nonneg_P_dec + by (auto simp: P_upper_def less_eq_vec_def) + ultimately show ?thesis + by (metis P_dec_def \\<^sub>U_def blinfun_apply_mono blinfun_to_matrix_inv nonneg_\\<^sub>U) +qed + +lemma row_P_upper_indep: "d s = d' s \<Longrightarrow> row s (P_upper d) = row s (P_upper d')" + unfolding row_def P_dec_elem P_upper_def + by auto + +lemma row_P_lower_indep: "d s = d' s \<Longrightarrow> row s (P_lower d) = row s (P_lower d')" + unfolding row_def P_dec_elem P_lower_def + by auto + +lemma triangular_mat_P_upper: "upper_triangular_mat (P_upper d)" + unfolding upper_triangular_mat_def P_upper_def + by auto + +lemma slt_P_lower: "strict_lower_triangular_mat (P_lower d)" + unfolding strict_lower_triangular_mat_def P_lower_def + by auto + +lemma lt_P_lower: "lower_triangular_mat (P_lower d)" + unfolding lower_triangular_mat_def P_lower_def + by auto + + +subsubsection \<open>Gauss Seidel is a Regular Splitting\<close> +definition "Q_GS d = id_blinfun - l *\<^sub>R \\<^sub>L d" +definition "R_GS d = l *\<^sub>R \\<^sub>U d" + +lemma splitting_gauss: "is_splitting_blin (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d)) (Q_GS d) (R_GS d)" + unfolding is_splitting_blin_def' +proof safe + show "nonneg_blinfun (R_GS d)" + unfolding R_GS_def \\<^sub>U_def blinfun_to_matrix_scaleR Finite_Cartesian_Product.less_eq_vec_def blinfun_to_matrix_inv + using nonneg_P_upper + by (auto intro!: mult_nonneg_nonneg) +next + have "\\<^sub>L d + \\<^sub>U d = \\<^sub>1 (mk_dec_det d)" for d + proof - + have "\\<^sub>L d + \\<^sub>U d = matrix_to_blinfun (\<chi> i j. ((blinfun_to_matrix (\\<^sub>1 (mk_dec_det d)))) $ i $ j)" + unfolding \\<^sub>L_def \\<^sub>U_def P_lower_def P_upper_def P_dec_def matrix_to_blinfun_add[symmetric] + by (auto simp: vec_eq_iff intro!: arg_cong[of _ _ matrix_to_blinfun]) + also have "\<dots> = (\\<^sub>1 (mk_dec_det d))" + by (simp add: matrix_to_blinfun_inv) + finally show "\\<^sub>L d + \\<^sub>U d = \\<^sub>1 (mk_dec_det d)". + qed + thus "id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det d) = Q_GS d - R_GS d" + unfolding Q_GS_def R_GS_def + by (auto simp: algebra_simps scaleR_add_right[symmetric] simp del: scaleR_add_right) +next + have n_le: "norm (l *\<^sub>R \\<^sub>L d) < 1" + using mult_left_le[OF norm_\\<^sub>L_le_one[of d] zero_le_disc] order.strict_trans1 + by (auto intro: disc_lt_one) + thus "invertible\<^sub>L (Q_GS d)" + by (simp add: Q_GS_def invertible\<^sub>L_inf_sum) + have "inv\<^sub>L (Q_GS d) = (\<Sum>i. (l *\<^sub>R \\<^sub>L d) ^^ i)" + using inv\<^sub>L_inf_sum n_le unfolding Q_GS_def + by blast + hence *: "blinfun_to_matrix (inv\<^sub>L (Q_GS d)) $ i $ j = (\<Sum>k. blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d) ^^ k) $ i $ j)" for i j + using summable_inv_Q[of "Q_GS d"] norm_\\<^sub>L_less_one + unfolding Q_GS_def + by (subst bounded_linear.suminf[symmetric]) + (auto intro!: bounded_linear_compose[OF bounded_linear_vec_nth] bounded_linear_compose[OF bounded_linear_blinfun_to_matrix]) + have "0 \<le> l^i *\<^sub>R matpow (P_lower d) i" for i + using nonneg_matpow[OF nonneg_P_lower] + by (meson scaleR_nonneg_nonneg zero_le_disc zero_le_power) + have "0 \<le> (\<Sum>k. blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d) ^^ k) $ i $ j)" for i j + proof (intro suminf_nonneg) + show "summable (\<lambda>k. blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d) ^^ k) $ i $ j)" + using summable_inv_Q[of "Q_GS d"] norm_\\<^sub>L_less_one + unfolding Q_GS_def + by (fastforce + simp: + blinfun_to_matrix_matpow nonneg_matrix_nonneg blincomp_scaleR_right blinfun_to_matrix_scaleR + intro: + bounded_linear.summable[of _ "\<lambda>i. (l *\<^sub>R \\<^sub>L d) ^^ i"] + bounded_linear_compose[OF bounded_linear_vec_nth] + bounded_linear_compose[OF bounded_linear_blinfun_to_matrix]) + show "\<And>n. 0 \<le> blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d) ^^ n) $ i $ j" + using nonneg_matpow[OF nonneg_P_lower] + by (auto simp: \\<^sub>L_def nonneg_matrix_nonneg blinfun_to_matrix_scaleR matpow_scaleR blinfun_to_matrix_matpow) + qed + thus "nonneg_blinfun (inv\<^sub>L (Q_GS d))" + by (simp add: * Finite_Cartesian_Product.less_eq_vec_def) +qed + +abbreviation "r_det\<^sub>b d \<equiv> r_dec\<^sub>b (mk_dec_det d) " +abbreviation "r_vec d \<equiv> \<chi> i. r_dec\<^sub>b (mk_dec_det d) i" + +abbreviation "Q_mat d \<equiv> blinfun_to_matrix (Q_GS d)" +abbreviation "R_mat d \<equiv> blinfun_to_matrix (R_GS d)" + +lemma Q_mat_def: "Q_mat d = mat 1 - l *\<^sub>R P_lower d" + unfolding Q_GS_def + by (simp add: \\<^sub>L_def blinfun_to_matrix_diff blinfun_to_matrix_id blinfun_to_matrix_scaleR) + +lemma R_mat_def: "R_mat d = l *\<^sub>R P_upper d" + unfolding R_GS_def + by (simp add: \\<^sub>U_def blinfun_to_matrix_scaleR) + +lemma triangular_mat_R: "upper_triangular_mat (R_mat d)" + using triangular_mat_P_upper + unfolding upper_triangular_mat_def R_mat_def + by auto + +definition "GS_inv d v \<equiv> matrix_inv (Q_mat d) *v (r_vec d + R_mat d *v v)" + +text \<open>@{term Q_mat} can be expressed as an infinite sum of @{const P_lower}. + It is therefore lower triangular.\<close> +lemma inv_Q_mat_suminf: "matrix_inv (Q_mat d) = (\<Sum>k. (matpow (l *\<^sub>R (P_lower d)) k))" +proof - + have "matrix_inv (Q_mat d) = blinfun_to_matrix (inv\<^sub>L (Q_GS d))" + using blinfun_to_matrix_inverse(2) is_splitting_blin_def' splitting_gauss + by metis + also have "\<dots> = blinfun_to_matrix (\<Sum>i. (l *\<^sub>R \\<^sub>L d)^^i)" + using norm_\\<^sub>L_less_one + by (auto simp: Q_GS_def inv\<^sub>L_inf_sum) + also have "\<dots> = (\<Sum>k. (blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d)^^k)))" + using summable_inv_Q[of "Q_GS d"] norm_\\<^sub>L_less_one bounded_linear_blinfun_to_matrix + unfolding Q_GS_def row_def + by (subst bounded_linear.suminf) auto + also have "\<dots> = (\<Sum>k. (matpow (l *\<^sub>R (P_lower d)) k))" + by (simp add: blinfun_to_matrix_scaleR blinfun_to_matrix_matpow \\<^sub>L_def blinfun_to_matrix_inv) + finally show ?thesis. +qed + +lemma lt_Q_inv: "lower_triangular_mat (matrix_inv (Q_mat d))" + unfolding inv_Q_mat_suminf + using summable_inv_Q[of "Q_GS d"] norm_\\<^sub>L_less_one summable_blinfun_to_matrix[of "\<lambda>i. (l *\<^sub>R \\<^sub>L d)^^i"] + by (intro lower_triangular_suminf lower_triangular_pow) + (auto simp: lower_triangular_mat_def P_lower_def Q_GS_def blinfun_to_matrix_scaleR blinfun_to_matrix_matpow \\<^sub>L_def) + +text \<open>Each row of the matrix @{term "Q_mat d"} only depends on @{term d}'s actions in lower states.\<close> + +lemma inv_Q_mat_indep: + assumes "\<And>i. i \<le> s \<Longrightarrow> d i = d' i" "i \<le> s" + shows "row i (matrix_inv (Q_mat d)) = row i (matrix_inv (Q_mat d'))" +proof - + have "row i (matrix_inv (Q_mat d)) = row i (blinfun_to_matrix (inv\<^sub>L (Q_GS d)))" + using blinfun_to_matrix_inverse(2) is_splitting_blin_def' splitting_gauss + by metis + also have "\<dots> = row i (blinfun_to_matrix (\<Sum>i. (l *\<^sub>R \\<^sub>L d)^^i))" + using norm_\\<^sub>L_less_one + by (auto simp: Q_GS_def inv\<^sub>L_inf_sum) + also have "\<dots> = (\<Sum>k. row i (blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d)^^k)))" + using summable_inv_Q[of "Q_GS d"] norm_\\<^sub>L_less_one + unfolding Q_GS_def row_def + by (subst bounded_linear.suminf[OF bounded_linear_compose[OF _ bounded_linear_blinfun_to_matrix]]) auto + also have "\<dots> = (\<Sum>k. row i (matpow (l *\<^sub>R (P_lower d)) k))" + by (simp add: blinfun_to_matrix_matpow blinfun_to_matrix_scaleR \\<^sub>L_def blinfun_to_matrix_inv) + also have "\<dots> = (\<Sum>k. l^k *\<^sub>R row i (matpow ((P_lower d)) k))" + by (subst matpow_scaleR) (auto simp: row_def scaleR_vec_def) + also have "\<dots> = (\<Sum>k. l^k *\<^sub>R row i (matpow ((P_lower d')) k))" + using assms + by (subst lower_triangular_pow_eq[of "P_lower d'"]) (auto simp: P_dec_elem lt_P_lower row_P_lower_indep[of d' _ d]) + also have "\<dots> = (\<Sum>k. row i (matpow (l *\<^sub>R (P_lower d')) k))" + by (subst matpow_scaleR) (auto simp: row_def scaleR_vec_def) + also have "\<dots> = (\<Sum>k. row i (blinfun_to_matrix ((l *\<^sub>R \\<^sub>L d')^^k)))" + by (simp add: \\<^sub>L_def blinfun_to_matrix_inv blinfun_to_matrix_matpow blinfun_to_matrix_scaleR) + also have "\<dots> = row i (blinfun_to_matrix (\<Sum>i. (l *\<^sub>R \\<^sub>L d')^^i))" + using summable_inv_Q[of "Q_GS d'"] norm_\\<^sub>L_less_one + unfolding Q_GS_def row_def + by (auto intro!: bounded_linear.suminf[symmetric] + bounded_linear_compose[OF _ bounded_linear_blinfun_to_matrix]) + also have "\<dots> = row i (blinfun_to_matrix (inv\<^sub>L (Q_GS d')))" + by (metis Q_GS_def inv\<^sub>L_inf_sum norm_\\<^sub>L_less_one) + also have "\<dots> = row i (matrix_inv (Q_mat d'))" + by (metis blinfun_to_matrix_inverse(2) is_splitting_blin_def' splitting_gauss) + finally show ?thesis. +qed + +text \<open>As a result, also @{term GS_inv} is independent of lower actions.\<close> +lemma GS_indep_high_states: + assumes "\<And>s'. s' \<le> s \<Longrightarrow> d s' = d' s'" + shows "GS_inv d v $ s = GS_inv d' v $ s" +proof - + have "row i (P_upper d) = row i (P_upper d')" if "i \<le> s" for i + using assms that row_P_upper_indep by blast + hence R_eq_upto_s: "row i (R_mat d) = row i (R_mat d')" if "i \<le> s" for i + using that + by (simp add: row_def R_mat_def) + + have Qr_eq: "(matrix_inv (Q_mat d) *v r_vec d) $ s = (matrix_inv (Q_mat d') *v r_vec d') $ s" + proof - + have "(matrix_inv (Q_mat d) *v r_vec d) $ s = (\<Sum>j\<in>UNIV. matrix_inv (Q_mat d) $ s $ j * r_vec d $ j)" + unfolding matrix_vector_mult_def + by simp + also have "\<dots> = (\<Sum>j\<in>UNIV. if s < j then 0 else matrix_inv (Q_mat d) $ s $ j * r_vec d $ j)" + using lt_Q_inv + by (auto intro!: sum.cong simp: lower_triangular_mat_def) + also have "\<dots> = (\<Sum>j\<in>UNIV. if s < j then 0 else matrix_inv (Q_mat d') $ s $ j * r_vec d $ j)" + using inv_Q_mat_indep assms + by (fastforce intro!: sum.cong simp: row_def) + also have "\<dots> = (matrix_inv (Q_mat d') *v r_vec d') $ s" + using lt_Q_inv + by (auto simp: matrix_vector_mult_def assms lower_triangular_mat_def intro!: sum.cong) + finally show ?thesis. + qed + + have QR_eq: "row s (matrix_inv (Q_mat d) ** R_mat d) = row s (matrix_inv (Q_mat d') ** R_mat d')" + proof - + have "matrix_inv (Q_mat d) $ s $ k * R_mat d $ k $ j = matrix_inv (Q_mat d') $ s $ k * R_mat d' $ k $ j" for k j + proof - + have "matrix_inv (Q_mat d) $ s $ k * R_mat d $ k $ j = + (if s < k then 0 else matrix_inv (Q_mat d) $ s $ k * R_mat d $ k $ j)" + using lower_triangular_mat_def lt_Q_inv by auto + also have "\<dots> = (if s < k then 0 else matrix_inv (Q_mat d') $ s $ k * R_mat d $ k $ j)" + by (metis (no_types, lifting) Finite_Cartesian_Product.row_def assms inv_Q_mat_indep order_refl vec_lambda_eta) + also have "\<dots> = (if s < k \<or> j < k then 0 else (matrix_inv (Q_mat d') $ s $ k * R_mat d $ k $ j))" + using triangular_mat_R + unfolding upper_triangular_mat_def + by (auto split: if_splits) + also have "\<dots> = (if s < k \<or> j < k then 0 else (matrix_inv (Q_mat d') $ s $ k * R_mat d' $ k $ j))" + using R_eq_upto_s + by (auto simp: row_def) + also have "\<dots> = matrix_inv (Q_mat d') $ s $ k * R_mat d' $ k $ j" + by (metis lower_triangular_mat_def lt_Q_inv mult_not_zero triangular_mat_R upper_triangular_mat_def) + finally show ?thesis. + qed + thus ?thesis + unfolding row_def matrix_matrix_mult_def + by auto + qed + show ?thesis + using QR_eq Qr_eq + by (auto simp add: GS_inv_def vec.add row_def matrix_vector_mul_assoc matrix_vector_mult_code') +qed + +text \<open>This recursive definition mimics the computation of the GS iteration.\<close> +lemma GS_inv_rec: "GS_inv d v = r_vec d + l *\<^sub>R (P_upper d *v v + P_lower d *v (GS_inv d v))" +proof - + have "Q_mat d *v (GS_inv d v) = r_vec d + R_mat d *v v" + using splitting_gauss[of d] blinfun_to_matrix_inverse(1) + unfolding GS_inv_def matrix_vector_mul_assoc is_splitting_blin_def' + by (subst matrix_inv(2)) auto + thus ?thesis + unfolding Q_mat_def R_mat_def + by (auto simp: algebra_simps scaleR_matrix_vector_assoc) +qed + +lemma is_am_GS_inv_extend: + assumes "\<And>s. s < k \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + and "is_arg_max (\<lambda>a. GS_inv (d (k := a)) v $ k) (\<lambda>a. a \<in> A k) a" + and "s \<le> k" + and "d \<in> D\<^sub>D" + shows "is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (d (k := a))" +proof - + have am_k: "is_arg_max (\<lambda>d. GS_inv d v $ k) (\<lambda>d. d \<in> D\<^sub>D) (d (k := a))" + proof (rule is_arg_max_linorderI) + fix y + assume "y \<in> D\<^sub>D" + have "GS_inv y v $ k = (r_vec y + l *\<^sub>R (P_upper y *v v + P_lower y *v (GS_inv y v))) $ k" + using GS_inv_rec by auto + also have "\<dots> = r (k, y k) + l * ((P_upper y *v v) $ k + (P_lower y *v GS_inv y v) $ k)" + by auto + also have "\<dots> \<le> r (k, (d(k := y k)) k) + l * ((P_upper (d(k := y k)) *v v) $ k + (P_lower (d(k := y k)) *v GS_inv (d(k := y k)) v) $ k)" + proof (rule add_mono, goal_cases) + case 2 + thus ?case + proof (intro mult_left_mono add_mono, goal_cases) + case 1 + thus ?case + by (auto simp: matrix_vector_mult_def P_dec_elem fun_upd_same P_upper_def cong: if_cong) + next + case 2 + thus ?case + proof - + have "(P_lower y *v GS_inv y v) $ k = (P_lower (d(k := y k)) *v GS_inv y v) $ k" + unfolding matrix_vector_mult_def + by (auto simp: P_dec_elem fun_upd_same P_lower_def cong: if_cong) + also have "\<dots> = (\<Sum>j\<in>UNIV. (if j < k then pmf (K (k, y k)) j * GS_inv y v $ j else 0))" + by (auto simp: matrix_vector_mult_def P_dec_elem P_lower_def intro!: sum.cong) + also have "\<dots> \<le> (\<Sum>j\<in>UNIV. (if j < k then pmf (K (k, y k)) j * GS_inv d v $ j else 0))" + using assms \<open>y\<in>D\<^sub>D\<close> + by (fastforce intro!: sum_mono mult_left_mono dest: is_arg_max_linorderD) + also have "\<dots> = (\<Sum>j\<in>UNIV. (if j < k then pmf (K (k, y k)) j * GS_inv (d(k := y k)) v $ j else 0))" + using GS_indep_high_states[of _ "d(k := y k)" d, symmetric] + by (fastforce intro!: sum.cong dest: leD) + also have "\<dots> = (P_lower (d(k := y k)) *v GS_inv (d(k := y k)) v) $ k" + unfolding matrix_vector_mult_def P_lower_def P_dec_elem + by (fastforce intro!: sum.cong) + finally show ?thesis. + qed + qed auto + qed auto + also have "\<dots> = (r_vec (d(k := y k)) + l *\<^sub>R ((P_upper (d(k := y k)) *v v) + (P_lower (d(k := y k)) *v GS_inv (d(k := y k)) v))) $ k" + by auto + also have "\<dots> = GS_inv (d(k := y k)) v $ k" + using GS_inv_rec by presburger + also have "\<dots> \<le> GS_inv (d(k := a)) v $ k" + using is_arg_max_linorderD(2)[OF assms(2)] \<open>y \<in> D\<^sub>D\<close> is_dec_det_def + by blast + finally show "GS_inv y v $ k \<le> GS_inv (d(k := a)) v $ k". + next + show "d(k := a) \<in> D\<^sub>D" + using assms + by (auto simp: is_dec_det_def is_arg_max_linorder) + qed + show ?thesis + proof (cases "s < k") + case True + thus ?thesis + using am_k assms(1)[OF True] GS_indep_high_states[of s "d (k := a)" d] + by (fastforce dest: is_arg_max_linorderD intro!: is_arg_max_linorderI) + next + case False + thus ?thesis + using assms am_k + by auto + qed +qed + + +lemma is_arg_max_GS_le: + "\<exists>d. \<forall>s\<le>k. is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" +proof (induction k rule: less_induct) + case (less x) + show ?case + proof (cases "\<exists>y. y < x") + case True + define y where "y = Max {y. y < x}" + have "y < x" + using Max_in + by (simp add: True y_def) + obtain d_opt where d_opt: "is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d_opt" if "s \<le> y" for s + using \<open>y < x\<close> less by blast + + define d_act where d_act: "d_act a = d_opt(x := a)" for a + have le_y: "a < x \<Longrightarrow> a \<le> y" for a + by (simp add: y_def) + have 1: "GS_inv d v = r_vec d + l *\<^sub>R (P_upper d *v v + P_lower d *v (GS_inv d v))" for d + proof - + have "Q_mat d *v (GS_inv d v) = (R_mat d *v v + r_vec d)" + unfolding GS_inv_def + using splitting_gauss[unfolded is_splitting_blin_def'] + by (auto simp: matrix_vector_mul_assoc matrix_inv_right[OF blinfun_to_matrix_inverse(1)]) + thus ?thesis + unfolding Q_mat_def R_mat_def + by (auto simp: scaleR_matrix_vector_assoc algebra_simps) + qed + have "(\<Squnion>d \<in> D\<^sub>D. GS_inv d v $ x) = (\<Squnion>d \<in> D\<^sub>D. (r_vec d + l *\<^sub>R (P_upper d *v v + P_lower d *v (GS_inv d v))) $ x)" + using 1 by auto + also have "\<dots> = (\<Squnion>a \<in> A x. (r_vec (d_act a) + l *\<^sub>R (P_upper (d_act a) *v v + P_lower (d_act a) *v (GS_inv (d_act a) v))) $ x)" + proof (rule antisym, rule cSUP_mono, goal_cases) + case (3 n) + moreover have "(P_upper n *v v) $ x \<le> (P_upper (d_opt(x := n x)) *v v) $ x" + unfolding P_upper_def matrix_vector_mult_def + by (auto simp: P_dec_elem cong: if_cong) + moreover + { + have "\<And>j. j < x \<Longrightarrow> GS_inv n v $ j \<le> GS_inv (d_opt(x := n x)) v $ j" + using d_opt[OF le_y] 3 + by (subst GS_indep_high_states[of _ "d_opt(x := n x)" d_opt]) (auto simp: is_arg_max_linorder) + hence "(P_lower n *v GS_inv n v) $ x \<le> (P_lower (d_opt(x := n x)) *v GS_inv (d_opt(x := n x)) v) $ x" + unfolding matrix_vector_mult_def P_lower_def P_dec_elem + by (fastforce intro!: mult_left_mono sum_mono) + } + ultimately show ?case + unfolding d_act + by (auto intro!: bexI[of _ "n x"] mult_left_mono add_mono simp: is_dec_det_def) + next + case 4 + then show ?case + proof (rule cSUP_mono, goal_cases) + case (3 n) + then show ?case + using d_opt + by (fastforce simp: d_act is_dec_det_def is_arg_max_linorder intro!: bexI[of _ "d_act n"]) + qed (auto simp: A_ne) + qed auto + also have "\<dots> = (\<Squnion>a \<in> A x. GS_inv (d_act a) v $ x)" + using 1 by auto + finally have *: "(\<Squnion>d \<in> D\<^sub>D. GS_inv d v $ x) = (\<Squnion>a \<in> A x. GS_inv (d_act a) v $ x)". + then obtain a_opt where a_opt: "is_arg_max (\<lambda>a. GS_inv (d_act a) v $ x) (\<lambda>a. a \<in> A x) a_opt" + by (metis A_ne finite finite_is_arg_max) + hence "(\<Squnion>d \<in> D\<^sub>D. GS_inv d v $ x) = GS_inv (d_act a_opt) v $ x" + by (metis * arg_max_SUP) + hence am_a_opt: "is_arg_max (\<lambda>d. GS_inv d v $ x) (\<lambda>d. d \<in> D\<^sub>D) (d_act a_opt)" + using a_opt d_opt d_act unfolding is_dec_det_def + by (fastforce dest: is_arg_max_linorderD(1) intro!: SUP_is_arg_max) + hence "is_arg_max (\<lambda>d. GS_inv d v $ x') (\<lambda>d. d \<in> D\<^sub>D) (d_act a_opt)" if "x' < x" for x' + proof - + have "s' \<le> x' \<Longrightarrow> d_act a_opt s' = d_opt s'" for s' + using d_act that is_arg_max_linorderD[OF d_opt[OF le_y[OF that]]] + by auto + thus ?thesis + using am_a_opt is_arg_max_linorderD[OF d_opt[OF le_y[OF that]]] + by (auto simp: GS_indep_high_states[of _ "d_act a_opt" d_opt]) + qed + thus ?thesis + by (metis am_a_opt antisym_conv1) + next + case False + thus ?thesis + using finite_is_arg_max[OF finite_D\<^sub>D] + by (fastforce simp: arg_max_def someI_ex dest!: le_neq_trans) + qed +qed + +lemma ex_is_arg_max_GS: + "\<exists>d. \<forall>s. is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + using is_arg_max_GS_le[of "Max UNIV"] + by auto + +function GS_rec_fun where + "GS_rec_fun v s = (\<Squnion>a \<in> A s. r (s, a) + l * ( + (\<Sum>s' < s. pmf (K (s,a)) s' * (GS_rec_fun v s')) + + (\<Sum>s' \<in> {s'. s \<le> s'}. pmf (K (s,a)) s' * v s')))" + by auto +termination +proof (relation "{(x,y). snd x < snd y}", rule wfI_min, goal_cases) + case (1 x Q) + assume " x \<in> Q" + hence *: "{u. \<exists>a. (a, u) \<in> Q} \<noteq> {}" + by (metis (mono_tags, lifting) \<open>x\<in>Q\<close> prod.collapse Collect_empty_eq) + hence "\<exists>a x. (a,x)\<in>Q \<and> x = Min (snd ` Q)" + by (auto simp: image_iff) (metis (mono_tags, lifting) equals0D Min_in[OF finite] prod.collapse image_iff) + then obtain x where "x \<in> Q" "snd x = Min {snd x| x. x \<in> Q}" + by (metis Setcompr_eq_image snd_conv) + thus ?case + using * + by (intro bexI[of _ x]) auto +qed auto + +declare GS_rec_fun.simps[simp del] + +definition "GS_rec_elem v s a = r (s, a) + l * ( + (\<Sum>s' < s. pmf (K (s,a)) s' * (GS_rec_fun v s')) + + (\<Sum>s' \<in> {s'. s \<le> s'}. pmf (K (s,a)) s' * v s'))" + +lemma GS_rec_fun_elem: "GS_rec_fun v s = (\<Squnion>a \<in> A s. GS_rec_elem v s a)" + unfolding GS_rec_elem_def + using GS_rec_fun.simps + by blast + +definition "GS_rec v = (\<chi> s. GS_rec_fun (vec_nth v) s)" + +lemma GS_rec_def': "GS_rec v $ s = (\<Squnion>a \<in> A s. r (s, a) + l * ( + (\<Sum>s' < s. pmf (K (s,a)) s' * (GS_rec v $ s')) + + (\<Sum>s' \<in> {s'. s \<le> s'}. pmf (K (s,a)) s' * v $ s')))" + unfolding GS_rec_def + by (auto simp: GS_rec_fun.simps[of _ s]) + +lemma GS_rec_eq: "GS_rec v $ s = (\<Squnion>a \<in> A s. r (s, a) + l * ( + (P_lower (d(s := a)) *v (GS_rec v)) $ s + (P_upper (d(s := a)) *v v) $ s))" + unfolding GS_rec_def'[of v s] P_lower_def P_upper_def P_dec_elem matrix_vector_mult_def + by (auto simp: if_distrib[where f = "\<lambda>x. x * _ $ _"] sum.If_cases lessThan_def) +definition "GS_rec_step d v \<equiv> r_vec d + l *\<^sub>R (P_lower d *v GS_rec v + P_upper d *v v)" + +lemma GS_rec_eq': "GS_rec v $ s = (\<Squnion>a \<in> A s. GS_rec_step (d(s:= a)) v $ s)" + using GS_rec_eq GS_rec_step_def by auto + +lemma GS_rec_eq_vec: + "GS_rec v $ s = (\<Squnion>d\<in>D\<^sub>D. GS_rec_step d v $ s)" +proof - + obtain d where d: "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in>D\<^sub>D) d" + using finite_is_arg_max[OF finite, of "D\<^sub>D" ] ex_dec_det by blast + have "GS_rec v $ s = GS_rec_step d v $ s" + unfolding GS_rec_eq'[of _ _ d] + proof (intro antisym cSUP_least) + show "\<And>x. x \<in> A s \<Longrightarrow> GS_rec_step (d(s := x)) v $ s \<le> GS_rec_step d v $ s" + using A_ne d + by (intro is_arg_max_linorderD[OF d]) (auto simp: is_dec_det_def is_arg_max_linorder) + show "GS_rec_step d v $ s \<le> (\<Squnion>a\<in>A s. GS_rec_step (d(s := a)) v $ s)" + using d unfolding is_arg_max_linorder is_dec_det_def fun_upd_triv + by (auto intro!: cSUP_upper2[of _ _ "d s"]) + qed (auto simp: A_ne) + thus ?thesis + using d + by (subst arg_max_SUP[symmetric]) auto +qed + + +lift_definition GS_rec_fun\<^sub>b :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" is GS_rec_fun + by auto + +definition "GS_rec_fun_inner (v :: 's \<Rightarrow>\<^sub>b real) s a \<equiv> r (s, a) + l * ( + (\<Sum>s' < s. pmf (K (s,a)) s' * (GS_rec_fun\<^sub>b v s')) + + (\<Sum>s' \<in> {s'. s \<le> s'}. pmf (K (s,a)) s' * v s'))" + +definition GS_rec_iter where + "GS_rec_iter v s = (\<Squnion>a \<in> A s. r (s, a) + l * + (\<Sum>s' \<in> UNIV. pmf (K (s,a)) s' * v s'))" + +lemma GS_rec_fun_eq_GS_iter: + assumes "\<forall>s' < s. v_next s' = GS_rec_fun v s'" "\<forall>s' \<in> {s'. s \<le> s'}. v_next s' = v s'" + shows "GS_rec_fun v s = GS_rec_iter v_next s" +proof - + have "{s'. s' < s} \<union> {s'. s \<le> s'} = UNIV" + by auto + hence *: "(\<Sum>s'<s. f s') + (\<Sum>s'\<in>Collect ((\<le>) s). f s') = (\<Sum>s' \<in> UNIV. f s')" for f + by (subst sum.union_disjoint[symmetric]) (auto simp add: lessThan_def) + have "GS_rec_fun v s = (\<Squnion>a\<in>A s. r (s, a) + l * ((\<Sum>s'<s. pmf (K (s, a)) s' * v_next s') + (\<Sum>s'\<in>Collect ((\<le>) s). pmf (K (s, a)) s' * v s')))" + using assms + by (subst GS_rec_fun.simps) auto + also have "\<dots> = (\<Squnion>a\<in>A s. r (s, a) + l * ((\<Sum>s'<s. pmf (K (s, a)) s' * v_next s') + (\<Sum>s'\<in>Collect ((\<le>) s). pmf (K (s, a)) s' * v_next s')))" + using assms + by auto + also have "\<dots> = GS_rec_iter v_next s" + by (auto simp: * GS_rec_iter_def) + finally show ?thesis . +qed + +lemma foldl_upd_notin: "x \<notin> set X \<Longrightarrow> foldl (\<lambda>f y. f(y := g f y)) c X x = c x" + by (induction X arbitrary: c) auto + +lemma foldl_upd_notin': "x \<notin> set Y \<Longrightarrow> foldl (\<lambda>f y. f(y := g f y)) c (X@Y) x = foldl (\<lambda>f y. f(y := g f y)) c X x" + by (induction X arbitrary: x c Y) (auto simp add: foldl_upd_notin) + +lemma sorted_list_of_set_split: + assumes "finite X" + shows "sorted_list_of_set X = sorted_list_of_set {x \<in> X. x < y} @ sorted_list_of_set {x \<in> X. y \<le> x}" + using assms +proof (induction "card X" arbitrary: X) + case (Suc n X) + have "sorted_list_of_set X = Min X # sorted_list_of_set (X - {Min X})" + using Suc by (auto intro: sorted_list_of_set_nonempty) + also have "\<dots> = Min X # sorted_list_of_set {x \<in> (X - {Min X}). x < y} @ sorted_list_of_set {x \<in> (X - {Min X}). y \<le> x}" + using Suc card.remove[OF Suc(3) Min_in] card.empty + by (fastforce simp: Suc(1))+ + also have "\<dots> = sorted_list_of_set ({x \<in> X. x < y}) @ sorted_list_of_set {x \<in> X. y \<le> x}" + proof (cases "Min X < y") + case True + hence Min_eq: "Min X = Min {x \<in> X. x < y}" + using True Suc Min_in + by (subst eq_Min_iff) fastforce+ + have "{x \<in> (X - {Min X}). x < y} = {x \<in> X. x < y} - {Min {x \<in> X. x < y}}" + using Min_eq by auto + hence "Min X # sorted_list_of_set {x \<in> (X - {Min X}). x < y} = + Min {x \<in> X. x < y} # sorted_list_of_set ({x \<in> X. x < y} - {Min {x \<in> X. x < y}})" + using Min_eq by auto + also have "\<dots> = sorted_list_of_set ({x \<in> X. x < y})" + using Suc True Min_in Min_eq + by (subst sorted_list_of_set_nonempty[symmetric]) fastforce+ + finally have "Min X # sorted_list_of_set {x \<in> (X - {Min X}). x < y} = sorted_list_of_set ({x \<in> X. x < y})". + hence "Min X # sorted_list_of_set {x \<in> (X - {Min X}). x < y} @ sorted_list_of_set {x \<in> (X - {Min X}). y \<le> x} = + sorted_list_of_set ({x \<in> X. x < y}) @ sorted_list_of_set {x \<in> (X - {Min X}). y \<le> x}" + by auto + then show ?thesis + using True + by (auto simp: append_Cons[symmetric] simp del: append_Cons dest!: leD intro: arg_cong) + next + case False + have Min_eq: "Min X = Min {x \<in> X. y \<le> x}" + using False Suc Min_in + by (subst eq_Min_iff) (fastforce simp: linorder_class.not_less)+ + have 2: "{x \<in> (X - {Min X}). y \<le> x} = {x \<in> X. y \<le> x} - {Min {x \<in> X. y \<le> x}}" + using Min_eq by auto + have "x \<in> X \<Longrightarrow> \<not> x < y" for x + using False Min_less_iff Suc(3) by blast + hence "{x \<in> X. x < y} = {}" + by auto + hence "Min X # sorted_list_of_set {x \<in> X - {Min X}. x < y} @ sorted_list_of_set {x \<in> X - {Min X}. y \<le> x} = + Min X # sorted_list_of_set {x \<in> X - {Min X}. y \<le> x}" + using Suc by auto + also have "\<dots> = Min {x \<in> X. y \<le> x} # sorted_list_of_set ({x \<in> X. y \<le> x} - {Min {x \<in> X. y \<le> x}})" + using Min_eq 2 + by auto + also have "\<dots> = sorted_list_of_set ({x \<in> X. y \<le> x})" + using Suc False Min_in Min_eq + by (subst sorted_list_of_set_nonempty[symmetric]) fastforce+ + also have "\<dots> = sorted_list_of_set ({x \<in> X. x < y})@ sorted_list_of_set ({x \<in> X. y \<le> x})" + by (simp add: \<open>{x \<in> X. x < y} = {}\<close>) + finally show ?thesis. + qed + finally show ?case. +qed auto + +lemma sorted_list_of_set_split': + assumes "finite X" + shows "sorted_list_of_set X = sorted_list_of_set {x \<in> X. x \<le> y} @ sorted_list_of_set {x \<in> X. y < x}" + using sorted_list_of_set_split[of X] +proof (cases "\<exists>x \<in> X. y < x") + case True + hence "{x \<in> X. x \<le> y} = {x \<in> X. x < Min {x \<in> X. y < x}}" + using assms True by (subst Min_gr_iff) auto + moreover have "{x \<in> X. y < x} = {x \<in> X. Min {x \<in> X. y < x} \<le> x}" + using assms True + by (subst Min_le_iff) auto + ultimately show ?thesis + using sorted_list_of_set_split[OF assms, of "Min {x \<in> X. y < x}"] + by auto +next + case False + hence *: "{x \<in> X. y < x} = {}" "{x \<in> X. x \<le> y} = X" + by (auto simp add:linorder_class.not_less) + thus ?thesis + using False + by (auto simp: *) +qed + +lemma GS_rec_fun_code: "GS_rec_fun v s = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..s}) s" +proof (induction s rule: less_induct) + case (less s) + have "foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..s}) s + = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {x \<in> {..s}. x < s} @ sorted_list_of_set {x \<in> {..s}. s \<le> x}) s" + by (subst sorted_list_of_set_split[of _ s]) auto + also have "\<dots> = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..<s} @ sorted_list_of_set {s}) s" + proof - + have "{x \<in> {..s}. x <s} = {..<s}" "{x \<in> {..s}. s \<le> x} = {s}" + by auto + thus ?thesis by auto + qed + also have "\<dots> = GS_rec_iter (foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..<s})) s" + by auto + also have "\<dots> = GS_rec_fun v s" + proof (intro GS_rec_fun_eq_GS_iter[symmetric], safe, goal_cases) + case (1 s') + assume "s' < s" + hence *: "(Collect ((<) s')) \<noteq> {}" + by auto + hence "{x \<in> {..<s}. x < Min (Collect ((<) s'))} = {..s'}" + using leI 1 + by (auto simp add: Min_gr_iff[OF finite]) + moreover have "{x \<in> {..<s}. Min (Collect ((<) s')) \<le> x} = {s'<..<s}" + using * + by (auto simp add: Min_le_iff[OF finite]) + ultimately have "foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..<s}) s' + = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set {..s'} @ sorted_list_of_set {s'<..<s}) s'" + by (subst sorted_list_of_set_split[of _ "Min{s. s' < s}"]) auto + also have "\<dots> = GS_rec_fun v s'" + using "1" less.IH by (subst foldl_upd_notin') fastforce+ + finally show ?case. + qed (auto intro: foldl_upd_notin) + finally show ?case + by metis +qed + +lemma GS_rec_fun_code': "GS_rec_fun v s = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set UNIV) s" +proof (cases "s = Max UNIV") + case True + then show ?thesis + by (auto simp: GS_rec_fun_code atMost_def) +next + case False + hence *: "(Collect ((<) s)) \<noteq> {}" + by (auto simp: not_le eq_Max_iff[OF finite]) + hence "{x. x < Min (Collect ((<) s))} = {..s}" + by (auto simp: Min_less_iff[OF finite *] intro: leI) + then show ?thesis + unfolding sorted_list_of_set_split[of UNIV "Min{s'. s < s'}", OF finite] GS_rec_fun_code + by (subst foldl_upd_notin'[of s]) auto +qed + +lemma GS_rec_fun_code'': "GS_rec_fun v = foldl (\<lambda>v s. v(s := GS_rec_iter v s)) v (sorted_list_of_set UNIV)" + using GS_rec_fun_code' by auto + +lemma GS_rec_eq_elem: "GS_rec v $ s = GS_rec_fun (vec_nth v) s" + unfolding GS_rec_def + by auto + + + +lemma GS_rec_step_elem: "GS_rec_step d v $ s = r (s, d s) + l * ((\<Sum>s' < s. pmf (K (s, d s)) s' * GS_rec v $ s') + (\<Sum>s' \<in> {s'. s \<le> s'}. pmf (K (s, d s)) s' * v $ s'))" + unfolding GS_rec_step_def P_upper_def P_lower_def lessThan_def P_dec_elem matrix_vector_mult_def + by (auto simp: sum.If_cases algebra_simps if_distrib[of "\<lambda>x. _ $ _ * x"]) + +lemma is_arg_max_GS_rec_step_act: + assumes "d \<in>D\<^sub>D" "is_arg_max (\<lambda>a. GS_rec_step (d'(s := a)) v $ s) (\<lambda>a. a \<in>A s) a" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in>D\<^sub>D) (d(s := a))" + using assms + unfolding GS_rec_step_elem is_arg_max_linorder is_dec_det_def + by auto + +lemma is_arg_max_GS_rec_step_act': + assumes "d \<in>D\<^sub>D" "is_arg_max (\<lambda>a. GS_rec_step (d'(s := a)) v $ s) (\<lambda>a. a \<in>A s) (d s)" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in>D\<^sub>D) d" + using is_arg_max_GS_rec_step_act[OF assms] + by fastforce + +lemma + is_arg_max_GS_rec: + assumes "\<And>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec v = GS_rec_step d v" + using arg_max_SUP[OF assms] + by (auto simp: vec_eq_iff GS_rec_eq_vec ) + +lemma + is_arg_max_GS_rec': + assumes "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec v $ s = GS_rec_step d v $ s" + using assms + by (auto simp: GS_rec_eq_vec arg_max_SUP[symmetric]) + +lemma + GS_rec_eq_GS_inv: + assumes "\<And>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec v = GS_inv d v" +proof - + have "GS_rec v = GS_rec_step d v" + using is_arg_max_GS_rec[OF assms] + by auto + hence "GS_rec v = r_vec d + R_mat d *v v + (l *\<^sub>R P_lower d) *v GS_rec v" + unfolding R_mat_def GS_rec_step_def + by (auto simp: scaleR_matrix_vector_assoc algebra_simps) + hence "Q_mat d *v GS_rec v = r_vec d + R_mat d *v v" + unfolding Q_mat_def + by (metis (no_types, lifting) add_diff_cancel matrix_vector_mult_diff_rdistrib matrix_vector_mul_lid) + hence "(matrix_inv (Q_mat d) ** Q_mat d) *v GS_rec v = matrix_inv (Q_mat d) *v (r_vec d + R_mat d *v v)" + by (metis matrix_vector_mul_assoc) + thus "GS_rec v = GS_inv d v" + using splitting_gauss + unfolding GS_inv_def is_splitting_blin_def' + by (subst (asm) matrix_inv_left) (fastforce intro: blinfun_to_matrix_inverse(1))+ +qed + + +lemma + GS_rec_step_eq_GS_inv: + assumes "\<And>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec_step d v = GS_inv d v" + using GS_rec_eq_GS_inv[OF assms] is_arg_max_GS_rec[OF assms] + by auto + +lemma strict_lower_triangular_mat_mult: + assumes "strict_lower_triangular_mat M" "\<And>i. i < j \<Longrightarrow> v $ i = v' $ i" + shows "(M *v v) $ j = (M *v v') $ j" +proof - + have "(M *v v) $ j = (\<Sum>i\<in>UNIV. (if j \<le> i then 0 else M $ j $ i * v $ i))" + using assms unfolding strict_lower_triangular_mat_def + by (auto simp: matrix_vector_mult_def intro!: sum.cong) + also have "\<dots> = (\<Sum>i\<in>UNIV. (if j \<le> i then 0 else M $ j $ i * v' $ i))" + using assms + by (auto intro!: sum.cong) + also have "\<dots> = (M *v v') $ j" + using assms unfolding strict_lower_triangular_mat_def + by (auto simp: matrix_vector_mult_def intro!: sum.cong) + finally show ?thesis. +qed + +lemma Q_mat_invertible: "invertible (Q_mat d)" + by (meson blinfun_to_matrix_inverse(1) is_splitting_blin_def' splitting_gauss) + +lemma GS_eq_GS_inv: + assumes "\<And>s. s \<le> k \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + assumes "s \<le> k" + shows "GS_rec_step d v $ s = GS_inv d v $ s" +proof - + have *: "GS_rec v $ s = GS_rec_step d v $ s" if "s \<le> k" for s + using assms is_arg_max_GS_rec' that by presburger + hence "GS_rec v $ s = (r_vec d + R_mat d *v v + (l *\<^sub>R P_lower d) *v GS_rec v) $ s" if "s \<le> k" for s + unfolding R_mat_def GS_rec_step_def using that + by (simp add: scaleR_matrix_vector_assoc pth_6) + hence "(Q_mat d *v GS_rec v) $ s = (r_vec d + R_mat d *v v) $ s" if "s \<le> k" for s + unfolding Q_mat_def using that + by (simp add: matrix_vector_mult_diff_rdistrib) + hence "(matrix_inv (Q_mat d) *v (Q_mat d *v GS_rec v)) $ s = (matrix_inv (Q_mat d) *v ((r_vec d + R_mat d *v v))) $ s" + using assms lt_Q_inv by (auto intro: lower_triangular_mat_mult) + thus "GS_rec_step d v $ s = GS_inv d v $ s" + unfolding GS_inv_def + using matrix_inv_left[OF Q_mat_invertible] assms * + by (auto simp: matrix_vector_mul_assoc) +qed + +lemma is_arg_max_GS_imp_splitting': + assumes "\<And>s. s \<le> k \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + assumes "s \<le> k" + shows "is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + using assms +proof (induction k arbitrary: s rule: less_induct) + case (less x) + have d: "d \<in> D\<^sub>D" + using assms(1) is_arg_max_linorderD by fast + have "is_arg_max (\<lambda>a. GS_inv (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) (d s)" if "s \<le> x" for s + proof - + have "is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) (d s)" + using less(2)[OF that] + unfolding is_dec_det_def is_arg_max_linorder + by simp + hence *: "is_arg_max (\<lambda>a. r (s, a) + l * ((P_lower (d(s := a)) *v GS_rec v) $ s + (P_upper (d(s := a)) *v v) $ s)) (\<lambda>a. a \<in> A s) (d s)" + unfolding GS_rec_step_def + by auto + have "is_arg_max (\<lambda>a. r (s, a) + l * ((P_lower (d(s := a)) *v GS_inv (d(s := a)) v) $ s + (P_upper (d(s := a)) *v v) $ s)) (\<lambda>a. a \<in> A s) (d s)" + proof - + have "((P_lower (d(s := a)) *v GS_rec v) $ s = ((P_lower (d(s := a)) *v GS_rec_step d v) $ s))" for a + using is_arg_max_GS_rec' less(2) that + by (auto intro!: lower_triangular_mat_mult[OF lt_P_lower]) + moreover have "((P_lower (d(s := a)) *v GS_rec_step d v) $ s) = (P_lower (d(s := a)) *v GS_inv d v) $ s" for a + using less(2) that GS_eq_GS_inv + by (fastforce intro!: lower_triangular_mat_mult[OF lt_P_lower]) + moreover have "(P_lower (d(s := a)) *v GS_inv d v) $ s = (P_lower (d(s := a)) *v GS_inv (d(s := a)) v) $ s" for a + using GS_indep_high_states[of _ d "d(s := a)"] + by (fastforce intro!: strict_lower_triangular_mat_mult[OF slt_P_lower] dest!: leD) + ultimately show ?thesis + using * + by auto + qed + hence "is_arg_max (\<lambda>a. ((r_vec (d(s := a)) + l *\<^sub>R ((P_lower (d(s := a)) *v GS_inv (d(s := a)) v) + (P_upper (d(s := a)) *v v))) $ s)) (\<lambda>a. a \<in> A s) (d s)" + by auto + hence **: "is_arg_max (\<lambda>a. ((r_vec (d(s := a)) + R_mat (d(s := a)) *v v) + ((l *\<^sub>R P_lower (d(s := a))) *v GS_inv (d(s := a)) v) ) $ s) (\<lambda>a. a \<in> A s) (d s)" + unfolding R_mat_def + by (auto simp: algebra_simps scaleR_matrix_vector_assoc) + show ?thesis + proof- + have "(r_vec d + R_mat d *v v) = Q_mat d *v (GS_inv d v)" for d v + unfolding GS_inv_def matrix_vector_mul_assoc + by (metis (no_types, lifting) blinfun_to_matrix_inverse(1) is_splitting_blin_def' matrix_inv(2) matrix_vector_mul_lid splitting_gauss) + hence "((r_vec d + R_mat d *v v) + ((l *\<^sub>R P_lower d)) *v GS_inv d v) = GS_inv d v" for d + unfolding Q_mat_def + by (auto simp: matrix_vector_mult_diff_rdistrib) + thus ?thesis + using ** + by presburger + qed + qed + thus ?case + using less d + by (fastforce intro!: is_am_GS_inv_extend[of x v d "d x" s, unfolded fun_upd_triv]) +qed + +lemma is_am_GS_rec_step_indep: + assumes "d s = d' s" + assumes "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec v $ s = GS_rec_step d' v $ s" +proof - + have "GS_rec v $ s = GS_rec_step d v $ s" + using is_arg_max_GS_rec' assms(2) by blast + moreover have "GS_rec_step d v $ s = GS_rec_step d' v $ s" + using GS_rec_step_elem assms(1) by fastforce + ultimately show ?thesis by auto +qed + +lemma is_am_GS_rec_step_indep': + assumes "d s = d' s" + assumes "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "GS_rec v $ s = GS_rec_step d' v $ s" +proof - + have "GS_rec v $ s = GS_rec_step d v $ s" + using is_arg_max_GS_rec' assms(2) by blast + moreover have "GS_rec_step d v $ s = GS_rec_step d' v $ s" + using GS_rec_step_elem assms(1) by fastforce + ultimately show ?thesis by auto +qed + +lemma is_arg_max_GS_imp_splitting'': + assumes "\<And>s. s \<le> k \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + assumes "s \<le> k" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d \<and> GS_inv d v $ s = GS_rec v $ s" + using assms +proof (induction k arbitrary: s rule: less_induct) + case (less x) + have d[simp]: "d \<in> D\<^sub>D" using assms unfolding is_arg_max_linorder by blast + + have "is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) (d s)" if "s \<le> x" for s + proof - + have "is_arg_max (\<lambda>a. GS_inv (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) (d s)" + using less(2)[OF that] + unfolding is_dec_det_def is_arg_max_linorder + by auto + hence *: "is_arg_max (\<lambda>a. (r_vec (d(s := a)) + l *\<^sub>R (P_lower (d(s := a)) *v (GS_inv (d(s := a)) v) + P_upper (d(s := a)) *v v)) $ s) (\<lambda>a. a \<in> A s) (d s)" + by (subst (asm) GS_inv_rec) (auto simp: add.commute) + + hence *: "is_arg_max (\<lambda>a. (r_vec (d(s := a)) + l *\<^sub>R (P_lower (d(s := a)) *v (GS_inv d v) + P_upper (d(s := a)) *v v)) $ s) (\<lambda>a. a \<in> A s) (d s)" + proof - + have "(P_lower (d(s := a)) *v (GS_inv (d(s := a)) v)) $ s = (P_lower (d(s := a)) *v (GS_inv d v)) $ s" for a + using GS_indep_high_states[of _ "d(s := a)" d v] + by (rule strict_lower_triangular_mat_mult[OF slt_P_lower]) (metis array_rules(4) leD) + thus ?thesis using * by auto + qed + thus "is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) (d s)" + proof - + have "(P_lower (d(s := a)) *v (GS_inv d v)) $ s = (P_lower (d(s := a)) *v (GS_rec v)) $ s" for a + using less(1) less(2)that + by (intro strict_lower_triangular_mat_mult[OF slt_P_lower]) force + thus ?thesis + using * + unfolding GS_rec_step_def + by auto + qed + qed + hence *: "\<And>s. s \<le> x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + using d + by (intro is_arg_max_GS_rec_step_act'[of d d]) auto + moreover have "GS_inv d v $ s = GS_rec v $ s" if "s \<le> x" for s + proof - + have "GS_rec v $ s = GS_rec_step d v $ s" + using *[OF that] + by (auto simp: is_arg_max_GS_rec') + thus ?thesis + using * GS_eq_GS_inv that by presburger + qed + ultimately show ?case using less by blast +qed + +lemma is_arg_max_GS_imp_splitting''': + assumes "\<And>s. s \<le> k \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + assumes "s \<le> k" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + using assms is_arg_max_GS_imp_splitting'' by blast + +lemma is_arg_max_GS_imp_splitting: + assumes "\<And>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + shows "is_arg_max (\<lambda>d. GS_inv d v $ k) (\<lambda>d. d \<in> D\<^sub>D) d" + using assms is_arg_max_GS_imp_splitting'[of "Max UNIV"] + by (simp add: is_arg_max_linorder) + +lemma is_arg_max_gs_iff: + assumes "d \<in> D\<^sub>D" + shows " (\<forall>s \<le> k. is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d) \<longleftrightarrow> + (\<forall>s \<le> k. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d)" + using is_arg_max_GS_imp_splitting' is_arg_max_GS_imp_splitting'' + by meson + +lemma GS_opt_indep_high: + assumes "(\<And>s'. s' < s \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s') is_dec_det d)" "s' < s" "a \<in> A s" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s') is_dec_det (d(s := a))" +proof (rule is_arg_max_linorderI) + fix y + assume "is_dec_det y" + hence "GS_rec_step y v $ s' \<le> r (s', d s') + l * (P_lower d *v GS_rec v) $ s' + l * (P_upper d *v v) $ s'" + using is_arg_max_linorderD[OF assms(1)] + by (auto simp: GS_rec_step_def algebra_simps assms(2)) + also have "\<dots> = r (s', (d(s := a)) s') + l * (P_lower (d(s := a)) *v GS_rec v) $ s' + l * (P_upper (d(s := a)) *v v) $ s'" + proof - + have "(P_lower d *v GS_rec v) $ s' = (P_lower (d(s := a)) *v GS_rec v) $ s'" + using assms + by (fastforce simp: matrix_vector_mult_def P_lower_def P_dec_elem intro!: sum.cong) + moreover have "(P_upper d *v v) $ s' = (P_upper (d(s := a)) *v v) $ s'" + using assms + by (fastforce simp: matrix_vector_mult_def P_upper_def P_dec_elem intro!: sum.cong) + ultimately show ?thesis + using assms(2) by force + qed + also have "\<dots> = GS_rec_step (d(s := a)) v $ s'" + by (auto simp: GS_rec_step_def algebra_simps) + finally show "GS_rec_step y v $ s' \<le> GS_rec_step (d(s := a)) v $ s'". +next + show "is_dec_det (d(s := a))" + using is_arg_max_linorderD[OF assms(1)[OF assms(2)]] assms(3) is_dec_det_def + by fastforce +qed + +lemma mult_mat_vec_nth: "(X *v x) $ i = scalar_product (row i X) x" + by (simp add: matrix_vector_mult_def row_def scalar_product_def) + +(* +(* duplicate *) +lemma ext_GS_opt_eq: + assumes "(\<And>s'. s' < s \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) d)" + and "is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) a" + and "d \<in> D\<^sub>D" +shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (d(s := a))" +proof (rule is_arg_max_linorderI) + fix y + assume "y \<in> D\<^sub>D" + have "GS_rec_step y v $ s = GS_rec_step (d (s := y s)) v $ s" + unfolding P_lower_def P_upper_def P_dec_elem + using GS_rec_step_elem by force + also have "\<dots> \<le> GS_rec_step (d (s := a)) v $ s" + using is_arg_max_linorderD[OF assms(2)] \<open>y \<in> D\<^sub>D\<close> is_dec_det_def + by auto + finally show "GS_rec_step y v $ s \<le> GS_rec_step (d(s := a)) v $ s". +next + show "d(s := a) \<in> D\<^sub>D" + using assms(3) is_arg_max_linorderD[OF assms(2)] is_dec_det_def + by simp +qed +*) + +lemma ext_GS_opt_le: + assumes "(\<And>s'. s' < s \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) d)" + and "is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) a" "s' \<le> s" + and "d \<in> D\<^sub>D" + shows "is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) (d(s := a))" + using assms is_arg_max_GS_rec_step_act is_arg_max_linorderD(1) + by (cases "s = s'") (auto intro!: GS_opt_indep_high) + +lemma ex_GS_opt_le: + shows "\<exists>d. (\<forall>s' \<le> s. is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) d)" +proof (induction s rule: less_induct) + case (less x) + show ?case + proof (cases "\<exists>y. y < x") + case True + hence "{y. y < x} \<noteq> {}" + by auto + have 1: "\<And>y. y \<le> Max {y. y < x} \<longleftrightarrow> y < x" + using True + by (auto simp: Max_ge_iff[OF finite]) + obtain d where d: "is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) d" if "s'< x" for s' + using less[of "Max {y. y < x}"] 1 + by auto + obtain a where a: "is_arg_max (\<lambda>a. GS_rec_step (d(x := a)) v $ x) (\<lambda>a. a \<in> A x) a" + using finite_is_arg_max[OF finite A_ne] + by blast + hence d': "is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) (d(x := a))" if "s' < x" for s' + using d GS_opt_indep_high that is_arg_max_linorderD(1)[OF a] + by simp + have d': "is_arg_max (\<lambda>d. GS_rec_step d v $ s') (\<lambda>d. d \<in> D\<^sub>D) (d(x := a))" if "s' \<le> x" for s' + using that a is_arg_max_linorderD[OF d] True + by (fastforce intro!: ext_GS_opt_le[OF d]) + thus ?thesis + by blast + next + case False + define d where "d y = (SOME a. a \<in> A y)" for y + obtain a where a: "is_arg_max (\<lambda>a. GS_rec_step (d(x := a)) v $ x) (\<lambda>a. a \<in> A x) a" + using finite_is_arg_max[OF finite A_ne] + by blast + have 1: "y \<le> x \<Longrightarrow> y = x" for y + using False + by (meson le_neq_trans) + have "is_arg_max (\<lambda>d. GS_rec_step d v $ x) (\<lambda>d. d \<in> D\<^sub>D) (d(x := a))" + using False a SOME_is_dec_det unfolding d_def + by (fastforce intro!: is_arg_max_GS_rec_step_act) + then show ?thesis + using 1 + by blast + qed +qed + +lemma ex_GS_opt: + shows "\<exists>d. \<forall>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d" + using ex_GS_opt_le[of "Max UNIV"] + by auto + +lemma GS_rec_eq_GS_inv': "GS_rec v $ s = (\<Squnion>d\<in>D\<^sub>D. GS_inv d v $ s)" +proof - + obtain d where d: "(\<And>s. is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d)" + using ex_GS_opt by blast + have "(\<Squnion>d\<in>D\<^sub>D. GS_rec_step d v $ s) = GS_rec_step d v $ s" + using d is_arg_max_GS_rec GS_rec_eq_vec + by metis + have "(\<Squnion>d\<in>D\<^sub>D. GS_inv d v $ s) = GS_inv d v $ s" + using is_arg_max_GS_imp_splitting[OF d] + by (subst arg_max_SUP[symmetric]) auto + thus ?thesis + using GS_rec_eq_GS_inv d + by presburger +qed + +lemma GS_rec_fun_eq_GS_inv: "GS_rec_fun v s = (\<Squnion>d\<in>D\<^sub>D. GS_inv d (vec_lambda v) $ s)" + using GS_rec_eq_GS_inv'[of "vec_lambda v"] + unfolding GS_rec_def + by (auto simp: vec_lambda_inverse) + + +lemma invertible_Q_GS: "invertible\<^sub>L (Q_GS d)" for d + by (simp add: Q_mat_invertible invertible_invertible\<^sub>L_I(1)) + +lemma ex_opt_blinfun: "\<exists>d. \<forall>s. is_arg_max (\<lambda>d. ((inv\<^sub>L (Q_GS d)) (r_det\<^sub>b d + (R_GS d) v)) s) is_dec_det d" +proof - + have "GS_inv d (vec_lambda v) $ s = inv\<^sub>L (Q_GS d) (r_det\<^sub>b d + R_GS d v) s" for d s + unfolding GS_inv_def plus_bfun_def + by (simp add: invertible_Q_GS blinfun_to_matrix_mult' blinfun_to_matrix_inverse(2)[symmetric] apply_bfun_inverse) + moreover obtain d where "is_arg_max (\<lambda>d. GS_inv d (vec_lambda v) $ s) is_dec_det d" for s + using ex_GS_opt[of "vec_lambda v"] is_arg_max_GS_imp_splitting + by auto + ultimately show ?thesis + by auto +qed + +lemma GS_inv_blinfun_to_matrix: "((inv\<^sub>L (Q_GS d)) (r_det\<^sub>b d + R_GS d v)) = Bfun (vec_nth (GS_inv d (vec_lambda v)))" + unfolding GS_inv_def plus_bfun_def + by (auto simp: invertible_Q_GS blinfun_to_matrix_inverse(2)[symmetric] blinfun_to_matrix_mult'' apply_bfun_inverse ) + +lemma norm_GS_QR_le_disc: "norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d) \<le> l" +proof - + have "norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d) \<le> norm (inv\<^sub>L ((\<lambda>_. id_blinfun) d) o\<^sub>L (l *\<^sub>R \\<^sub>1 (mk_dec_det d))) " + proof (rule norm_splitting_le[of "mk_dec_det d"], goal_cases) + case 1 + then show ?case + unfolding is_splitting_blin_def' + by (auto simp: nonneg_id_blinfun blinfun_to_matrix_scaleR nonneg_\\<^sub>1 scaleR_nonneg_nonneg) + next + case 3 + then show ?case + unfolding R_mat_def P_upper_def Finite_Cartesian_Product.less_eq_vec_def + using nonneg_P_dec + by (auto simp: P_dec_def nonneg_matrix_nonneg blinfun_to_matrix_scaleR) + qed (auto simp: splitting_gauss) + also have "\<dots> = norm ((l *\<^sub>R \\<^sub>1 (mk_dec_det d)))" + by auto + also have "\<dots> \<le> l" + by auto + finally show ?thesis. +qed + +sublocale GS: MDP_QR A K r l Q_GS R_GS + rewrites "GS.\<L>\<^sub>b_split = GS_rec_fun\<^sub>b" +proof - + have "(\<Squnion>d\<in>D\<^sub>D. norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d)) < 1" + using norm_GS_QR_le_disc ex_dec_det + by (fastforce intro: le_less_trans[of _ l 1] intro!: cSUP_least) + thus "MDP_QR A K r l Q_GS R_GS" + by unfold_locales (auto simp: splitting_gauss ex_opt_blinfun) + thus "MDP_QR.\<L>\<^sub>b_split A r Q_GS R_GS = GS_rec_fun\<^sub>b" + by (fastforce simp: MDP_QR.\<L>\<^sub>b_split.rep_eq MDP_QR.\<L>_split_def GS_rec_fun\<^sub>b.rep_eq GS_rec_fun_eq_GS_inv GS_inv_blinfun_to_matrix) +qed + +abbreviation "gs_measure \<equiv> (\<lambda>(eps, v). + if v = \<nu>\<^sub>b_opt \<or> l = 0 + then 0 + else nat (ceiling (log (1/l) (dist v \<nu>\<^sub>b_opt) - log (1/l) (eps * (1-l) / (8 * l)))))" + +lemma dist_\<L>\<^sub>b_split_lt_dist_opt: "dist v (GS_rec_fun\<^sub>b v) \<le> 2 * dist v \<nu>\<^sub>b_opt" +proof - + have le1: "dist v (GS_rec_fun\<^sub>b v) \<le> dist v \<nu>\<^sub>b_opt + dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt" + by (simp add: dist_triangle dist_commute) + have le2: "dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt \<le> GS.QR_disc * dist v \<nu>\<^sub>b_opt" + using GS.\<L>\<^sub>b_split_contraction GS.\<L>\<^sub>b_split_fix + by (metis (no_types, lifting)) + show ?thesis + using mult_right_mono[of GS.QR_disc 1] GS.QR_contraction + by (fastforce intro!: order.trans[OF le2] order.trans[OF le1]) +qed + +lemma GS_QR_disc_le_disc: "GS.QR_disc \<le> l" + using norm_GS_QR_le_disc ex_dec_det + by (fastforce intro!: cSUP_least) + +lemma gs_rel_dec: + assumes "l \<noteq> 0" "GS_rec_fun\<^sub>b v \<noteq> \<nu>\<^sub>b_opt" + shows "\<lceil>log (1 / l) (dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt) - c\<rceil> < \<lceil>log (1 / l) (dist v \<nu>\<^sub>b_opt) - c\<rceil>" +proof - + have "log (1 / l) (dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (l * dist v \<nu>\<^sub>b_opt) - c" + using GS.\<L>\<^sub>b_split_contraction[of _ "\<nu>\<^sub>b_opt"] GS.QR_contraction norm_GS_QR_le_disc disc_lt_one GS_QR_disc_le_disc + by (fastforce simp: assms less_le intro!: log_le order.trans[OF GS.\<L>\<^sub>b_split_contraction[of v "\<nu>\<^sub>b_opt", simplified]] mult_right_mono) + also have "\<dots> = log (1 / l) l + log (1/l) (dist v \<nu>\<^sub>b_opt) - c" + using assms disc_lt_one + by (auto simp: less_le intro!: log_mult) + also have "\<dots> = -(log (1 / l) (1/l)) + (log (1/l) (dist v \<nu>\<^sub>b_opt)) - c" + using assms disc_lt_one + by (subst log_inverse[symmetric]) (auto simp: less_le right_inverse_eq) + also have "\<dots> = (log (1/l) (dist v \<nu>\<^sub>b_opt)) - 1 - c" + using assms order.strict_implies_not_eq[OF disc_lt_one] + by (auto intro!: log_eq_one neq_le_trans) + finally have "log (1 / l) (dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (dist v \<nu>\<^sub>b_opt) - 1 - c" . + thus ?thesis + by linarith +qed + +function gs_iteration :: "real \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" where + "gs_iteration eps v = + (if 2 * l * dist v (GS_rec_fun\<^sub>b v) < eps * (1-l) \<or> eps \<le> 0 then GS_rec_fun\<^sub>b v else gs_iteration eps (GS_rec_fun\<^sub>b v))" + by auto +termination +proof (relation "Wellfounded.measure gs_measure", (simp; fail), cases "l = 0") + case False + fix eps v + assume h: "\<not> (2 * l * dist v (GS_rec_fun\<^sub>b v) < eps * (1 - l) \<or> eps \<le> 0)" + show "((eps, GS_rec_fun\<^sub>b v), eps, v) \<in> Wellfounded.measure gs_measure" + proof - + have gt_zero[simp]: "l \<noteq> 0" "eps > 0" and dist_ge: "eps * (1 - l) \<le> dist v (GS_rec_fun\<^sub>b v) * (2 * l)" + using h + by (auto simp: algebra_simps) + have v_not_opt: "v \<noteq> \<nu>\<^sub>b_opt" + using h + by auto + have "log (1 / l) (eps * (1 - l) / (8 * l)) < log (1 / l) (dist v \<nu>\<^sub>b_opt)" + proof (intro log_less) + show "1 < 1 / l" + by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans) + show "0 < eps * (1 - l) / (8 * l)" + by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans) + show "eps * (1 - l) / (8 * l) < dist v \<nu>\<^sub>b_opt" + using dist_pos_lt[OF v_not_opt] dist_\<L>\<^sub>b_split_lt_dist_opt[of v] gt_zero zero_le_disc + mult_strict_left_mono[of "dist v (GS_rec_fun\<^sub>b v)" "(4 * dist v \<nu>\<^sub>b_opt)" l] + by (intro mult_imp_div_pos_less le_less_trans[OF dist_ge], argo+) + qed + thus ?thesis + using gs_rel_dec h + by auto + qed +qed auto + + +lemma THE_fix_GS_rec_fun\<^sub>b: "(THE v. GS_rec_fun\<^sub>b v = v) = \<nu>\<^sub>b_opt" + using GS.\<L>\<^sub>b_lim(1) GS.\<L>\<^sub>b_split_fix + by blast+ + +text \<open> +The distance between an estimate for the value and the optimal value can be bounded with respect to +the distance between the estimate and the result of applying it to @{const \<L>\<^sub>b} +\<close> +lemma contraction_\<L>_split_dist: "(1 - l) * dist v \<nu>\<^sub>b_opt \<le> dist v (GS_rec_fun\<^sub>b v)" + using GS_QR_disc_le_disc + by (fastforce + simp: THE_fix_GS_rec_fun\<^sub>b + intro: order.trans[OF _ contraction_dist, of _ l] order.trans[OF GS.\<L>\<^sub>b_split_contraction] mult_right_mono)+ + +lemma dist_\<L>\<^sub>b_split_opt_eps: + assumes "eps > 0" "2 * l * dist v (GS_rec_fun\<^sub>b v) < eps * (1-l)" + shows "dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt < eps / 2" +proof - + have "dist v \<nu>\<^sub>b_opt \<le> dist v (GS_rec_fun\<^sub>b v) / (1 - l)" + using contraction_\<L>_split_dist + by (simp add: mult.commute pos_le_divide_eq) + hence "2 * l * dist v \<nu>\<^sub>b_opt \<le> 2 * l * (dist v (GS_rec_fun\<^sub>b v) / (1 - l))" + using contraction_\<L>_dist assms mult_le_cancel_left_pos[of "2 * l"] + by (fastforce intro!: mult_left_mono[of _ _ "2 * l"]) + hence "2 * l * dist v \<nu>\<^sub>b_opt < eps" + by (auto simp: assms(2) pos_divide_less_eq intro: order.strict_trans1) + hence "dist v \<nu>\<^sub>b_opt * l < eps / 2" + by argo + hence *: "l * dist v \<nu>\<^sub>b_opt < eps / 2" + by (auto simp: algebra_simps) + show "dist (GS_rec_fun\<^sub>b v) \<nu>\<^sub>b_opt < eps / 2" + using GS.\<L>\<^sub>b_split_contraction[of v \<nu>\<^sub>b_opt] order.trans mult_right_mono[OF GS_QR_disc_le_disc zero_le_dist] + by (fastforce intro!: le_less_trans[OF _ *]) +qed +end + +context MDP_ord +begin + +lemma is_am_GS_inv_extend': + assumes "(\<And>s. s < x \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d)" + assumes "is_arg_max (\<lambda>d. GS_rec_step d v $ x) (\<lambda>d. d \<in> D\<^sub>D) (d(x := a))" + assumes "s \<le> x" "d \<in> D\<^sub>D" + shows "is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (d(x := a))" +proof - + have a: "a \<in> A x" using assms(2) unfolding is_arg_max_linorder is_dec_det_def by (auto split: if_splits) + have *: "\<exists>y. y < x \<Longrightarrow> s\<le>Max {y. y < x} \<longleftrightarrow> s < x" for x s :: 's + by (auto simp: linorder_class.Max_ge_iff[OF finite]) + have "(\<And>s. s < x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) d)" + using is_arg_max_gs_iff[OF assms(4), of "Max {y. y < x}"] assms(1) + by (cases "\<exists>y. y < x") (auto simp: *) + hence "(\<And>s. s < x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (d(x := a)))" + using GS_opt_indep_high a by auto + hence "(\<And>s. s \<le> x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (d(x := a)))" + using assms(2) antisym_conv1 by blast + thus ?thesis + using is_arg_max_gs_iff[of "d(x := a)" s] assms(4) assms a + by (intro is_arg_max_GS_imp_splitting') auto +qed + +definition "opt_policy_gs' d v s = (LEAST a. is_arg_max (\<lambda>a. GS_rec_step (d(s := a)) v $ s) (\<lambda>a. a \<in> A s) a)" + +definition "GS_iter a v s = r (s, a) + l * (\<Sum>s' \<in> UNIV. pmf (K(s,a)) s' * v $ s')" + +definition "GS_iter_max v s = (\<Squnion>a \<in> A s. GS_iter a v s)" + +lemma GS_rec_eq_iter: + assumes "\<And>s. s < k \<Longrightarrow> v' $ s = GS_rec v $ s" "\<And>s. k \<le> s \<Longrightarrow> v' $ s = v $ s" + shows "GS_rec_step (d(k := a)) v $ k = GS_iter a v' k" +proof - + have "(P_lower d *v GS_rec v) $ k = (P_lower d *v v') $ k" for d + using slt_P_lower assms + by (auto intro!: strict_lower_triangular_mat_mult) + moreover have "(P_upper d *v v) $ k = (P_upper d *v v') $ k" for d + unfolding P_upper_def using assms + by (auto simp: matrix_vector_mult_def if_distrib[of "\<lambda>x. x * _ $ _"] cong: if_cong) + moreover have "P_lower d + P_upper d = P_dec d" for d + by (auto simp: P_lower_def P_upper_def Finite_Cartesian_Product.vec_eq_iff) + ultimately show ?thesis + unfolding vector_add_component[symmetric] matrix_vector_mult_diff_rdistrib[symmetric] GS_rec_step_def + matrix_vector_mult_def P_dec_elem P_lower_def P_upper_def GS_iter_def + by (fastforce simp: sum.distrib[symmetric] intro!: sum.cong) +qed + +lemma GS_rec_eq_iter_max: + assumes "\<And>s. s < k \<Longrightarrow> v' $ s = GS_rec v $ s" "\<And>s. k \<le> s \<Longrightarrow> v' $ s = v $ s" + shows "GS_rec v $ k = GS_iter_max v' k" + using GS_rec_eq_iter[OF assms] GS_rec_eq'[of _ _ undefined] GS_iter_max_def + by auto + +definition "GS_iter_arg_max v s = (LEAST a. is_arg_max (\<lambda>a. GS_iter a v s) (\<lambda>a. a \<in> A s) a)" + +definition "GS_rec_am_code v d s = foldl (\<lambda>vd s. vd(s := (GS_iter_max (\<chi> s. fst (vd s)) s, GS_iter_arg_max (\<chi> s. fst (vd s)) s))) (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..s}) s" +definition "GS_rec_am_code' v d s = foldl (\<lambda>vd s. vd(s := (GS_iter_max (\<chi> s. fst (vd s)) s, GS_iter_arg_max (\<chi> s. fst (vd s)) s))) (\<lambda>s. (v $ s, d s)) (sorted_list_of_set UNIV) s" + +lemma GS_rec_am_code': "GS_rec_am_code = GS_rec_am_code'" +proof - + have *: "sorted_list_of_set UNIV = sorted_list_of_set{..s} @ sorted_list_of_set{s<..}" for s :: 's + using sorted_list_of_set_split'[OF finite, of UNIV s] + by (auto simp: atMost_def greaterThan_def) + have "GS_rec_am_code v d s = GS_rec_am_code' v d s" for v d s + unfolding GS_rec_am_code_def GS_rec_am_code'_def *[of s] + by (fastforce intro!: foldl_upd_notin'[symmetric]) + thus ?thesis + by blast +qed + +lemma opt_policy_gs'_eq_GS_iter: + assumes "\<And>s. s < k \<Longrightarrow> v' $ s = GS_rec v $ s" "\<And>s. k \<le> s \<Longrightarrow> v' $ s = v $ s" + shows "opt_policy_gs' d v k = GS_iter_arg_max v' k" + unfolding opt_policy_gs'_def GS_iter_arg_max_def + by (subst GS_rec_eq_iter[OF assms, of k d]) auto + +lemma opt_policy_gs'_eq_GS_iter': + "opt_policy_gs' d v k = GS_iter_arg_max (\<chi> s. if s < k then GS_rec v $ s else v $ s) k" + using opt_policy_gs'_eq_GS_iter + by (simp add: leD) + +lemma opt_policy_gs'_is_dec_det: "opt_policy_gs' d v \<in> D\<^sub>D" + unfolding opt_policy_gs'_def is_dec_det_def + using finite_is_arg_max[OF finite A_ne] + by (auto intro: LeastI2_ex) + +lemma opt_policy_gs'_is_arg_max: "is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" +proof (induction arbitrary: d rule: less_induct) + case (less x) + have "s < x \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" for d s + using less + by auto + hence *:"s < x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" for d s + by (intro is_arg_max_GS_imp_splitting''') auto + have "is_arg_max (\<lambda>a. GS_rec_step (d(x := a)) v $ x) (\<lambda>a. a \<in> A x) (opt_policy_gs' d v x)" for d + unfolding opt_policy_gs'_def + using finite_is_arg_max[OF _ A_ne] + by (auto intro: LeastI_ex) + hence "is_arg_max (\<lambda>d. GS_rec_step d v $ x) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" for d + using opt_policy_gs'_is_dec_det + by (intro is_arg_max_GS_rec_step_act') auto + hence "s \<le> x \<Longrightarrow> is_arg_max (\<lambda>d. GS_rec_step d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" for d s + using * + by (auto simp: order.order_iff_strict) + hence "s \<le> x \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v $ s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs' d v)" for d s + using is_arg_max_GS_imp_splitting' + by blast + thus ?case + by blast +qed + +lemma "GS_rec_am_code v d s = (GS_rec v $ s, opt_policy_gs' d v s)" +proof (induction s arbitrary: d rule: less_induct) + case (less x) + show ?case + proof (cases "\<exists>x'. x' < x") + case True + let ?f = "(\<lambda>vd s. vd(s := (GS_iter_max (\<chi> s. fst (vd s)) s, GS_iter_arg_max (\<chi> s. fst (vd s)) s)))" + define x' where "x' = Max {x'. x' < x}" + let ?old = "(foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}))" + have 1: "s < x \<Longrightarrow> (s \<notin> set (sorted_list_of_set {s' \<in> {..x'}. s < s'}))" for s :: 's + by auto + have "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {s' \<in> {..x'}. s' \<le> s} @ sorted_list_of_set {s' \<in> {..x'}. s < s'}) s" for s + by (subst sorted_list_of_set_split'[symmetric, OF finite]) blast + hence "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {s' \<in> {..x'}. s' \<le> s}) s" for s + using foldl_upd_notin'[OF 1] + by fastforce + hence 1: "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..s}) s" for s + unfolding x'_def + using True + by (auto simp: atMost_def Max_ge_iff[OF finite]) meson + have fst_IH: "fst (?old s) = GS_rec v $ s" if "s < x" for s + using 1[OF that] less[unfolded GS_rec_am_code_def] that + by auto + have fst_IH': "fst (?old s) = v $ s" if "x \<le> s" for s + using True that + by (subst foldl_upd_notin) (auto simp: x'_def Max_ge_iff) + have fst_IH'': "fst (?old s) = (if s < x then GS_rec v $ s else v $ s)" for s + using fst_IH fst_IH' by auto + have "foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x}) = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'} @ sorted_list_of_set {x})" + proof - + have *: "{x'. x' < x} \<noteq> {}" using True by auto + hence **: "{..x'} = {y \<in> {..x}. y < x}" "{x} = {y \<in> {..x}. x \<le> y}" + by (auto simp: x'_def Max_ge_iff[OF finite *]) + show ?thesis + unfolding ** sorted_list_of_set_split[symmetric, OF finite] by auto + qed + also have "\<dots> = ?f (foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'})) x" + by auto + also have "\<dots> = (?old (x := (GS_rec v $ x, GS_iter_arg_max (\<chi> s. fst (?old s)) x)))" + proof (subst GS_rec_eq_iter_max[of _ "(\<chi> s. fst (?old s))"], goal_cases) + case (1 s) + then show ?case + using fst_IH by auto + next + case (2 s) + then show ?case + unfolding vec_lambda_inverse[OF UNIV_I] + using True + by (subst foldl_upd_notin) (auto simp: x'_def Max_ge_iff[OF finite]) + qed auto + also have "\<dots> = (?old (x := (GS_rec v $ x, opt_policy_gs' d v x)))" + by (auto simp: fst_IH'' opt_policy_gs'_eq_GS_iter') + finally have "foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x}) = (?old (x := (GS_rec v $ x, opt_policy_gs' d v x)))". + thus ?thesis + unfolding GS_rec_am_code_def + by auto + next + case False + hence "{..x} = {x}" + by (auto simp: not_less antisym) + thus ?thesis + unfolding GS_rec_am_code_def + using opt_policy_gs'_eq_GS_iter[of x v] GS_rec_eq_iter_max[of x v] False + by fastforce + qed +qed + +lemma GS_rec_am_code_eq: "GS_rec_am_code v d s = (GS_rec v $ s, opt_policy_gs' d v s)" +proof (induction s arbitrary: d rule: less_induct) + case (less x) + show ?case + proof (cases "\<exists>x'. x' < x") + case True + let ?f = "(\<lambda>vd s. vd(s := (GS_iter_max (\<chi> s. fst (vd s)) s, GS_iter_arg_max (\<chi> s. fst (vd s)) s)))" + define x' where "x' = Max {x'. x' < x}" + let ?old = "(foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}))" + have 1: "s < x \<Longrightarrow> (s \<notin> set (sorted_list_of_set {s' \<in> {..x'}. s < s'}))" for s :: 's + by auto + have "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {s' \<in> {..x'}. s' \<le> s} @ sorted_list_of_set {s' \<in> {..x'}. s < s'}) s" for s + by (subst sorted_list_of_set_split'[symmetric, OF finite]) blast + hence "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {s' \<in> {..x'}. s' \<le> s}) s" for s + using foldl_upd_notin'[OF 1] + by fastforce + hence 1: "s < x \<Longrightarrow> foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'}) s = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..s}) s" for s + unfolding x'_def + using True + by (auto simp: atMost_def Max_ge_iff[OF finite]) meson + have fst_IH: "fst (?old s) = GS_rec v $ s" if "s < x" for s + unfolding 1[OF that] less[unfolded GS_rec_am_code_def, OF that] + by auto + have fst_IH': "fst (?old s) = v $ s" if "x \<le> s" for s + using True that + by (subst foldl_upd_notin) (auto simp: x'_def atMost_def Max_ge_iff[OF finite]) + have fst_IH'': "fst (?old s) = (if s < x then GS_rec v $ s else v $ s)" for s + using fst_IH fst_IH' by auto + have "foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x}) = foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'} @ sorted_list_of_set {x})" + proof - + have *: "{x'. x' < x} \<noteq> {}" using True by auto + hence 1: "{..x'} = {y \<in> {..x}. y < x}" + by (auto simp: x'_def Max_ge_iff[OF finite *]) + have 2: "{x} = {y \<in> {..x}. x \<le> y}" + by auto + thus ?thesis + unfolding 1 2 sorted_list_of_set_split[symmetric, OF finite] by auto + qed + also have "\<dots> = ?f (foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x'})) x" + by auto + also have "\<dots> = (?old (x := (GS_rec v $ x, GS_iter_arg_max (\<chi> s. fst (?old s)) x)))" + proof (subst GS_rec_eq_iter_max[of _ "(\<chi> s. fst (?old s))"], goal_cases) + case (2 s) + then show ?case + unfolding vec_lambda_inverse[OF UNIV_I] + using True + by (subst foldl_upd_notin) (auto simp: x'_def Max_ge_iff[OF finite]) + qed (auto simp: fst_IH) + also have "\<dots> = (?old (x := (GS_rec v $ x, opt_policy_gs' d v x)))" + by (auto simp: fst_IH'' opt_policy_gs'_eq_GS_iter') + finally have "foldl ?f (\<lambda>s. (v $ s, d s)) (sorted_list_of_set {..x}) = (?old (x := (GS_rec v $ x, opt_policy_gs' d v x)))". + thus ?thesis + unfolding GS_rec_am_code_def + by auto + next + case (False) + hence "{..x} = {x}" + by (auto simp: not_less antisym) + hence *: "(sorted_list_of_set {..x}) = [x]" + by auto + show ?thesis + unfolding GS_rec_am_code_def + using opt_policy_gs'_eq_GS_iter[of x v] GS_rec_eq_iter_max[of x v] False + by (fastforce simp: *) + qed +qed + +definition GS_rec_iter_arg_max where + "GS_rec_iter_arg_max v s = (LEAST a. is_arg_max (\<lambda>a. r (s, a) + l * (\<Sum>s' \<in> UNIV. pmf (K (s,a)) s' * v s')) (\<lambda>a. a \<in> A s) a)" +definition "opt_policy_gs v s = (LEAST a. is_arg_max (\<lambda>a. GS_rec_fun_inner v s a) (\<lambda>a. a \<in> A s) a)" + +lemma opt_policy_gs_eq': "opt_policy_gs v = opt_policy_gs' d (vec_lambda v)" + unfolding opt_policy_gs_def opt_policy_gs'_def GS_rec_fun_inner_def GS_rec_step_elem + by (auto simp: GS_rec_fun\<^sub>b.rep_eq GS_rec_def vec_lambda_inverse) + +declare gs_iteration.simps[simp del] + +lemma gs_iteration_error: + assumes "eps > 0" + shows "dist (gs_iteration eps v) \<nu>\<^sub>b_opt < eps / 2" + using assms dist_\<L>\<^sub>b_split_opt_eps gs_iteration.simps + by (induction eps v rule: gs_iteration.induct) auto + + +lemma GS_rec_fun_inner_vec: "GS_rec_fun_inner v s a = GS_rec_step (d(s := a)) (vec_lambda v) $ s" + unfolding GS_rec_step_elem + by (auto simp: GS_rec_fun_inner_def GS_rec_def GS_rec_fun\<^sub>b.rep_eq vec_lambda_inverse) + +lemma find_policy_error_bound_gs: + assumes "eps > 0" "2 * l * dist v (GS_rec_fun\<^sub>b v) < eps * (1-l)" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (opt_policy_gs (GS_rec_fun\<^sub>b v)))) \<nu>\<^sub>b_opt < eps" +proof (rule GS.find_policy_QR_error_bound[OF assms(1)]) + have "2 * GS.QR_disc * dist v (GS_rec_fun\<^sub>b v) \<le> 2 * l * dist v (GS_rec_fun\<^sub>b v)" + using GS_QR_disc_le_disc + by (auto intro!: mult_right_mono) + also have "\<dots> < eps * (1-l)" using assms by auto + also have "\<dots> \<le> eps * (1 - GS.QR_disc)" + using assms GS_QR_disc_le_disc + by (auto intro!: mult_left_mono) + finally show "2 * GS.QR_disc * dist v (GS_rec_fun\<^sub>b v) < eps * (1 - GS.QR_disc)". +next + obtain d where d: "is_dec_det d" + using ex_dec_det by blast + show "is_arg_max (\<lambda>d. apply_bfun (GS.L_split d (GS_rec_fun\<^sub>b v)) s) (\<lambda>d. d \<in> D\<^sub>D) (opt_policy_gs (GS_rec_fun\<^sub>b v))" for s + unfolding opt_policy_gs_eq'[of _ d] GS_inv_blinfun_to_matrix + using opt_policy_gs'_is_arg_max + by simp +qed + +definition "vi_gs_policy eps v = opt_policy_gs (gs_iteration eps v)" + +lemma vi_gs_policy_opt: + assumes "0 < eps" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (vi_gs_policy eps v))) \<nu>\<^sub>b_opt < eps" + unfolding vi_gs_policy_def + using assms +proof (induction eps v rule: gs_iteration.induct) + case (1 v) + then show ?case + using find_policy_error_bound_gs + by (subst gs_iteration.simps) auto +qed + +lemma GS_rec_iter_eq_iter_max: "GS_rec_iter v = GS_iter_max (vec_lambda v)" + unfolding GS_rec_iter_def GS_iter_max_def GS_iter_def + by auto +end + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/Value_Iteration.thy b/thys/MDP-Algorithms/Value_Iteration.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/Value_Iteration.thy @@ -0,0 +1,351 @@ +(* Author: Maximilian Schäffeler *) + +theory Value_Iteration + imports "MDP-Rewards.MDP_reward" +begin + +context MDP_att_\<L> +begin + +section \<open>Value Iteration\<close> +text \<open> +In the previous sections we derived that repeated application of @{const "\<L>\<^sub>b"} to any bounded +function from states to the reals converges to the optimal value of the MDP @{const "\<nu>\<^sub>b_opt"}. + +We can turn this procedure into an algorithm that computes not only an approximation of +@{const "\<nu>\<^sub>b_opt"} but also a policy that is arbitrarily close to optimal. + +Most of the proofs rely on the assumption that the supremum in @{const "\<L>\<^sub>b"} can always be attained. +\<close> + +text \<open> +The following lemma shows that the relation we use to prove termination of the value iteration +algorithm decreases in each step. +In essence, the distance of the estimate to the optimal value decreases by a factor of at +least @{term l} per iteration.\<close> + + +lemma vi_rel_dec: + assumes "l \<noteq> 0" "\<L>\<^sub>b v \<noteq> \<nu>\<^sub>b_opt" + shows "\<lceil>log (1 / l) (dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt) - c\<rceil> < \<lceil>log (1 / l) (dist v \<nu>\<^sub>b_opt) - c\<rceil>" +proof - + have "log (1 / l) (dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (l * dist v \<nu>\<^sub>b_opt) - c" + using contraction_\<L>[of _ "\<nu>\<^sub>b_opt"] disc_lt_one + by (auto simp: assms less_le intro: log_le) + also have "\<dots> = log (1 / l) l + log (1/l) (dist v \<nu>\<^sub>b_opt) - c" + using assms disc_lt_one + by (auto simp: less_le intro!: log_mult) + also have "\<dots> = -(log (1 / l) (1/l)) + (log (1/l) (dist v \<nu>\<^sub>b_opt)) - c" + using assms disc_lt_one + by (subst log_inverse[symmetric]) (auto simp: less_le right_inverse_eq) + also have "\<dots> = (log (1/l) (dist v \<nu>\<^sub>b_opt)) - 1 - c" + using assms order.strict_implies_not_eq[OF disc_lt_one] + by (auto intro!: log_eq_one neq_le_trans) + finally have "log (1 / l) (dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (dist v \<nu>\<^sub>b_opt) - 1 - c" . + thus ?thesis + by linarith +qed + +lemma dist_\<L>\<^sub>b_lt_dist_opt: "dist v (\<L>\<^sub>b v) \<le> 2 * dist v \<nu>\<^sub>b_opt" +proof - + have le1: "dist v (\<L>\<^sub>b v) \<le> dist v \<nu>\<^sub>b_opt + dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt" + by (simp add: dist_triangle dist_commute) + have le2: "dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt \<le> l * dist v \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_opt contraction_\<L> + by metis + show ?thesis + using mult_right_mono[of l 1] disc_lt_one + by (fastforce intro!: order.trans[OF le2] order.trans[OF le1]) +qed + +abbreviation "term_measure \<equiv> (\<lambda>(eps, v). + if v = \<nu>\<^sub>b_opt \<or> l = 0 + then 0 + else nat (ceiling (log (1/l) (dist v \<nu>\<^sub>b_opt) - log (1/l) (eps * (1-l) / (8 * l)))))" + +function value_iteration :: "real \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" where + "value_iteration eps v = + (if 2 * l * dist v (\<L>\<^sub>b v) < eps * (1-l) \<or> eps \<le> 0 then \<L>\<^sub>b v else value_iteration eps (\<L>\<^sub>b v))" + by auto + +termination +proof (relation "Wellfounded.measure term_measure", (simp; fail), cases "l = 0") + case False + fix eps v + assume h: "\<not> (2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l) \<or> eps \<le> 0)" + show "((eps, \<L>\<^sub>b v), eps, v) \<in> Wellfounded.measure term_measure" + proof - + have gt_zero[simp]: "l \<noteq> 0" "eps > 0" and dist_ge: "eps * (1 - l) \<le> dist v (\<L>\<^sub>b v) * (2 * l)" + using h + by (auto simp: algebra_simps) + have v_not_opt: "v \<noteq> \<nu>\<^sub>b_opt" + using h + by force + have "log (1 / l) (eps * (1 - l) / (8 * l)) < log (1 / l) (dist v \<nu>\<^sub>b_opt)" + proof (intro log_less) + show "1 < 1 / l" + by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans) + show "0 < eps * (1 - l) / (8 * l)" + by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans) + show "eps * (1 - l) / (8 * l) < dist v \<nu>\<^sub>b_opt" + using dist_pos_lt[OF v_not_opt] dist_\<L>\<^sub>b_lt_dist_opt[of v] gt_zero zero_le_disc + mult_strict_left_mono[of "dist v (\<L>\<^sub>b v)" "(4 * dist v \<nu>\<^sub>b_opt)" l] + by (intro mult_imp_div_pos_less le_less_trans[OF dist_ge], argo+) + qed + thus ?thesis + using vi_rel_dec h + by auto + qed +qed auto + +text \<open> +The distance between an estimate for the value and the optimal value can be bounded with respect to +the distance between the estimate and the result of applying it to @{const \<L>\<^sub>b} +\<close> +lemma contraction_\<L>_dist: "(1 - l) * dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b v)" + using contraction_dist contraction_\<L> disc_lt_one zero_le_disc + by fastforce + +lemma dist_\<L>\<^sub>b_opt_eps: + assumes "eps > 0" "2 * l * dist v (\<L>\<^sub>b v) < eps * (1-l)" + shows "dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt < eps / 2" +proof - + have "dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b v) / (1 - l)" + using contraction_\<L>_dist + by (simp add: mult.commute pos_le_divide_eq) + hence "2 * l * dist v \<nu>\<^sub>b_opt \<le> 2 * l * (dist v (\<L>\<^sub>b v) / (1 - l))" + using contraction_\<L>_dist assms mult_le_cancel_left_pos[of "2 * l"] + by (fastforce intro!: mult_left_mono[of _ _ "2 * l"]) + hence "2 * l * dist v \<nu>\<^sub>b_opt < eps" + by (auto simp: assms(2) pos_divide_less_eq intro: order.strict_trans1) + hence "dist v \<nu>\<^sub>b_opt * l < eps / 2" + by argo + hence "l * dist v \<nu>\<^sub>b_opt < eps / 2" + by (auto simp: algebra_simps) + thus "dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt < eps / 2" + using contraction_\<L>[of v \<nu>\<^sub>b_opt] + by auto +qed + +text \<open> +The estimates above allow to give a bound on the error of @{const value_iteration}. +\<close> +declare value_iteration.simps[simp del] + +lemma value_iteration_error: + assumes "eps > 0" + shows "dist (value_iteration eps v) \<nu>\<^sub>b_opt < eps / 2" + using assms dist_\<L>\<^sub>b_opt_eps value_iteration.simps + by (induction eps v rule: value_iteration.induct) auto + +text \<open> +After the value iteration terminates, one can easily obtain a stationary deterministic +epsilon-optimal policy. + +Such a policy does not exist in general, attainment of the supremum in @{const \<L>\<^sub>b} is required. +\<close> +definition "find_policy (v :: 's \<Rightarrow>\<^sub>b real) s = arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s)" + +definition "vi_policy eps v = find_policy (value_iteration eps v)" + +text \<open> +We formalize the attainment of the supremum using a predicate @{const has_arg_max}. +\<close> + +abbreviation "vi u n \<equiv> (\<L>\<^sub>b ^^n) u" + +lemma \<L>\<^sub>b_iter_mono: + assumes "u \<le> v" shows "vi u n \<le> vi v n" + using assms \<L>\<^sub>b_mono + by (induction n) auto + +lemma + assumes "vi v (Suc n) \<le> vi v n" + shows "vi v (Suc n + m) \<le> vi v (n + m)" +proof - + have "vi v (Suc n + m) = vi (vi v (Suc n)) m" + by (simp add: Groups.add_ac(2) funpow_add funpow_swap1) + also have "... \<le> vi (vi v n) m" + using \<L>\<^sub>b_iter_mono[OF assms] + by auto + also have "... = vi v (n + m)" + by (simp add: add.commute funpow_add) + finally show ?thesis . +qed + + +lemma + assumes "vi v n \<le> vi v (Suc n)" + shows "vi v (n + m) \<le> vi v (Suc n + m)" +proof - + have "vi v (n + m) \<le> vi (vi v n) m" + by (simp add: Groups.add_ac(2) funpow_add funpow_swap1) + also have "\<dots> \<le> vi v (Suc n + m)" + using \<L>\<^sub>b_iter_mono[OF assms] + by (auto simp only: add.commute funpow_add o_apply) + finally show ?thesis . +qed + +(* 6.3.1 *) +(* a) *) +lemma "vi v \<longlonglongrightarrow> \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_lim. + +lemma "(\<lambda>n. dist (vi v (Suc n)) (vi v n)) \<longlonglongrightarrow> 0" + using thm_6_3_1_b_aux[of v] + by (auto simp only: dist_commute[of "((\<L>\<^sub>b ^^ Suc _) v)"]) + + + +end + +context MDP_att_\<L> +begin + +text \<open> +The error of the resulting policy is bounded by the distance from its value to the value computed +by the value iteration plus the error in the value iteration itself. +We show that both are less than @{term "eps / 2"} when the algorithm terminates. +\<close> +lemma find_policy_error_bound: + assumes "eps > 0" "2 * l * dist v (\<L>\<^sub>b v) < eps * (1-l)" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (find_policy (\<L>\<^sub>b v)))) \<nu>\<^sub>b_opt < eps" +proof - + let ?d = "mk_dec_det (find_policy (\<L>\<^sub>b v))" + let ?p = "mk_stationary ?d" + (* shorter proof: by (auto simp: arg_max_SUP[OF find_policy_QR_is_arg_max] \<L>\<^sub>b_split.rep_eq \<L>_split_def )*) + have L_eq_\<L>\<^sub>b: "L (mk_dec_det (find_policy v)) v = \<L>\<^sub>b v" for v + unfolding find_policy_def + proof (intro antisym) + show "L (mk_dec_det (\<lambda>s. arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s))) v \<le> \<L>\<^sub>b v" + using Sup_att has_arg_max_arg_max abs_L_le + unfolding \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det less_eq_bfun_def arg_max_on_def is_dec_det_def max_L_ex_def + by (auto intro!: cSUP_upper bounded_imp_bdd_above boundedI[of _ "r\<^sub>M + l * norm v"]) + next + show "\<L>\<^sub>b v \<le> L (mk_dec_det (\<lambda>s. arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s))) v" + unfolding less_eq_bfun_def \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det + using Sup_att ex_dec_det + by (auto intro!: cSUP_least app_arg_max_ge simp: L_eq_L\<^sub>a_det max_L_ex_def is_dec_det_def) + qed + have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) = dist (L ?d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b v)" + using L_\<nu>_fix + by force + also have "\<dots> \<le> dist (L ?d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)" + using dist_triangle + by blast + also have "\<dots> = dist (L ?d (\<nu>\<^sub>b ?p)) (L ?d (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)" + by (auto simp: L_eq_\<L>\<^sub>b) + also have "\<dots> \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + l * dist (\<L>\<^sub>b v) v" + using contraction_\<L> contraction_L + by (fastforce intro!: add_mono) + finally have aux: "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + l * dist (\<L>\<^sub>b v) v" . + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) - l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> l * dist (\<L>\<^sub>b v) v" + by auto + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1 - l) \<le> l * dist (\<L>\<^sub>b v) v" + by argo + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1-l) \<le> 2 * (l * dist (\<L>\<^sub>b v) v)" + using zero_le_disc mult_left_mono + by auto + also have "\<dots> \<le> eps * (1-l)" + using assms + by (auto intro!: mult_left_mono simp: dist_commute pos_divide_le_eq) + finally have "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1 - l) \<le> eps * (1 - l)" . + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> eps" + using disc_lt_one mult_right_le_imp_le + by auto + moreover have "2 * dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt < eps" + using dist_\<L>\<^sub>b_opt_eps assms + by fastforce + moreover have "dist (\<nu>\<^sub>b ?p) \<nu>\<^sub>b_opt \<le> dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt" + using dist_triangle + by blast + ultimately show ?thesis + by auto +qed + +lemma vi_policy_opt: + assumes "0 < eps" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (vi_policy eps v))) \<nu>\<^sub>b_opt < eps" + unfolding vi_policy_def + using assms +proof (induction eps v rule: value_iteration.induct) + case (1 v) + then show ?case + using find_policy_error_bound + by (subst value_iteration.simps) auto +qed + +lemma lemma_6_3_1_d: + assumes "eps > 0" + assumes "2 * l * dist (vi v (Suc n)) (vi v n) < eps * (1-l)" + shows "dist (vi v (Suc n)) \<nu>\<^sub>b_opt < eps / 2" + using dist_\<L>\<^sub>b_opt_eps assms + by (simp add: dist_commute) + +end + +context MDP_act begin + +definition "find_policy' (v :: 's \<Rightarrow>\<^sub>b real) s = arb_act (opt_acts v s)" + +definition "vi_policy' eps v = find_policy' (value_iteration eps v)" + +lemma find_policy'_error_bound: + assumes "eps > 0" "2 * l * dist v (\<L>\<^sub>b v) < eps * (1-l)" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (find_policy' (\<L>\<^sub>b v)))) \<nu>\<^sub>b_opt < eps" +proof - + let ?d = "mk_dec_det (find_policy' (\<L>\<^sub>b v))" + let ?p = "mk_stationary ?d" + have L_eq_\<L>\<^sub>b: "L (mk_dec_det (find_policy' v)) v = \<L>\<^sub>b v" for v + unfolding find_policy'_def + by (metis \<nu>_improving_imp_\<L>\<^sub>b \<nu>_improving_opt_acts) + have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) = dist (L ?d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b v)" + using L_\<nu>_fix + by force + also have "\<dots> \<le> dist (L ?d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)" + using dist_triangle + by blast + also have "\<dots> = dist (L ?d (\<nu>\<^sub>b ?p)) (L ?d (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)" + by (auto simp: L_eq_\<L>\<^sub>b) + also have "\<dots> \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + l * dist (\<L>\<^sub>b v) v" + using contraction_\<L> contraction_L + by (fastforce intro!: add_mono) + finally have aux: "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + l * dist (\<L>\<^sub>b v) v" . + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) - l * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> l * dist (\<L>\<^sub>b v) v" + by auto + hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1 - l) \<le> l * dist (\<L>\<^sub>b v) v" + by argo + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1-l) \<le> 2 * (l * dist (\<L>\<^sub>b v) v)" + using zero_le_disc mult_left_mono + by auto + also have "\<dots> \<le> eps * (1-l)" + using assms + by (auto intro!: mult_left_mono simp: dist_commute pos_divide_le_eq) + finally have "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) * (1 - l) \<le> eps * (1 - l)". + hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) \<le> eps" + using disc_lt_one mult_right_le_imp_le + by auto + moreover have "2 * dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt < eps" + using dist_\<L>\<^sub>b_opt_eps assms + by fastforce + moreover have "dist (\<nu>\<^sub>b ?p) \<nu>\<^sub>b_opt \<le> dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b v) + dist (\<L>\<^sub>b v) \<nu>\<^sub>b_opt" + using dist_triangle + by blast + ultimately show ?thesis + by auto +qed + +lemma vi_policy'_opt: + assumes "eps > 0" "l > 0" + shows "dist (\<nu>\<^sub>b (mk_stationary_det (vi_policy' eps v))) \<nu>\<^sub>b_opt < eps" + unfolding vi_policy'_def + using assms +proof (induction eps v rule: value_iteration.induct) + case (1 v) + then show ?case + using find_policy'_error_bound + by (subst value_iteration.simps) auto +qed + +end +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/code/Code_DP.thy b/thys/MDP-Algorithms/code/Code_DP.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/code/Code_DP.thy @@ -0,0 +1,526 @@ +(* Author: Maximilian Schäffeler *) + +theory Code_DP + imports + Value_Iteration + Policy_Iteration + Modified_Policy_Iteration + Splitting_Methods + +"HOL-Library.Code_Target_Numeral" +"Gauss_Jordan.Code_Generation_IArrays" +begin + +section \<open>Code Generation for MDP Algorithms\<close> + +subsection \<open>Least Argmax\<close> + +lemma least_list: + assumes "sorted xs" "\<exists>x \<in> set xs. P x" + shows "(LEAST x \<in> set xs. P x) = the (find P xs)" + using assms +proof (induction xs) + case (Cons a xs) + thus ?case + proof (cases "P a") + case False + have "(LEAST x \<in> set (a # xs). P x) = (LEAST x \<in> set xs. P x)" + using False Cons(2) + by simp metis + thus ?thesis + using False Cons + by simp + qed (auto intro: Least_equality) +qed auto + +definition "least_enum P = the (find P (sorted_list_of_set (UNIV :: ('b:: {finite, linorder}) set)))" + +lemma least_enum_eq: "\<exists>x. P x \<Longrightarrow> least_enum P = (LEAST x. P x)" + by (auto simp: least_list[symmetric] least_enum_def) + +definition "least_max_arg_max_list f init xs = + foldl (\<lambda>(am, m) x. if f x > m then (x, f x) else (am, m)) init xs" + +lemma snd_least_max_arg_max_list: + "snd (least_max_arg_max_list f (n, f n) xs) = (MAX x \<in> insert n (set xs). f x)" + unfolding least_max_arg_max_list_def +proof (induction xs arbitrary: n) + case (Cons a xs) + then show ?case + by (cases "xs = []") (fastforce simp: max.assoc[symmetric])+ +qed auto + +lemma least_max_arg_max_list_snd_fst: "snd (least_max_arg_max_list f (x, f x) xs) = f (fst (least_max_arg_max_list f (x, f x) xs))" + by (induction xs arbitrary: x) (auto simp: least_max_arg_max_list_def) + +lemma fst_least_max_arg_max_list: + fixes f :: "_ \<Rightarrow> _ :: linorder" + assumes "sorted (n#xs)" + shows "fst (least_max_arg_max_list f (n, f n) xs) + = (LEAST x. is_arg_max f (\<lambda>x. x \<in> insert n (set xs)) x)" + unfolding least_max_arg_max_list_def + using assms proof (induction xs arbitrary: n) + case Nil + then show ?case + by (auto simp: is_arg_max_def intro!: Least_equality[symmetric]) +next + case (Cons a xs) + hence "sorted (a#xs)" + by auto + then show ?case + proof (cases "f a > f n") + case True + then show ?thesis + by (fastforce simp: is_arg_max_def Cons.IH[OF \<open>sorted (a#xs)\<close>] intro!: cong[of Least, OF refl]) + next + case False + have "(LEAST b. is_arg_max f (\<lambda>x. x \<in> insert n (set (a # xs))) b) + = (LEAST b. is_arg_max f (\<lambda>x. x \<in> (set (n # xs))) b)" + proof (cases "is_arg_max f (\<lambda>x. x \<in> set (n #a# xs)) a") + case True + hence "(LEAST b. is_arg_max f (\<lambda>x. x \<in> (set (n#a # xs))) b) = n" + using Cons False + by (fastforce simp: is_arg_max_linorder intro!: Least_equality) + thus ?thesis + using False True Cons + by (fastforce simp: is_arg_max_linorder intro!: Least_equality[symmetric]) + next + case False + thus ?thesis + by (fastforce simp: not_less is_arg_max_linorder intro!: cong[of Least, OF refl]) + qed + thus ?thesis + using False Cons + by (auto simp add: Cons.IH[OF \<open>sorted (a#xs)\<close>]) + qed +qed + +definition "least_arg_max_enum f X = ( + let xs = sorted_list_of_set (X :: (_ :: {finite, linorder}) set) in + fst (least_max_arg_max_list f (hd xs, f (hd xs)) (tl xs)))" + +definition "least_max_arg_max_enum f X = ( + let xs = sorted_list_of_set (X :: (_ :: {finite, linorder}) set) in + (least_max_arg_max_list f (hd xs, f (hd xs)) (tl xs)))" + +lemma least_arg_max_enum_correct: + assumes "X \<noteq> {}" + shows " + (least_arg_max_enum (f :: _ \<Rightarrow> (_ :: linorder)) X) = (LEAST x. is_arg_max f (\<lambda>x. x \<in> X) x)" +proof - + have *: "xs \<noteq> [] \<Longrightarrow> (x = hd xs \<or> x \<in> set (tl xs)) \<longleftrightarrow> x \<in> set xs" for x xs + using list.set_sel list.exhaust_sel set_ConsD by metis + thus ?thesis + unfolding least_arg_max_enum_def + using assms + by (auto simp: Let_def fst_least_max_arg_max_list *) +qed + +lemma least_max_arg_max_enum_correct1: + assumes "X \<noteq> {}" + shows "fst (least_max_arg_max_enum (f :: _ \<Rightarrow> (_ :: linorder)) X) = (LEAST x. is_arg_max f (\<lambda>x. x \<in> X) x)" +proof - + have *: "xs \<noteq> [] \<Longrightarrow> (x = hd xs \<or> x \<in> set (tl xs)) \<longleftrightarrow> x \<in> set xs" for x xs + using list.set_sel list.exhaust_sel set_ConsD by metis + thus ?thesis + using assms + by (auto simp: least_max_arg_max_enum_def Let_def fst_least_max_arg_max_list *) +qed + +lemma least_max_arg_max_enum_correct2: + assumes "X \<noteq> {}" + shows "snd (least_max_arg_max_enum (f :: _ \<Rightarrow> (_ :: linorder)) X) = (MAX x \<in> X. f x)" +proof - + have *: "xs \<noteq> [] \<Longrightarrow> insert (hd xs) (set (tl xs)) = set xs" for xs + using list.exhaust_sel list.simps(15) + by metis + show ?thesis + using assms + by (auto simp: least_max_arg_max_enum_def Let_def snd_least_max_arg_max_list *) +qed + +subsection \<open>Functions as Vectors\<close> +typedef ('a, 'b) Fun = "UNIV :: ('a \<Rightarrow> 'b) set" + by blast + +setup_lifting type_definition_Fun + +lift_definition to_Fun :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'b) Fun" is id. + +definition "fun_to_vec (v :: ('a::finite, 'b) Fun) = vec_lambda (Rep_Fun v)" + +lift_definition vec_to_fun :: "'b^'a \<Rightarrow> ('a, 'b) Fun" is vec_nth. + +lemma Fun_inverse[simp]: "Rep_Fun (Abs_Fun f) = f" + using Abs_Fun_inverse by auto + +lift_definition zero_Fun :: "('a, 'b::zero) Fun" is 0. + +code_datatype vec_to_fun + +lemmas vec_to_fun.rep_eq[code] + +instantiation Fun :: (enum, equal) equal +begin +definition "equal_Fun (f :: ('a::enum, 'b::equal) Fun) g = (Rep_Fun f = Rep_Fun g)" +instance + by standard (auto simp: equal_Fun_def Rep_Fun_inject) +end + +subsection \<open>Bounded Functions as Vectors\<close> +lemma Bfun_inverse_fin[simp]: "apply_bfun (Bfun (f :: 'c :: finite \<Rightarrow> _)) = f" + using finite by (fastforce intro!: Bfun_inverse simp: bfun_def) + +definition "bfun_to_vec (v :: ('a::finite) \<Rightarrow>\<^sub>b ('b::metric_space)) = vec_lambda v" +definition "vec_to_bfun v = Bfun (vec_nth v)" + +code_datatype vec_to_bfun + +lemma apply_bfun_vec_to_bfun[code]: "apply_bfun (vec_to_bfun f) x = f $ x" + by (auto simp: vec_to_bfun_def) + +lemma [code]: "0 = vec_to_bfun 0" + by (auto simp: vec_to_bfun_def) + +subsection \<open>IArrays with Lengths in the Type\<close> + +typedef ('s :: mod_type, 'a) iarray_type = "{arr :: 'a iarray. IArray.length arr = CARD('s)}" + using someI_ex[OF Ex_list_of_length] + by (auto intro!: exI[of _ "IArray (SOME xs. length xs = CARD('s))"]) + +setup_lifting type_definition_iarray_type + +lift_definition fun_to_iarray_t :: "('s::{mod_type} \<Rightarrow> 'a) \<Rightarrow> ('s, 'a) iarray_type" is "\<lambda>f. IArray.of_fun (\<lambda>s. f (from_nat s)) (CARD('s))" + by auto + +lift_definition iarray_t_sub :: "('s::mod_type, 'a) iarray_type \<Rightarrow> 's \<Rightarrow> 'a" is "\<lambda>v x. IArray.sub v (to_nat x)". + +lift_definition iarray_to_vec :: "('s, 'a) iarray_type \<Rightarrow> 'a^'s::{mod_type, finite}" + is "\<lambda>v. (\<chi> s. IArray.sub v (to_nat s))". + +lift_definition vec_to_iarray :: "'a^'s::{mod_type, finite} \<Rightarrow> ('s, 'a) iarray_type" + is "\<lambda>v. IArray.of_fun (\<lambda>s. v $ ((from_nat s) :: 's)) (CARD('s))" + by auto + +lemma length_iarray_type [simp]: "length (IArray.list_of (Rep_iarray_type (v:: ('s::{mod_type}, 'a) iarray_type))) = CARD('s)" + using Rep_iarray_type by auto + +lemma iarray_t_eq_iff: "(v = w) = (\<forall>x. iarray_t_sub v x = iarray_t_sub w x)" + unfolding iarray_t_sub.rep_eq IArray.sub_def + by (metis Rep_iarray_type_inject iarray_exhaust2 length_iarray_type list_eq_iff_nth_eq to_nat_from_nat_id) + +lemma iarray_to_vec_inv: "iarray_to_vec (vec_to_iarray v) = v" + by (auto simp: to_nat_less_card iarray_to_vec.rep_eq vec_to_iarray.rep_eq vec_eq_iff) + +lemma vec_to_iarray_inv: "vec_to_iarray (iarray_to_vec v) = v" + by (auto simp: to_nat_less_card iarray_to_vec.rep_eq vec_to_iarray.rep_eq iarray_t_eq_iff iarray_t_sub.rep_eq) + +code_datatype iarray_to_vec + +lemma vec_nth_iarray_to_vec[code]: "vec_nth (iarray_to_vec v) x = iarray_t_sub v x" + by (auto simp: iarray_to_vec.rep_eq iarray_t_sub.rep_eq) + +lemma vec_lambda_iarray_t[code]: "vec_lambda v = iarray_to_vec (fun_to_iarray_t v)" + by (auto simp: iarray_to_vec.rep_eq fun_to_iarray_t.rep_eq to_nat_less_card) + +lemma zero_iarray[code]: "0 = iarray_to_vec (fun_to_iarray_t 0)" + by (auto simp: iarray_to_vec.rep_eq fun_to_iarray_t.rep_eq to_nat_less_card vec_eq_iff) + +subsection \<open>Value Iteration\<close> + +locale vi_code = + MDP_ord A K r l for A :: "'s::mod_type \<Rightarrow> ('a::{finite, wellorder}) set" + and K :: "('s::{finite, mod_type} \<times> 'a::{finite, wellorder}) \<Rightarrow> 's pmf" and r l +begin +definition "vi_test (v::'s\<Rightarrow>\<^sub>b real) v' eps = 2 * l * dist v v'" + +partial_function (tailrec) value_iteration_partial where [code]: "value_iteration_partial eps v = + (let v' = \<L>\<^sub>b v in + (if 2 * l * dist v v' < eps * (1 - l) then v' else (value_iteration_partial eps v')))" + +lemma vi_eq_partial: "eps > 0 \<Longrightarrow> value_iteration_partial eps v = value_iteration eps v" +proof (induction eps v rule: value_iteration.induct) + case (1 eps v) + then show ?case + by (auto simp: Let_def value_iteration.simps value_iteration_partial.simps) +qed + +definition "L_det d = L (mk_dec_det d)" + +lemma code_L_det [code]: "L_det d (vec_to_bfun v) = vec_to_bfun (\<chi> s. L\<^sub>a (d s) (vec_nth v) s)" + by (auto simp: L_det_def vec_to_bfun_def L_eq_L\<^sub>a_det) + +lemma code_\<L>\<^sub>b [code]: "\<L>\<^sub>b (vec_to_bfun v) = vec_to_bfun (\<chi> s. (MAX a \<in> A s. r (s, a) + l * measure_pmf.expectation (K (s, a)) (vec_nth v)))" + by (auto simp: vec_to_bfun_def \<L>\<^sub>b_fin_eq_det A_ne cSup_eq_Max) + +lemma code_value_iteration[code]: "value_iteration eps (vec_to_bfun v) = + (if eps \<le> 0 then \<L>\<^sub>b (vec_to_bfun v) else value_iteration_partial eps (vec_to_bfun v))" + by (simp add: value_iteration.simps vi_eq_partial) + +lift_definition find_policy_impl :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s, 'a) Fun" is "\<lambda>v. find_policy' v". +lemma code_find_policy_impl: "find_policy_impl v = vec_to_fun (\<chi> s. (LEAST x. x \<in> opt_acts v s))" + by (auto simp: vec_to_fun_def find_policy_impl_def find_policy'_def Abs_Fun_inject) + +lemma code_find_policy_impl_opt[code]: "find_policy_impl v = vec_to_fun (\<chi> s. least_arg_max_enum (\<lambda>a. L\<^sub>a a v s) (A s))" + by (auto simp: is_opt_act_def code_find_policy_impl least_arg_max_enum_correct[OF A_ne]) + +lemma code_vi_policy'[code]: "vi_policy' eps v = Rep_Fun (find_policy_impl (value_iteration eps v))" + unfolding vi_policy'_def find_policy_impl_def by auto + +subsection \<open>Policy Iteration\<close> + +partial_function (tailrec) policy_iteration_partial where [code]: "policy_iteration_partial d = + (let d' = policy_step d in if d = d' then d else policy_iteration_partial d')" + +lemma pi_eq_partial: "d \<in> D\<^sub>D \<Longrightarrow> policy_iteration_partial d = policy_iteration d" +proof (induction d rule: policy_iteration.induct) + case (1 d) + then show ?case + by (auto simp: Let_def is_dec_det_pi policy_step_def policy_iteration_partial.simps) +qed + +definition "P_mat d = (\<chi> i j. pmf (K (i, Rep_Fun d i)) j)" + +definition "r_vec' d = (\<chi> i. r(i, Rep_Fun d i))" + +lift_definition policy_eval' :: "('s::{mod_type, finite}, 'a) Fun \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" is "policy_eval". + +lemma mat_eq_blinfun: "mat 1 - l *\<^sub>R (P_mat (vec_to_fun d)) = blinfun_to_matrix (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det (vec_nth d)))" + unfolding blinfun_to_matrix_diff blinfun_to_matrix_id blinfun_to_matrix_scaleR + unfolding blinfun_to_matrix_def P_mat_def \\<^sub>1.rep_eq K_st_def push_exp_def matrix_def axis_def vec_to_fun_def + by (auto simp: if_distrib mk_dec_det_def integral_measure_pmf[of UNIV] pmf_expectation_bind[of UNIV] pmf_bind cong: if_cong) + +lemma \<nu>\<^sub>b_vec: "policy_eval' (vec_to_fun d) = vec_to_bfun (matrix_inv (mat 1 - l *\<^sub>R (P_mat (vec_to_fun d))) *v (r_vec' (vec_to_fun d)))" +proof - + let ?d = "Rep_Fun (vec_to_fun d)" + have "vec_to_bfun (matrix_inv (mat 1 - l *\<^sub>R (P_mat (vec_to_fun d))) *v (r_vec' (vec_to_fun d))) = matrix_to_blinfun (matrix_inv (mat 1 - l *\<^sub>R (P_mat (vec_to_fun d)))) (vec_to_bfun (r_vec' (vec_to_fun d)))" + by (auto simp: matrix_to_blinfun_mult vec_to_bfun_def r_vec'_def) + also have "\<dots> = matrix_to_blinfun (matrix_inv (blinfun_to_matrix (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det ?d)))) (r_dec\<^sub>b (mk_dec_det ?d))" + unfolding mat_eq_blinfun + by (auto simp: r_vec'_def vec_to_bfun_def vec_lambda_inverse r_dec\<^sub>b_def vec_to_fun_def) + also have "\<dots> = inv\<^sub>L (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det ?d)) (r_dec\<^sub>b (mk_dec_det ?d))" + by (auto simp: blinfun_to_matrix_inverse(2)[symmetric] invertible\<^sub>L_inf_sum matrix_to_blinfun_inv) + finally have "vec_to_bfun (matrix_inv (mat 1 - l *\<^sub>R (P_mat (vec_to_fun d))) *v (r_vec' (vec_to_fun d))) = inv\<^sub>L (id_blinfun - l *\<^sub>R \\<^sub>1 (mk_dec_det ?d)) (r_dec\<^sub>b (mk_dec_det ?d))". + thus ?thesis + by (auto simp: \<nu>_stationary policy_eval'.rep_eq policy_eval_def inv\<^sub>L_inf_sum blincomp_scaleR_right) +qed + +lemma \<nu>\<^sub>b_vec_opt[code]: "policy_eval' (vec_to_fun d) = vec_to_bfun (Matrix_To_IArray.iarray_to_vec (Matrix_To_IArray.vec_to_iarray ((fst (Gauss_Jordan_PA ((mat 1 - l *\<^sub>R (P_mat (vec_to_fun d)))))) *v (r_vec' (vec_to_fun d)))))" + using \<nu>\<^sub>b_vec + by (auto simp: mat_eq_blinfun matrix_inv_Gauss_Jordan_PA blinfun_to_matrix_inverse(1) invertible\<^sub>L_inf_sum iarray_to_vec_vec_to_iarray) + +lift_definition policy_improvement' :: "('s, 'a) Fun \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s, 'a) Fun" + is policy_improvement. + +lemma [code]: "policy_improvement' (vec_to_fun d) v = vec_to_fun (\<chi> s. (if is_arg_max (\<lambda>a. L\<^sub>a a v s) (\<lambda>a. a \<in> A s) (d $ s) then d $ s else LEAST x. is_arg_max (\<lambda>a. L\<^sub>a a v s) (\<lambda>a. a \<in> A s) x))" + by (auto simp: is_opt_act_def policy_improvement'_def vec_to_fun_def vec_lambda_inverse policy_improvement_def Abs_Fun_inject) + +lift_definition policy_step' :: "('s, 'a) Fun \<Rightarrow> ('s, 'a) Fun" + is policy_step. + +lemma [code]: "policy_step' d = policy_improvement' d (policy_eval' d)" + by (auto simp: policy_step'_def policy_step_def policy_improvement'_def policy_eval'_def apply_bfun_inverse) + +lift_definition policy_iteration_partial' :: "('s, 'a) Fun \<Rightarrow> ('s, 'a) Fun" + is policy_iteration_partial. + +lemma [code]: "policy_iteration_partial' d = (let d' = policy_step' d in if d = d' then d else policy_iteration_partial' d')" + by (auto simp: policy_iteration_partial'.rep_eq policy_step'.rep_eq Let_def policy_iteration_partial.simps Rep_Fun_inject[symmetric]) + +lift_definition policy_iteration' :: "('s, 'a) Fun \<Rightarrow> ('s, 'a) Fun" is policy_iteration. + +lemma code_policy_iteration'[code]: "policy_iteration' d = + (if Rep_Fun d \<notin> D\<^sub>D then d else (policy_iteration_partial' d))" + by transfer (auto simp: pi_eq_partial) + +lemma code_policy_iteration[code]: "policy_iteration d = Rep_Fun (policy_iteration' (vec_to_fun (vec_lambda d)))" + by (auto simp add: vec_lambda_inverse policy_iteration'.rep_eq vec_to_fun_def) + +subsection \<open>Gauss-Seidel Iteration\<close> + +partial_function (tailrec) gs_iteration_partial where + [code]: "gs_iteration_partial eps v = ( + let v' = (GS_rec_fun\<^sub>b v) in + (if 2 * l * dist v v' < eps * (1 - l) then v' else gs_iteration_partial eps v'))" + +lemma gs_iteration_partial_eq: "eps > 0 \<Longrightarrow> gs_iteration_partial eps v = gs_iteration eps v" + by (induction eps v rule: gs_iteration.induct) (auto simp: gs_iteration_partial.simps Let_def gs_iteration.simps) + +lemma gs_iteration_code_opt[code]: "gs_iteration eps v = (if eps \<le> 0 then GS_rec_fun\<^sub>b v else gs_iteration_partial eps v)" + by (auto simp: gs_iteration_partial_eq gs_iteration.simps) + +definition "vec_upd v i x = (\<chi> j. if i = j then x else v $ j)" + +lemma GS_rec_eq_fold: "GS_rec v = foldl (\<lambda>v s. (vec_upd v s (GS_iter_max v s))) v (sorted_list_of_set UNIV)" +proof - + have "vec_lambda (foldl (\<lambda>v s. v(s := GS_rec_iter v s)) (($) v) xs) = foldl (\<lambda>v s. vec_upd v s (GS_iter_max v s)) v xs" for xs + proof (induction xs arbitrary: v) + case (Cons a xs) + show ?case + by (auto simp: vec_upd_def[of v] Cons[symmetric] eq_commute GS_rec_iter_eq_iter_max cong: if_cong) + qed auto + thus ?thesis + unfolding GS_rec_def GS_rec_fun_code' + by auto +qed + +lemma GS_rec_fun_code''''[code]: "GS_rec_fun\<^sub>b (vec_to_bfun v) = vec_to_bfun (foldl (\<lambda>v s. (vec_upd v s (GS_iter_max v s))) v (sorted_list_of_set UNIV))" + by (auto simp add: GS_rec_eq_fold[symmetric] GS_rec_eq_elem GS_rec_fun\<^sub>b.rep_eq vec_to_bfun_def) + +lemma GS_iter_max_code [code]: "GS_iter_max v s = (MAX a \<in> A s. GS_iter a v s)" + using A_ne + by (auto simp: GS_iter_max_def cSup_eq_Max) + +lift_definition opt_policy_gs'' :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s, 'a) Fun" is opt_policy_gs. + +declare opt_policy_gs''.rep_eq[symmetric, code] + +lemma GS_rec_am_code'_prod: "GS_rec_am_code' v d = + (\<lambda>s'. ( + let (v', d') = foldl (\<lambda>(v,d) s. (v(s := (GS_iter_max (vec_lambda v) s)), d(s := GS_iter_arg_max (vec_lambda v) s))) (vec_nth v, d) (sorted_list_of_set UNIV) + in (v' s', d' s')))" +proof - + have 1: "(\<lambda>x. (f x, g x))(y := (z, w)) = (\<lambda>x. ((f(y := z)) x, (g(y := w)) x))" for f g y z w + by auto + have 2: "(($) f)(a := y) = ($) (vec_lambda ((vec_nth f)(a := y)))" for f a y + by auto + have "foldl (\<lambda>vd s. vd(s := (GS_iter_max (\<chi> s. fst (vd s)) s, GS_iter_arg_max (\<chi> s. fst (vd s)) s))) (\<lambda>s. (v $ s, d s)) xs = + (\<lambda>s'. let (v', d') = foldl (\<lambda>(v, d) s. (v(s := GS_iter_max (vec_lambda v) s), d(s := GS_iter_arg_max (vec_lambda v) s))) (($) v, d) xs in (v' s', d' s'))" for xs + proof (induction xs arbitrary: v d) + case Nil + then show ?case by auto + next + case (Cons a xs) + show ?case + by (simp add: 1 Cons.IH[of "(vec_lambda ((($) v)(a := GS_iter_max v a)))", unfolded 2[symmetric]] del: fun_upd_apply) + qed + thus ?thesis + unfolding GS_rec_am_code'_def by blast +qed + + +lemma code_GS_rec_am_arr_opt[code]: "opt_policy_gs'' (vec_to_bfun v) = vec_to_fun ((snd (foldl (\<lambda>(v, d) s. + let (am, m) = least_max_arg_max_enum (\<lambda>a. r (s, a) + l * (\<Sum>s' \<in> UNIV. pmf (K (s,a)) s' * v $ s')) (A s) in + (vec_upd v s m, vec_upd d s am)) + (v, (\<chi> s. (least_enum (\<lambda>a. a \<in> A s)))) (sorted_list_of_set UNIV))))" +proof - + have 1: "opt_policy_gs'' v' = Abs_Fun (opt_policy_gs v')" for v' + by (simp add: opt_policy_gs''.abs_eq) + have 2: "opt_policy_gs (vec_to_bfun v) = opt_policy_gs' d v" for v d + by (metis Bfun_inverse_fin opt_policy_gs_eq' vec_lambda_eta vec_to_bfun_def) + have 3: "opt_policy_gs' d v = (\<lambda>s. snd (GS_rec_am_code v d s))" for d + by (simp add: GS_rec_am_code_eq) + have 4: "GS_rec_am_code v d = (\<lambda>s'. let (v', d') = foldl (\<lambda>(v, d) s. (v(s := GS_iter_max (vec_lambda v) s), d(s := GS_iter_arg_max (vec_lambda v) s))) (($) v, d) (sorted_list_of_set UNIV) in (v' s', d' s'))" for d s v + using GS_rec_am_code' GS_rec_am_code'_prod by presburger + have 5: "foldl (\<lambda>(v, d) s. (v(s := GS_iter_max (vec_lambda v) s), d(s := GS_iter_arg_max (vec_lambda v) s))) (($) v, ($) d) xs = + (let (v', d') = foldl (\<lambda>(v, d) s. (vec_upd v s (GS_iter_max v s), vec_upd d s (GS_iter_arg_max v s))) (v, d) xs in (vec_nth v', vec_nth d'))" for d v xs + proof (induction xs arbitrary: d v) + case Nil + then show ?case by auto + next + case (Cons a xs) + show ?case + unfolding vec_lambda_inverse Let_def + using Cons[symmetric, unfolded Let_def] + by simp (auto simp: vec_lambda_inverse vec_upd_def Let_def eq_commute cong: if_cong) + qed + have 6: "opt_policy_gs'' (vec_to_bfun v) = vec_to_fun (snd (foldl (\<lambda>(v, d) s. (vec_upd v s (GS_iter_max v s), vec_upd d s (GS_iter_arg_max v s))) (v, d) (sorted_list_of_set UNIV)))" for d + unfolding 1 + unfolding 2[of _ "Rep_Fun (vec_to_fun d)"] + unfolding 3 + unfolding 4 + using 5 + by (auto simp: Let_def case_prod_beta vec_to_fun_def) + show ?thesis + unfolding Let_def case_prod_beta + unfolding least_max_arg_max_enum_correct1[OF A_ne] + using least_max_arg_max_enum_correct2[OF A_ne] + unfolding least_max_arg_max_enum_correct2[OF A_ne] + using 6 fin_actions A_ne + unfolding GS_iter_max_def GS_iter_def GS_iter_arg_max_def + by (auto simp: cSup_eq_Max split_beta') +qed + + +subsection \<open>Modified Policy Iteration\<close> + +sublocale MDP_MPI A K r l "\<lambda>X. Least (\<lambda>x. x \<in> X)" + using MDP_act_axioms MDP_reward_axioms + by unfold_locales auto + + +definition "d0 s = (LEAST a. a \<in> A s)" +lift_definition d0' :: "('s, 'a) Fun" is d0. + +lemma d0_dec_det: "is_dec_det d0" + using A_ne unfolding d0_def is_dec_det_def + by simp + +lemma v0_code[code]: "v0_mpi\<^sub>b = vec_to_bfun (\<chi> s. r_min / (1 - l))" + by (auto simp: v0_mpi\<^sub>b_def v0_mpi_def vec_to_bfun_def ) + +lemma d0'_code[code]: "d0' = vec_to_fun (\<chi> s. (LEAST a. a \<in> A s))" + by (auto simp: d0'.rep_eq d0_def Rep_Fun_inject[symmetric] vec_to_fun_def) + +lemma step_value_code[code]: "L_pow v d m = (L_det d ^^ Suc m) v" + unfolding L_pow_def L_det_def + by auto + +partial_function (tailrec) mpi_partial where [code]: "mpi_partial eps d v m = + (let d' = policy_improvement d v in ( + if 2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l) + then (d', v) + else mpi_partial eps d' (L_pow v d' (m 0 v)) (\<lambda>n. m (Suc n))))" + +lemma mpi_partial_eq_algo: + assumes "eps > 0" "d \<in> D\<^sub>D" "v \<le> \<L>\<^sub>b v" + shows "mpi_partial eps d v m = mpi_algo eps d v m" +proof - + have "mpi_algo_dom eps (d,v,m)" + using assms termination_mpi_algo by blast + thus ?thesis + by (induction rule: mpi_algo.pinduct) (auto simp: Let_def mpi_algo.psimps mpi_partial.simps) +qed + +lift_definition mpi_partial' :: "real \<Rightarrow> ('s, 'a) Fun \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> (nat \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow> nat) + \<Rightarrow> ('s, 'a) Fun \<times> ('s \<Rightarrow>\<^sub>b real)" is mpi_partial. + +lemma mpi_partial'_code[code]: "mpi_partial' eps d v m = + (let d' = policy_improvement' d v in ( + if 2 * l * dist v (\<L>\<^sub>b v) < eps * (1 - l) + then (d', v) + else mpi_partial' eps d' (L_pow v (Rep_Fun d') (m 0 v)) (\<lambda>n. m (Suc n))))" + by (auto simp: mpi_partial'_def mpi_partial.simps Let_def policy_improvement'_def) + +lemma r_min_code[code_unfold]: "r_min = (MIN s. MIN a. r(s,a))" + by (auto simp: cInf_eq_Min) + +lemma mpi_user_code[code]: "mpi_user eps m = + (if eps \<le> 0 then undefined else + let (d, v) = mpi_partial' eps d0' v0_mpi\<^sub>b m in (Rep_Fun d, v))" + unfolding mpi_user_def case_prod_beta mpi_partial'_def + using mpi_partial_eq_algo A_ne v0_mpi\<^sub>b_le_\<L>\<^sub>b d0_dec_det + by (auto simp: d0'.rep_eq d0_def[symmetric]) +end + +subsection \<open>Auxiliary Equations\<close> +lemma [code_unfold]: "dist (f::'a::finite \<Rightarrow>\<^sub>b 'b::metric_space) g = (MAX a. dist (apply_bfun f a) (g a))" + by (auto simp: dist_bfun_def cSup_eq_Max) + +lemma member_code[code del]: "x \<in> List.coset xs \<longleftrightarrow> \<not> List.member xs x" + by (auto simp: in_set_member) + +lemma [code]: "iarray_to_vec v + iarray_to_vec u = (Matrix_To_IArray.iarray_to_vec (Rep_iarray_type v + Rep_iarray_type u))" + by (metis (no_types, lifting) Matrix_To_IArray.vec_to_iarray_def iarray_to_vec_vec_to_iarray vec_to_iarray.rep_eq vec_to_iarray_inv vec_to_iarray_plus) + +lemma [code]: "iarray_to_vec v - iarray_to_vec u = (Matrix_To_IArray.iarray_to_vec (Rep_iarray_type v - Rep_iarray_type u))" + unfolding minus_iarray_def Matrix_To_IArray.iarray_to_vec_def iarray_to_vec_def + by (auto simp: vec_eq_iff to_nat_less_card) + +lemma matrix_to_iarray_minus[code_unfold]: "matrix_to_iarray (A - B) = matrix_to_iarray A - matrix_to_iarray B" + unfolding matrix_to_iarray_def o_def minus_iarray_def Matrix_To_IArray.vec_to_iarray_def + by simp + +declare matrix_to_iarray_fst_Gauss_Jordan_PA[code_unfold] + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/code/Code_Mod.thy b/thys/MDP-Algorithms/code/Code_Mod.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/code/Code_Mod.thy @@ -0,0 +1,109 @@ +theory Code_Mod + imports Code_DP +begin +section \<open>Code Generation for Concrete Finite MDPs\<close> + +locale mod_MDP = + fixes transition :: "'s::{enum, mod_type} \<times> 'a::{enum, mod_type} \<Rightarrow> 's pmf" + and A :: "'s \<Rightarrow> 'a set" + and reward :: "'s \<times> 'a \<Rightarrow> real" + and discount :: "real" +begin + +sublocale mdp: vi_code + "\<lambda>s. (if Set.is_empty (A s) then UNIV else A s)" + transition + reward + "(if 1 \<le> discount \<or> discount < 0 then 0 else discount)" + defines \<L>\<^sub>b = mdp.\<L>\<^sub>b + and L_det = mdp.L_det + and value_iteration = mdp.value_iteration + and vi_policy' = mdp.vi_policy' + and find_policy' = mdp.find_policy' + and find_policy_impl = mdp.find_policy_impl + and is_opt_act = mdp.is_opt_act + and value_iteration_partial = mdp.value_iteration_partial + and policy_iteration = mdp.policy_iteration + and is_dec_det = mdp.is_dec_det + and policy_step = mdp.policy_step + and policy_improvement = mdp.policy_improvement + and policy_eval = mdp.policy_eval + and mk_markovian = mdp.mk_markovian + and policy_eval' = mdp.policy_eval' + and policy_iteration_partial' = mdp.policy_iteration_partial' + and policy_iteration' = mdp.policy_iteration' + and policy_iteration_policy_step' = mdp.policy_step' + and policy_iteration_policy_eval' = mdp.policy_eval' + and policy_iteration_policy_improvement' = mdp.policy_improvement' + and gs_iteration = mdp.gs_iteration + and gs_iteration_partial = mdp.gs_iteration_partial + and vi_gs_policy = mdp.vi_gs_policy + and opt_policy_gs = mdp.opt_policy_gs + and opt_policy_gs'' = mdp.opt_policy_gs'' + and P_mat = mdp.P_mat + and r_vec' = mdp.r_vec' + and GS_rec_fun\<^sub>b = mdp.GS_rec_fun\<^sub>b + and GS_iter_max = mdp.GS_iter_max + and GS_iter = mdp.GS_iter + and mpi_user = mdp.mpi_user + and v0_mpi\<^sub>b = mdp.v0_mpi\<^sub>b + and mpi_partial' = mdp.mpi_partial' + and L_pow = mdp.L_pow + and v0_mpi = mdp.v0_mpi + and r_min = mdp.r_min + and d0 = mdp.d0 + and d0' = mdp.d0' + and \<nu>\<^sub>b = mdp.\<nu>\<^sub>b + and vi_test = mdp.vi_test + by unfold_locales (auto simp add: Set.is_empty_def) +end + +global_interpretation mod_MDP transition A reward discount + for transition A reward discount + defines mod_MDP_\<L>\<^sub>b = mdp.\<L>\<^sub>b + and mod_MDP_\<L>\<^sub>b_L_det = mdp.L_det + and mod_MDP_value_iteration = mdp.value_iteration + and mod_MDP_vi_policy' = mdp.vi_policy' + and mod_MDP_find_policy' = mdp.find_policy' + and mod_MDP_find_policy_impl = mdp.find_policy_impl + and mod_MDP_is_opt_act = mdp.is_opt_act + and mod_MDP_value_iteration_partial = mdp.value_iteration_partial + and mod_MDP_policy_iteration = mdp.policy_iteration + and mod_MDP_is_dec_det = mdp.is_dec_det + and mod_MDP_policy_step = mdp.policy_step + and mod_MDP_policy_improvement = mdp.policy_improvement + and mod_MDP_policy_eval = mdp.policy_eval + and mod_MDP_mk_markovian = mdp.mk_markovian + and mod_MDP_policy_eval' = mdp.policy_eval' + and mod_MDP_policy_iteration_partial' = mdp.policy_iteration_partial' + and mod_MDP_policy_iteration' = mdp.policy_iteration' + and mod_MDP_policy_iteration_policy_step' = mdp.policy_step' + and mod_MDP_policy_iteration_policy_eval' = mdp.policy_eval' + and mod_MDP_policy_iteration_policy_improvement' = mdp.policy_improvement' + and mod_MDP_gs_iteration = mdp.gs_iteration + and mod_MDP_gs_iteration_partial = mdp.gs_iteration_partial + and mod_MDP_vi_gs_policy = mdp.vi_gs_policy + and mod_MDP_opt_policy_gs = mdp.opt_policy_gs + and mod_MDP_opt_policy_gs'' = mdp.opt_policy_gs'' + and mod_MDP_P_mat = mdp.P_mat + and mod_MDP_r_vec' = mdp.r_vec' + and mod_MDP_GS_rec_fun\<^sub>b = mdp.GS_rec_fun\<^sub>b + and mod_MDP_GS_iter_max = mdp.GS_iter_max + and mod_MDP_GS_iter = mdp.GS_iter + and mod_MDP_mpi_user = mdp.mpi_user + and mod_MDP_v0_mpi\<^sub>b = mdp.v0_mpi\<^sub>b + and mod_MDP_mpi_partial' = mdp.mpi_partial' + and mod_MDP_L_pow = mdp.L_pow + and mod_MDP_v0_mpi = mdp.v0_mpi + and mod_MDP_r_min = mdp.r_min + and mod_MDP_d0 = mdp.d0 + and mod_MDP_d0' = mdp.d0' + and mod_MDP_\<nu>\<^sub>b = mdp.\<nu>\<^sub>b + and mod_MDP_vi_test = mdp.vi_test + . + +(* +value "mod_MDP_vi_gs_policy (\<lambda>_::(2\<times>2). return_pmf (1::2)) (\<lambda>_. {}) (\<lambda>_. 0) 0.5 0.5 (vec_to_bfun (\<chi> i. 1)) 0" +*) + +end diff --git a/thys/MDP-Algorithms/code/Code_Real_Approx_By_Float_Fix.thy b/thys/MDP-Algorithms/code/Code_Real_Approx_By_Float_Fix.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/code/Code_Real_Approx_By_Float_Fix.thy @@ -0,0 +1,59 @@ +theory Code_Real_Approx_By_Float_Fix + imports + "HOL-Library.Code_Real_Approx_By_Float" + "Gauss_Jordan.Code_Real_Approx_By_Float_Haskell" +begin +(*<*) +section \<open>Fix for Floating Point Approximation using Haskell\<close> + +code_printing + type_constructor real \<rightharpoonup> (Haskell) "Prelude.Double" (*Double precision*) + | constant "0 :: real" \<rightharpoonup> (Haskell) "0.0" + | constant "1 :: real" \<rightharpoonup> (Haskell) "1.0" + | constant "real_of_integer" \<rightharpoonup> (Haskell) "Prelude.fromIntegral (_)" + | class_instance real :: "HOL.equal" => (Haskell) - (*This is necessary. See the tutorial on code generation, page 29*) + | constant "HOL.equal :: real \<Rightarrow> real \<Rightarrow> bool" \<rightharpoonup> + (Haskell) "_ == _" + | constant "(<) :: real => real => bool" \<rightharpoonup> + (Haskell) "_ < _" + | constant "(\<le>) :: real => real => bool" \<rightharpoonup> + (Haskell) "_ <= _" + | constant "(+) :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup> + (Haskell) "_ + _" + | constant "(-) :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup> + (Haskell) "_ - _" + | constant "(*) :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup> + (Haskell) "_ * _" + | constant "(/) :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup> + (Haskell) "_ '/ _" + | constant "uminus :: real => real" \<rightharpoonup> + (Haskell) "Prelude.negate" + | constant "sqrt :: real => real" \<rightharpoonup> + (Haskell) "Prelude.sqrt" + | constant Code_Real_Approx_By_Float.real_exp \<rightharpoonup> + (Haskell) "Prelude.exp" + | constant ln \<rightharpoonup> + (Haskell) "Prelude.log" + | constant cos \<rightharpoonup> + (Haskell) "Prelude.cos" + | constant sin \<rightharpoonup> + (Haskell) "Prelude.sin" + | constant tan \<rightharpoonup> + (Haskell) "Prelude.tan" + | constant pi \<rightharpoonup> + (Haskell) "Prelude.pi" + | constant arctan \<rightharpoonup> + (Haskell) "Prelude.atan" + | constant arccos \<rightharpoonup> + (Haskell) "Prelude.acos" + | constant arcsin \<rightharpoonup> + (Haskell) "Prelude.asin" + +code_printing + constant Realfract \<rightharpoonup> (Haskell) + "(Prelude.fromIntegral (integer'_of'_int _) '/ Prelude.fromIntegral (integer'_of'_int _))" + +code_printing + constant Realfract \<rightharpoonup> (SML) "(Real.fromInt (IntInf.toInt (integer'_of'_int _))) '// Real.fromInt (IntInf.toInt (integer'_of'_int _))" +(*>*) +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/document/root.bib b/thys/MDP-Algorithms/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/document/root.bib @@ -0,0 +1,13 @@ +@book{Puterman, + author = {Martin L. Puterman}, + title = {Markov Decision Processes: Discrete Stochastic Dynamic Programming}, + series = {Wiley Series in Probability and Statistics}, + publisher = {Wiley}, + year = {1994}, + url = {https://doi.org/10.1002/9780470316887}, + doi = {10.1002/9780470316887}, + isbn = {978-0-47161977-2}, + timestamp = {Mon, 22 Jul 2019 15:00:49 +0200}, + biburl = {https://dblp.org/rec/books/wi/Puterman94.bib}, + bibsource = {dblp computer science bibliography, https://dblp.org} +} diff --git a/thys/MDP-Algorithms/document/root.tex b/thys/MDP-Algorithms/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/document/root.tex @@ -0,0 +1,69 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amssymb, amsmath, amsfonts} + %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>, + %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>, + %\<triangleq>, \<yen>, \<lozenge> + +%\usepackage{eurosym} + %for \<euro> + +\usepackage[only,bigsqcap]{stmaryrd} + %for \<Sqinter> + +%\usepackage{eufrak} + %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb) + +%\usepackage{textcomp} + %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>, + %\<currency> + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Verified Algorithms for Solving Markov Decision Processes} +\author{Maximilian Schäffeler and Mohammad Abdulaziz} +\maketitle + +\abstract{ +We present a formalization of algorithms for solving Markov Decision Processes (MDPs) with formal guarantees on the optimality of their +solutions. +In particular we build on our analysis of the Bellman operator for discounted infinite horizon MDPs. +From the iterator rule on the Bellman operator we directly derive executable value iteration and policy iteration algorithms to iteratively solve finite MDPs. +We also prove correct optimized versions of value iteration that use matrix splittings to improve the convergence rate. In particular, we formally verify Gauss-Seidel value iteration and modified policy iteration. +The algorithms are evaluated on two standard examples from the literature, namely, inventory management and gridworld. +Our formalization covers most of chapter 6 in Puterman's book \cite{Puterman}. +} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/MDP-Algorithms/examples/Code_Gridworld.thy b/thys/MDP-Algorithms/examples/Code_Gridworld.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/examples/Code_Gridworld.thy @@ -0,0 +1,142 @@ +(* Author: Maximilian Schäffeler *) + +theory Code_Gridworld + imports + Code_Mod +begin +section \<open>Gridworld Example\<close> + +lemma [code abstype]: "embed_pmf (pmf P) = P" + by (metis (no_types, lifting) td_pmf_embed_pmf type_definition_def) + +lemmas [code_abbrev del] = pmf_integral_code_unfold + +lemma [code_unfold]: + "measure_pmf.expectation P (f :: 'a :: enum \<Rightarrow> real) = (\<Sum>x \<in> UNIV. pmf P x * f x)" + by (metis (no_types, lifting) UNIV_I finite_class.finite_UNIV integral_measure_pmf + real_scaleR_def sum.cong) + +lemma [code]: "pmf (return_pmf x) = (\<lambda>y. indicat_real {y} x) " + by auto + +lemma [code]: + "pmf (bind_pmf N f) = (\<lambda>i :: 'a. measure_pmf.expectation N (\<lambda>(x :: 'b ::enum). pmf (f x) i))" + using Probability_Mass_Function.pmf_bind + by fast + +(* 3 x 4 + 1 * Trap *) +type_synonym state_robot = "13" + +definition "from_state x = (Rep x div 4, Rep x mod 4)" +definition "to_state x = (Abs (fst x * 4 + snd x) :: state_robot)" + +(* up, right, down, left *) +type_synonym action_robot = 4 + +fun A_robot :: "state_robot \<Rightarrow> action_robot set" where + "A_robot pos = UNIV" + +abbreviation "noise \<equiv> (0.2 :: real)" + +lift_definition add_noise :: "action_robot \<Rightarrow> action_robot pmf" is "\<lambda>det rnd. ( + if det = rnd then 1 - noise else if det = rnd - 1 \<or> det = rnd + 1 then noise / 2 else 0)" + subgoal for n + unfolding nn_integral_count_space_finite[OF finite] UNIV_4 + using exhaust_4[of n] + by fastforce + done + +fun r_robot :: "(state_robot \<times> action_robot) \<Rightarrow> real" where + "r_robot (s,a) = ( + if from_state s = (2,3) then 1 else + if from_state s = (1,3) then -1 else + if from_state s = (3,0) then 0 else + 0)" + +fun K_robot :: "(state_robot \<times> action_robot) \<Rightarrow> state_robot pmf" where + "K_robot (loc, a) = + do { + a \<leftarrow> add_noise a; + let (y, x) = from_state loc; + let (y', x') = + (if a = 0 then (y + 1 , x) + else if a = 1 then (y, x+1) + else if a = 2 then (y-1, x) + else if a = 3 then (y, x-1) + else undefined); + return_pmf ( + if (y,x) = (2,3) \<or> (y,x) = (1,3) \<or> (y,x) = (3,0) + then to_state (3,0) + else if y' < 0 \<or> y' > 2 \<or> x' < 0 \<or> x' > 3 \<or> (y',x') = (1,1) + then to_state (y, x) + else to_state (y', x')) + }" + +definition "l_robot = 0.9" + +lemma "vi_code A_robot r_robot l_robot" + by standard (auto simp: l_robot_def) + + +abbreviation "to_gridworld f \<equiv> f K_robot r_robot l_robot" +abbreviation "to_gridworld' f \<equiv> f K_robot A_robot r_robot l_robot" + +abbreviation "gridworld_policy_eval' \<equiv> to_gridworld mod_MDP_policy_eval'" +abbreviation "gridworld_policy_step' \<equiv> to_gridworld' mod_MDP_policy_iteration_policy_step'" +abbreviation "gridworld_mpi_user \<equiv> to_gridworld' mod_MDP_mpi_user" +abbreviation "gridworld_opt_policy_gs \<equiv> to_gridworld' mod_MDP_opt_policy_gs" +abbreviation "gridworld_\<L>\<^sub>b \<equiv> to_gridworld' mod_MDP_\<L>\<^sub>b" +abbreviation "gridworld_find_policy' \<equiv> to_gridworld' mod_MDP_find_policy'" +abbreviation "gridworld_GS_rec_fun\<^sub>b \<equiv> to_gridworld' mod_MDP_GS_rec_fun\<^sub>b" +abbreviation "gridworld_vi_policy' \<equiv> to_gridworld' mod_MDP_vi_policy'" +abbreviation "gridworld_vi_gs_policy \<equiv> to_gridworld' mod_MDP_vi_gs_policy" +abbreviation "gridworld_policy_iteration \<equiv> to_gridworld' mod_MDP_policy_iteration" + + +fun pi_robot_n where + "pi_robot_n 0 d = (d, gridworld_policy_eval' d)" | + "pi_robot_n (Suc n) d = pi_robot_n n (gridworld_policy_step' d)" + +definition "mpi_robot eps = gridworld_mpi_user eps (\<lambda>_. 3)" + +fun gs_robot_n where + "gs_robot_n (0 :: nat) v = (gridworld_opt_policy_gs v, v)" | + "gs_robot_n (Suc n :: nat) v = gs_robot_n n (gridworld_GS_rec_fun\<^sub>b v)" + +fun vi_robot_n where + "vi_robot_n (0 :: nat) v = (gridworld_find_policy' v, v)" | + "vi_robot_n (Suc n :: nat) v = vi_robot_n n (gridworld_\<L>\<^sub>b v)" + +definition "mpi_result eps = + (let (d, v) = mpi_robot eps in (d,v))" + +definition "gs_result n = + (let (d,v) = gs_robot_n n 0 in (d,v))" + +definition "vi_result_n n = + (let (d, v) = vi_robot_n n 0 in (d,v))" + +definition "pi_result_n n = + (let (d, v) = pi_robot_n n (vec_to_fun 0) in (d,v))" + +definition "fun_to_list f = map f (sorted_list_of_set UNIV)" + +definition "benchmark_gs = fun_to_list (gridworld_vi_policy' 0.1 0)" +definition "benchmark_vi = fun_to_list (gridworld_vi_gs_policy 0.1 0)" +definition "benchmark_mpi = fun_to_list (fst (gridworld_mpi_user 0.1 (\<lambda>_ _. 3)))" +definition "benchmark_pi = fun_to_list (gridworld_policy_iteration 0)" + +(* +value [code] "gs_result 20" +value [code] "mpi_result 0.1" +value [code] "vi_result_n 20" +value [code] "pi_result_n 3" +value "benchmark_gs" +value "benchmark_vi" +value "benchmark_mpi" +value "benchmark_pi" +*) + +export_code benchmark_gs benchmark_vi benchmark_mpi benchmark_pi in Haskell module_name DP +export_code benchmark_gs benchmark_vi benchmark_mpi benchmark_pi in SML module_name DP +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/examples/Code_Inventory.thy b/thys/MDP-Algorithms/examples/Code_Inventory.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/examples/Code_Inventory.thy @@ -0,0 +1,197 @@ +(* Author: Maximilian Schäffeler *) + +theory Code_Inventory + imports + Code_Mod + (* Remove for precise results, approximates real numbers by floats, UNSOUND! *) + Code_Real_Approx_By_Float_Fix +begin + +section \<open>Inventory Management Example\<close> + +lemma [code abstype]: "embed_pmf (pmf P) = P" + by (metis (no_types, lifting) td_pmf_embed_pmf type_definition_def) + +lemmas [code_abbrev del] = pmf_integral_code_unfold + +lemma [code_unfold]: + "measure_pmf.expectation P (f :: 'a :: enum \<Rightarrow> real) = (\<Sum>x \<in> UNIV. pmf P x * f x)" + by (metis (no_types, lifting) UNIV_I finite_class.finite_UNIV integral_measure_pmf + real_scaleR_def sum.cong) + +lemma [code]: "pmf (return_pmf x) = (\<lambda>y. indicat_real {y} x) " + by auto + +lemma [code]: + "pmf (bind_pmf N f) = (\<lambda>i :: 'a. measure_pmf.expectation N (\<lambda>(x :: 'b ::enum). pmf (f x) i))" + using Probability_Mass_Function.pmf_bind + by fast + +lemma pmf_finite_le: "finite (X :: ('a::finite) set) \<Longrightarrow> sum (pmf p) X \<le> 1" + by (subst sum_pmf_eq_1[symmetric, of UNIV p]) (auto intro: sum_mono2) + +lemma mod_less_diff: + assumes "0 < (x::'s::{mod_type})" "x \<le> y" + shows "y - x < y" +proof - + have "0 \<le> Rep y - Rep x" + using assms mono_Rep unfolding mono_def + by auto + have 1: "Rep y - Rep x = Rep (y - x)" + unfolding mod_type_class.diff_def Rep_Abs_mod + using Rep_ge_0 + by (auto intro!: mod_pos_pos_trivial[OF \<open>0 \<le> Rep y - Rep x\<close> order.strict_trans1[OF _ Rep_less_n, of _ y], symmetric]) + have "Rep y - Rep x < Rep y" + using assms(1) strict_mono_Rep Rep_ge_0 le_less not_less + by (fastforce simp: strict_mono_def) + hence "Rep (y - x) < Rep y" + unfolding 1 by blast + thus ?thesis + by (metis not_less_iff_gr_or_eq strict_mono_Rep strict_mono_def) +qed + +locale inventory = + fixes fixed_cost :: real + and var_cost :: "'s::{mod_type, finite} \<Rightarrow> real" + and inv_cost :: "'s \<Rightarrow> real" + and demand_prob :: "'s pmf" + and revenue :: "'s \<Rightarrow> real" + and discount :: "real" +begin +definition "order_cost u = (if u = 0 then 0 else fixed_cost + var_cost u)" +definition "prob_ge_inv u = 1 - (\<Sum>j<u. pmf demand_prob j)" +definition "exp_rev u = (\<Sum>j<u. revenue j * pmf demand_prob j) + revenue u * prob_ge_inv u" +definition "reward sa = (case sa of (s,a) \<Rightarrow> exp_rev (s + a) - order_cost a - inv_cost (s + a))" +lift_definition transition :: "('s \<times> 's) \<Rightarrow> 's pmf" is "\<lambda>(s, a) s'. + (if CARD('s) \<le> Rep s + Rep a + then (if s' = 0 then 1 else 0) + else (if s + a < s' then 0 else + if s' = 0 then prob_ge_inv (s+a) + else pmf demand_prob (s + a - s'))) + " +proof (safe, goal_cases) + case (1 a b x) + then show ?case unfolding prob_ge_inv_def using pmf_finite_le by auto +next + case (2 a b) + then show ?case + proof (cases "int CARD('s) \<le> Rep a + Rep b") next + case False + hence "(\<integral>\<^sup>+ x. ennreal (if int CARD('s) \<le> Rep a + Rep b then if x = 0 then 1 else 0 else if a + b < x then 0 else if x = 0 then prob_ge_inv (a + b) else pmf demand_prob (a + b - x)) \<partial>count_space UNIV) = + (\<Sum>x \<in> UNIV. (if a + b < x then 0 else if x = 0 then prob_ge_inv (a + b) else pmf demand_prob (a + b - x)))" + using pmf_nonneg prob_ge_inv_def pmf_finite_le + by (auto simp: nn_integral_count_space_finite intro!: sum_ennreal) + also have "\<dots> =(\<Sum>x \<in> UNIV. (if x = 0 then prob_ge_inv (a + b) else if a + b < x then 0 else pmf demand_prob (a + b - x)))" + by (auto intro!: sum.cong ennreal_cong simp add: leD least_mod_type) + also have "\<dots> = prob_ge_inv (a + b) + (\<Sum>x \<in> UNIV-{0}. (if a + b < x then 0 else pmf demand_prob (a + b - x)))" + by (auto simp: sum.remove[of UNIV 0]) + also have "\<dots> = prob_ge_inv (a + b) + (\<Sum>x\<in>{0<..}. (if a + b < x then 0 else pmf demand_prob (a + b - x)))" + by (auto simp add: greaterThan_def le_neq_trans least_mod_type intro!: cong[of "sum _"] ennreal_cong) + also have "\<dots> = prob_ge_inv (a + b) + (\<Sum>x\<in>{0<..a+b}. (pmf demand_prob (a + b - x)))" + unfolding atMost_def greaterThan_def greaterThanAtMost_def + by (auto simp: Collect_neg_eq[symmetric] not_less sum.If_cases) + also have "\<dots> = 1 - (\<Sum>j<(a + b). pmf demand_prob j) + (\<Sum>x\<in>{0<..a+b}. pmf demand_prob (a + b - x))" + unfolding prob_ge_inv_def + by auto + also have "\<dots> = 1 - (\<Sum>j<(a + b). pmf demand_prob j) + (\<Sum>x\<in>{..<a+b}. (pmf demand_prob x))" + proof - + have "(\<Sum>x\<in>{0<..a+b}. pmf demand_prob (a + b - x)) = (\<Sum>x\<in>{..<a+b}. (pmf demand_prob x))" + proof (intro sum.reindex_bij_betw bij_betw_imageI) + show "inj_on ((-) (a + b)) {0<..a + b}" + unfolding inj_on_def + by (metis add.left_cancel diff_add_cancel) + have "x + (a + b) = a + (b + x)" for x + by (metis add.assoc add.commute add_to_nat_def) + moreover have "x < a + b \<Longrightarrow> 0 < a + b - x" for x + by (metis add.left_neutral diff_add_cancel least_mod_type less_le) + moreover have "x < a + b \<Longrightarrow> a + b - x \<le> a + b" for x + by (metis diff_0_right least_mod_type less_le mod_less_diff not_less) + ultimately have "x < a + b \<Longrightarrow> \<exists>xa. x = a + b - xa \<and> 0 < xa \<and> xa \<le> a + b" for x + by (auto simp: algebra_simps intro: exI[of _ "a + b - x"]) + thus "(-) (a + b) ` {0<..a + b} = {..<a + b}" + by (fastforce intro!: mod_less_diff) + qed + thus ?thesis + by auto + qed + also have "\<dots> = 1" + by auto + finally show ?thesis. + qed (simp add: nn_integral_count_space_finite) +qed + +definition "A_inv (s::'s) = {a::'s. Rep s + Rep a < CARD('s)}" + +end + +definition "var_cost_lin (c::real) n = c * Rep n" +definition "inv_cost_lin (c::real) n = c * Rep n" +definition "revenue_lin (c::real) n = c * Rep n" + +lift_definition demand_unif :: "('a::finite) pmf" is "\<lambda>_. 1 / card (UNIV::'a set)" + by (auto simp: ennreal_divide_times divide_ennreal[symmetric] ennreal_of_nat_eq_real_of_nat) + +lift_definition demand_three :: "3 pmf" is "\<lambda>i. if i = 1 then 1/4 else if i = 2 then 1/2 else 1/4" +proof - + have *: "(UNIV :: (3 set)) = {0,1,2}" + using exhaust_3 + by fastforce + show ?thesis + apply (auto simp: nn_integral_count_space_finite) + unfolding * + by auto +qed + +abbreviation "fixed_cost \<equiv> 4" +abbreviation "var_cost \<equiv> var_cost_lin 2" +abbreviation "inv_cost \<equiv> inv_cost_lin 1" +abbreviation "revenue \<equiv> revenue_lin 8" +abbreviation "discount \<equiv> 0.99" +type_synonym capacity = "30" + +lemma card_ge_2_imp_ne: "CARD('a) \<ge> 2 \<Longrightarrow> \<exists>(x::'a::finite) y::'a. x \<noteq> y" + by (meson card_2_iff' ex_card) + +global_interpretation inventory_ex: inventory fixed_cost "var_cost:: capacity \<Rightarrow> real" inv_cost demand_unif revenue discount + defines A_inv = inventory_ex.A_inv + and transition = inventory_ex.transition + and reward = inventory_ex.reward + and prob_ge_inv = inventory_ex.prob_ge_inv + and order_cost = inventory_ex.order_cost + and exp_rev = inventory_ex.exp_rev. + +abbreviation "K \<equiv> inventory_ex.transition" +abbreviation "A \<equiv> inventory_ex.A_inv" +abbreviation "r \<equiv> inventory_ex.reward" +abbreviation "l \<equiv> 0.95" +definition "eps = 0.1" + +definition "fun_to_list f = map f (sorted_list_of_set UNIV)" +definition "benchmark_gs (_ :: unit) = map Rep (fun_to_list (vi_policy' K A r l eps 0))" +definition "benchmark_vi (_ :: unit) = map Rep (fun_to_list (vi_gs_policy K A r l eps 0))" +definition "benchmark_mpi (_ :: unit ) = map Rep (fun_to_list (fst (mpi_user K A r l eps (\<lambda>_ _. 3))))" +definition "benchmark_pi (_ :: unit) = map Rep (fun_to_list (policy_iteration K A r l 0))" + +fun vs_n where + "vs_n 0 v = v" +| "vs_n (Suc n) v = vs_n n (mod_MDP_\<L>\<^sub>b K A r l v)" + +definition "vs_n' n = vs_n n 0" + +definition "benchmark_vi_n n = (fun_to_list (vs_n n 0))" +definition "benchmark_vi_nopol = (fun_to_list (mod_MDP_value_iteration K A r l (1/10) 0))" + +(* +value "benchmark_gs ()" +value "benchmark_vi ()" +value "benchmark_pi ()" +value "benchmark_mpi ()" +*) + + +export_code dist vs_n' benchmark_vi_nopol benchmark_vi_n nat_of_integer integer_of_int benchmark_gs benchmark_vi benchmark_mpi benchmark_pi + in Haskell module_name DP + +export_code integer_of_int benchmark_gs benchmark_vi benchmark_mpi benchmark_pi in SML module_name DP + +end \ No newline at end of file diff --git a/thys/MDP-Algorithms/examples/Examples.thy b/thys/MDP-Algorithms/examples/Examples.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Algorithms/examples/Examples.thy @@ -0,0 +1,8 @@ +(* Author: Maximilian Schäffeler *) + +theory Examples + imports + Code_Inventory + Code_Gridworld +begin +end \ No newline at end of file diff --git a/thys/MDP-Rewards/Blinfun_Util.thy b/thys/MDP-Rewards/Blinfun_Util.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/Blinfun_Util.thy @@ -0,0 +1,513 @@ +(* Author: Maximilian Schäffeler *) +section \<open>Bounded Linear Functions\<close> +theory Blinfun_Util + imports + "HOL-Analysis.Bounded_Linear_Function" + Bounded_Functions +begin + +subsection \<open>Composition\<close> + +lemma blinfun_compose_id[simp]: + "id_blinfun o\<^sub>L f = f" + "f o\<^sub>L id_blinfun = f" + by (auto intro!: blinfun_eqI) + +lemma blinfun_compose_assoc: "F o\<^sub>L G o\<^sub>L H = F o\<^sub>L (G o\<^sub>L H)" + using blinfun_apply_inject by fastforce + +lemma blinfun_compose_diff_right: "f o\<^sub>L (g - h) = (f o\<^sub>L g) - (f o\<^sub>L h)" + by (auto intro!: blinfun_eqI simp: blinfun.bilinear_simps) + +subsection \<open>Power\<close> + +overloading + blinfunpow \<equiv> "compow :: nat \<Rightarrow> ('a::real_normed_vector \<Rightarrow>\<^sub>L 'a) \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)" +begin + +primrec blinfunpow :: "nat \<Rightarrow> ('a::real_normed_vector \<Rightarrow>\<^sub>L 'a) \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)" + where + "blinfunpow 0 f = id_blinfun" + | "blinfunpow (Suc n) f = f o\<^sub>L blinfunpow n f" + +end + +lemma bounded_pow_blinfun[intro]: + assumes "bounded (range (F::nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow>\<^sub>L 'a))" + shows "bounded (range (\<lambda>t. (F t)^^(Suc n)))" + using assms proof - + assume "bounded (range F)" + then obtain b where bh: "\<And>x. norm (F x) \<le> b" + by (auto simp: bounded_iff) + hence "norm ((F x)^^(Suc n)) \<le> b^(Suc n)" for x + using bh + by (induction n) (auto intro!: order.trans[OF norm_blinfun_compose] simp: mult_mono') + thus ?thesis + by (auto intro!: boundedI) +qed + +lemma blincomp_scaleR_right: "(a *\<^sub>R (F :: 'a :: real_normed_vector \<Rightarrow>\<^sub>L 'a)) ^^ t = a^t *\<^sub>R F^^t" + by (induction t) (auto intro: blinfun_eqI simp: blinfun.scaleR_left blinfun.scaleR_right) +lemma summable_inv_Q: + fixes Q :: "'a :: banach \<Rightarrow>\<^sub>L 'a" + assumes onorm_le: "norm (id_blinfun - Q) < 1" + shows "summable (\<lambda>n. (id_blinfun - Q)^^n)" + using onorm_le norm_blinfun_compose + by (force intro!: summable_ratio_test) + +lemma blinfunpow_assoc: "(F::'a::real_normed_vector \<Rightarrow>\<^sub>L 'a) ^^ (Suc n) =(F ^^n) o\<^sub>L F" + by (induction n) (auto simp: blinfun_compose_assoc[symmetric]) + +lemma norm_blinfunpow_le: "norm ((f :: 'b :: real_normed_vector \<Rightarrow>\<^sub>L 'b) ^^ n) \<le> norm f ^ n" + by (induction n) (auto simp: norm_blinfun_id_le intro!: order.trans[OF norm_blinfun_compose] mult_left_mono) + +lemma blinfunpow_nonneg: + assumes "\<And>v. 0 \<le> v \<Longrightarrow> 0 \<le> blinfun_apply (f :: ('b :: {ord, real_normed_vector} \<Rightarrow>\<^sub>L 'b)) v" + shows "0 \<le> v \<Longrightarrow> 0 \<le> (f^^n) v" + by(induction n) (auto simp: assms) + +lemma blinfunpow_mono: + assumes "\<And>u v. u \<le> v \<Longrightarrow> (f :: 'b :: {ord, real_normed_vector} \<Rightarrow>\<^sub>L 'b) u \<le> f v" + shows "u \<le> v \<Longrightarrow> (f^^n) u \<le> (f^^n) v" + by (induction n) (auto simp: assms) + +lemma banach_blinfun: + fixes C :: "'b :: {real_normed_vector, complete_space} \<Rightarrow>\<^sub>L 'b" + assumes "norm C < 1" + shows "\<exists>!v. C v = v" "\<And>v. (\<lambda>n. (C ^^ n) v) \<longlonglongrightarrow> (THE v. C v = v)" + using assms +proof - + obtain v where "C v = v" "\<forall>v'. C v' = v' \<longrightarrow> v' = v" + using assms banach_fix_type[of "norm C" "blinfun_apply C"] + by (metis blinfun.zero_right less_irrefl mult.left_neutral mult_less_le_imp_less + norm_blinfun norm_conv_dist norm_ge_zero zero_less_dist_iff) + obtain l where "(\<forall>v u. norm (C (v - u)) \<le> l * dist v u)" "0 \<le> l" "l < 1" + by (metis assms dist_norm norm_blinfun norm_imp_pos_and_ge) + hence 1: "dist (C v) (C u) \<le> l * dist v u" for v u + by (simp add: blinfun.diff_right dist_norm) + have 2: "dist ((C ^^ n) v0) v \<le> l ^ n * dist v0 v" for n v0 + using \<open>0 \<le> l\<close> + by (induction n) (auto simp: mult.assoc + intro!: mult_mono' order.trans[OF 1[of _ v , unfolded \<open>C v = v\<close>]]) + have "(\<lambda>n. l ^ n) \<longlonglongrightarrow> 0" + by (simp add: LIMSEQ_realpow_zero \<open>0 \<le> l\<close> \<open>l < 1\<close>) + hence k: "\<And>v0. (\<lambda>n. l ^ n * dist v0 v) \<longlonglongrightarrow> 0" + by (auto simp add: tendsto_mult_left_zero) + have "(\<lambda>n. dist ((C ^^ n) v0) v) \<longlonglongrightarrow> 0" for v0 + using k 2 order_trans abs_ge_self + by (subst Limits.tendsto_0_le[where ?K = 1, where ?f = "(\<lambda>n. l ^ n * dist v0 v)"]) + (fastforce intro: eventuallyI)+ + hence "\<And>v0. (\<lambda>n. (C ^^ n) v0) \<longlonglongrightarrow> v" + using tendsto_dist_iff + by blast + thus "(\<lambda>n. (C ^^ n) v0) \<longlonglongrightarrow> (THE v. C v = v)" for v0 + using theI'[of "\<lambda>x. C x = x"] \<open>C v = v\<close> \<open>\<forall>v'. C v' = v' \<longrightarrow> v' = v\<close> + by blast +next + show "norm C < 1 \<Longrightarrow> \<exists>!v. blinfun_apply C v = v" + by (auto intro!: banach_fix_type[OF _ assms] + simp: dist_norm norm_blinfun blinfun.diff_right[symmetric]) +qed + +subsection \<open>Geometric Sum\<close> + +lemma inv_one_sub_Q: + fixes Q :: "'a :: banach \<Rightarrow>\<^sub>L 'a" + assumes onorm_le: "norm (id_blinfun - Q) < 1" + shows "(Q o\<^sub>L (\<Sum>i. (id_blinfun - Q)^^i)) = id_blinfun" + and "(\<Sum>i. (id_blinfun - Q)^^i) o\<^sub>L Q = id_blinfun" +proof - + obtain b where bh: "b < 1" "norm (id_blinfun - Q) < b" + using onorm_le dense + by blast + have "0 < b" + using le_less_trans[OF norm_ge_zero bh(2)] . + have norm_le_aux: "norm ((id_blinfun - Q)^^Suc n) \<le> b^(Suc n)" for n + proof (induction n) + case 0 + thus ?case + using bh + by simp + next + case (Suc n) + thus ?case + proof - + have "norm ((id_blinfun - Q) ^^ Suc (Suc n)) \<le> norm (id_blinfun - Q) * norm((id_blinfun - Q) ^^ Suc n)" + using norm_blinfun_compose + by auto + thus ?thesis + using Suc.IH \<open>0 < b\<close> bh order.trans + by (fastforce simp: mult_mono') + qed + qed + have "(Q o\<^sub>L (\<Sum>i\<le>n. (id_blinfun - Q)^^i)) = (id_blinfun - (id_blinfun - Q)^^(Suc n))" for n + by (induction n) (auto simp: bounded_bilinear.diff_left bounded_bilinear.add_right + bounded_bilinear_blinfun_compose) + hence "\<And>n. norm (id_blinfun - (Q o\<^sub>L (\<Sum>i\<le>n. (id_blinfun - Q)^^i))) \<le> b^Suc n" + using norm_le_aux + by auto + hence l2: "(\<lambda>n. (id_blinfun - (Q o\<^sub>L (\<Sum>i\<le>n. (id_blinfun - Q)^^i)))) \<longlonglongrightarrow> 0" + using \<open>0 < b\<close> bh + by (subst Lim_transform_bound[where g="\<lambda>n. b^Suc n"]) (auto intro!: tendsto_eq_intros) + have "summable (\<lambda>n. (id_blinfun - Q)^^n)" + using onorm_le norm_blinfun_compose + by (force intro!: summable_ratio_test) + hence "(\<lambda>n. \<Sum>i\<le>n. (id_blinfun - Q)^^i) \<longlonglongrightarrow> (\<Sum>i. (id_blinfun - Q)^^i)" + using summable_LIMSEQ' + by blast + hence "(\<lambda>n. Q o\<^sub>L (\<Sum>i\<le>n. (id_blinfun - Q)^^i)) \<longlonglongrightarrow> (Q o\<^sub>L (\<Sum>i. (id_blinfun - Q)^^i))" + using bounded_bilinear_blinfun_compose + by (subst Limits.bounded_bilinear.tendsto[where prod = "(o\<^sub>L)"]) auto + hence "(\<lambda>n. id_blinfun - (Q o\<^sub>L (\<Sum>i\<le>n. (id_blinfun - Q)^^i))) \<longlonglongrightarrow> + id_blinfun - (Q o\<^sub>L (\<Sum>i. (id_blinfun - Q)^^i))" + by (subst Limits.tendsto_diff) auto + thus "(Q o\<^sub>L (\<Sum>i. (id_blinfun - Q)^^i)) = id_blinfun" + using LIMSEQ_unique l2 by fastforce + + have "((\<Sum>i\<le>n. (id_blinfun - Q)^^i) o\<^sub>L Q) = (id_blinfun - (id_blinfun - Q)^^(Suc n))" for n + proof (induction n) + case (Suc n) + have "sum ((^^) (id_blinfun - Q)) {..Suc n} o\<^sub>L Q = + (sum ((^^) (id_blinfun - Q)) {..n} o\<^sub>L Q) + ((id_blinfun - Q) ^^Suc n o\<^sub>L Q)" + by (simp add: bounded_bilinear.add_left bounded_bilinear_blinfun_compose) + also have "\<dots> = id_blinfun - (((id_blinfun - Q)^^(Suc n) o\<^sub>L id_blinfun) - + ((id_blinfun - Q) ^^Suc n o\<^sub>L Q))" + using Suc.IH + by auto + also have "\<dots> = id_blinfun - (((id_blinfun - Q)^^(Suc n) o\<^sub>L (id_blinfun - Q)))" + by (auto intro!: blinfun_eqI simp: blinfun.diff_right blinfun.diff_left blinfun.minus_left) + also have "\<dots> = id_blinfun - (((id_blinfun - Q)^^(Suc (Suc n))))" + using blinfunpow_assoc + by metis + finally show ?case + by auto + qed simp + hence "\<And>n. norm (id_blinfun - ((\<Sum>i\<le>n. (id_blinfun - Q)^^i) o\<^sub>L Q)) \<le> b^Suc n" + using norm_le_aux by auto + hence l2: "(\<lambda>n. id_blinfun - ((\<Sum>i\<le>n. (id_blinfun - Q)^^i) o\<^sub>L Q)) \<longlonglongrightarrow> 0" + using \<open>0 < b\<close> bh + by (subst Lim_transform_bound[where g="\<lambda>n. b^Suc n"]) (auto intro!: tendsto_eq_intros) + have "summable (\<lambda>n. (id_blinfun - Q)^^n)" + using local.onorm_le norm_blinfun_compose + by (force intro!: summable_ratio_test) + hence "(\<lambda>n. \<Sum>i\<le>n. (id_blinfun - Q)^^i) \<longlonglongrightarrow> (\<Sum>i. (id_blinfun - Q)^^i)" + using summable_LIMSEQ' by blast + hence "(\<lambda>n. (\<Sum>i\<le>n. (id_blinfun - Q)^^i) o\<^sub>L Q) \<longlonglongrightarrow> ((\<Sum>i. (id_blinfun - Q)^^i) o\<^sub>L Q)" + using bounded_bilinear_blinfun_compose + by (subst Limits.bounded_bilinear.tendsto[where prod = "(o\<^sub>L)"]) auto + hence "(\<lambda>n. id_blinfun - ((\<Sum>i\<le>n. (id_blinfun - Q)^^i) o\<^sub>L Q)) \<longlonglongrightarrow> + id_blinfun - ((\<Sum>i. (id_blinfun - Q)^^i) o\<^sub>L Q)" + by (subst Limits.tendsto_diff) auto + thus "((\<Sum>i. (id_blinfun - Q)^^i) o\<^sub>L Q) = id_blinfun" + using LIMSEQ_unique l2 by fastforce +qed + +lemma inv_norm_le: + fixes Q :: "'a :: banach \<Rightarrow>\<^sub>L 'a" + assumes "norm Q < 1" + shows "(id_blinfun-Q) o\<^sub>L (\<Sum>i. Q^^i) = id_blinfun" + "(\<Sum>i. Q^^i) o\<^sub>L (id_blinfun-Q) = id_blinfun" + using inv_one_sub_Q[of "id_blinfun - Q"] assms + by auto + +lemma inv_norm_le': + fixes Q :: "'a :: banach \<Rightarrow>\<^sub>L 'a" + assumes "norm Q < 1" + shows "(id_blinfun-Q) ((\<Sum>i. Q^^i) x) = x" + "(\<Sum>i. Q^^i) ((id_blinfun-Q) x) = x" + using inv_norm_le assms + by (auto simp del: blinfun_apply_blinfun_compose + simp: inv_norm_le blinfun_apply_blinfun_compose[symmetric]) + +subsection \<open>Inverses\<close> + +definition "is_inverse\<^sub>L X Y \<longleftrightarrow> X o\<^sub>L Y = id_blinfun \<and> Y o\<^sub>L X = id_blinfun" + +abbreviation "invertible\<^sub>L X \<equiv> \<exists>X'. is_inverse\<^sub>L X X'" + +lemma is_inverse\<^sub>L_I[intro]: + assumes "X o\<^sub>L Y = id_blinfun" "Y o\<^sub>L X = id_blinfun" + shows "is_inverse\<^sub>L X Y" + using assms + unfolding is_inverse\<^sub>L_def + by auto + +lemma is_inverse\<^sub>L_D[dest]: + assumes "is_inverse\<^sub>L X Y" + shows "X o\<^sub>L Y = id_blinfun" "Y o\<^sub>L X = id_blinfun" + using assms + unfolding is_inverse\<^sub>L_def + by auto + +lemma invertible\<^sub>L_D[dest]: + assumes "invertible\<^sub>L f" + obtains g where "f o\<^sub>L g = id_blinfun" "g o\<^sub>L f = id_blinfun" + using assms + by auto + +lemma invertible\<^sub>L_I[intro]: + assumes "f o\<^sub>L g = id_blinfun" "g o\<^sub>L f = id_blinfun" + shows "invertible\<^sub>L f" + using assms + by auto + +lemma is_inverse\<^sub>L_comm: "is_inverse\<^sub>L X Y \<longleftrightarrow> is_inverse\<^sub>L Y X" + by auto + +lemma is_inverse\<^sub>L_unique: "is_inverse\<^sub>L f g \<Longrightarrow> is_inverse\<^sub>L f h \<Longrightarrow> g = h" + unfolding is_inverse\<^sub>L_def + using blinfun_compose_assoc blinfun_compose_id(1) + by metis + +lemma is_inverse\<^sub>L_ex1: "is_inverse\<^sub>L f g \<Longrightarrow> \<exists>!h. is_inverse\<^sub>L f h" + using is_inverse\<^sub>L_unique + by auto + +lemma is_inverse\<^sub>L_ex1': "\<exists>x. is_inverse\<^sub>L f x \<Longrightarrow> \<exists>!x. is_inverse\<^sub>L f x" + using is_inverse\<^sub>L_ex1 + by auto + +definition "inv\<^sub>L f = (THE g. is_inverse\<^sub>L f g)" + +lemma inv\<^sub>L_eq: + assumes "is_inverse\<^sub>L f g" + shows "inv\<^sub>L f = g" + unfolding inv\<^sub>L_def + using assms is_inverse\<^sub>L_ex1 + by (auto intro!: the_equality) + +lemma inv\<^sub>L_I: + assumes "f o\<^sub>L g = id_blinfun" "g o\<^sub>L f = id_blinfun" + shows "g = inv\<^sub>L f" + using assms inv\<^sub>L_eq + unfolding is_inverse\<^sub>L_def + by auto + +lemma inv_app1 [simp]: "invertible\<^sub>L X \<Longrightarrow> (inv\<^sub>L X) o\<^sub>L X = id_blinfun" + using is_inverse\<^sub>L_ex1' inv\<^sub>L_eq + by blast + +lemma inv_app2[simp]: "invertible\<^sub>L X \<Longrightarrow> X o\<^sub>L (inv\<^sub>L X) = id_blinfun" + using is_inverse\<^sub>L_ex1' inv\<^sub>L_eq + by blast + +lemma inv_app1'[simp]: "invertible\<^sub>L X \<Longrightarrow> inv\<^sub>L X (X v) = v" + using inv_app1 blinfun_apply_blinfun_compose id_blinfun.rep_eq + by metis + +lemma inv_app2'[simp]: "invertible\<^sub>L X \<Longrightarrow> X (inv\<^sub>L X v) = v" + using inv_app2 blinfun_apply_blinfun_compose id_blinfun.rep_eq + by metis + +lemma [simp]: "invertible\<^sub>L X \<Longrightarrow> inv\<^sub>L (inv\<^sub>L X) = X" + by (metis inv\<^sub>L_eq is_inverse\<^sub>L_comm) + +lemma inv\<^sub>L_cancel_iff: + assumes "invertible\<^sub>L f" + shows "f x = y \<longleftrightarrow> x = inv\<^sub>L f y" + by (auto simp add: assms) + +lemma invertible\<^sub>L_inf_sum: + assumes "norm (X :: 'b :: banach \<Rightarrow>\<^sub>L 'b) < 1" + shows "invertible\<^sub>L (id_blinfun - X)" + using Blinfun_Util.inv_norm_le[OF assms] assms + by blast + +lemma inv\<^sub>L_inf_sum: + fixes X :: "'b :: banach \<Rightarrow>\<^sub>L _" + assumes "norm X < 1" + shows "inv\<^sub>L (id_blinfun - X) = (\<Sum>i. X ^^ i)" + using Blinfun_Util.inv_norm_le[OF assms] assms + by (auto simp: inv\<^sub>L_I[symmetric]) + +lemma is_inverse\<^sub>L_compose: + assumes "invertible\<^sub>L f" "invertible\<^sub>L g" + shows "is_inverse\<^sub>L (f o\<^sub>L g) (inv\<^sub>L g o\<^sub>L inv\<^sub>L f)" + by (auto intro!: blinfun_eqI is_inverse\<^sub>L_I[of _ "inv\<^sub>L g o\<^sub>L inv\<^sub>L f"] + simp: inv_app2'[OF assms(1)] inv_app2'[OF assms(2)] inv_app1'[OF assms(1)] inv_app1'[OF assms(2)]) + +lemma invertible\<^sub>L_compose: "invertible\<^sub>L f \<Longrightarrow> invertible\<^sub>L g \<Longrightarrow> invertible\<^sub>L (f o\<^sub>L g)" + using is_inverse\<^sub>L_compose + by blast + +lemma inv\<^sub>L_compose: + assumes "invertible\<^sub>L f" "invertible\<^sub>L g" + shows"inv\<^sub>L (f o\<^sub>L g) = (inv\<^sub>L g) o\<^sub>L (inv\<^sub>L f)" + using assms inv\<^sub>L_eq is_inverse\<^sub>L_compose + by blast + +lemma inv\<^sub>L_id_blinfun[simp]: "inv\<^sub>L id_blinfun = id_blinfun" + by (metis blinfun_compose_id(2) inv\<^sub>L_I) + + +subsection \<open>Norm\<close> +lemma bounded_range_subset: + "bounded (range f :: real set) \<Longrightarrow> bounded (f ` X')" + by (auto simp: bounded_iff) + +lemma bounded_const: "bounded ((\<lambda>_. x) ` X)" + by (meson finite_imp_bounded finite.emptyI finite_insert finite_subset image_subset_iff insert_iff) + +lift_definition bfun_pos :: "('d \<Rightarrow>\<^sub>b real) \<Rightarrow> ('d \<Rightarrow>\<^sub>b real)" is "\<lambda>f i. if f i < 0 then -f i else f i" + using bounded_const bounded_range_subset by (auto simp: bfun_def) + +lemma bfun_pos_zero[simp]: "bfun_pos f = 0 \<longleftrightarrow> f = 0" + by (auto intro!: bfun_eqI simp: bfun_pos.rep_eq split: if_splits) + +lift_definition bfun_nonneg :: "('d \<Rightarrow>\<^sub>b real) \<Rightarrow> ('d \<Rightarrow>\<^sub>b real)" is "\<lambda>f i. if f i \<le> 0 then 0 else f i" + using bounded_const bounded_range_subset by (auto simp: bfun_def) + +lemma bfun_nonneg_split: "bfun_nonneg x - bfun_nonneg (- x) = x" + by (auto simp: bfun_nonneg.rep_eq) + +lemma blinfun_split: "blinfun_apply f x = f (bfun_nonneg x) - f (bfun_nonneg (- x))" + using bfun_nonneg_split + by (metis blinfun.diff_right) + +lemma bfun_nonneg_pos: "bfun_nonneg x + bfun_nonneg (-x) = bfun_pos x" + by (auto simp: bfun_nonneg.rep_eq bfun_pos.rep_eq) + +lemma bfun_nonneg: "0 \<le> bfun_nonneg f" + by (auto simp: bfun_nonneg.rep_eq) + +lemma bfun_pos_eq_nonneg: "bfun_pos n = bfun_nonneg n + bfun_nonneg (-n)" + by (auto simp: bfun_pos.rep_eq bfun_nonneg.rep_eq) + +lemma blinfun_mono_norm_pos: + fixes f :: "('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('d \<Rightarrow>\<^sub>b real)" + assumes "\<And>v :: 'c \<Rightarrow>\<^sub>b real. v \<ge> 0 \<Longrightarrow> f v \<ge> 0" + shows "norm (f n) \<le> norm (f (bfun_pos n))" +proof - + have *: "\<bar>f n i\<bar> \<le> \<bar>f (bfun_pos n) i\<bar>" for i + by (auto simp: blinfun_split[of f n] bfun_nonneg_pos[symmetric] blinfun.add_right abs_real_def) + (metis add_nonneg_nonneg assms bfun_nonneg leD less_eq_bfun_def zero_bfun.rep_eq)+ + thus "norm (f n) \<le> norm ((f (bfun_pos n)))" + unfolding norm_bfun_def' using * + by (auto intro!: cSUP_mono bounded_imp_bdd_above abs_le_norm_bfun boundedI[of _ "norm ((f (bfun_pos n)))"]) +qed + +lemma norm_bfun_pos[simp]: "norm (bfun_pos f) = norm f" +proof - + have "norm (bfun_pos f) = (\<Squnion>i. \<bar>bfun_pos f i\<bar>)" + by (auto simp add: norm_bfun_def') + also have "\<dots> = (\<Squnion>i. \<bar>f i\<bar>)" + by (rule SUP_cong[OF refl]) (auto simp: bfun_pos.rep_eq) + finally show ?thesis by (auto simp add: norm_bfun_def') +qed + +lemma norm_blinfun_mono_eq_nonneg: + fixes f :: "('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('d \<Rightarrow>\<^sub>b real)" + assumes "\<And>v :: 'c \<Rightarrow>\<^sub>b real. v \<ge> 0 \<Longrightarrow> f v \<ge> 0" + shows "norm f = (\<Squnion>v \<in> {v. v \<ge> 0}. norm (f v) / norm v)" + unfolding norm_blinfun.rep_eq onorm_def +proof (rule antisym, rule cSUP_mono) + have *: "norm (blinfun_apply f v) / norm v \<le> norm f" for v + using norm_blinfun[of f] + by (cases "v = 0") (auto simp: pos_divide_le_eq) + thus "bdd_above ((\<lambda>v. norm (f v) / norm v) ` {v. 0 \<le> v})" + by (auto intro!: bounded_imp_bdd_above boundedI) + show "\<exists>m\<in>{v. 0 \<le> v}. norm (f n) / norm n \<le> norm (f m) / norm m" for n + using blinfun_mono_norm_pos[OF assms] + by (cases "norm (bfun_pos n) = 0") + (auto intro!: frac_le exI[of _ "bfun_pos n"] simp: less_eq_bfun_def bfun_pos.rep_eq) + show "(\<Squnion>v\<in>{v. 0 \<le> v}. norm (f v) / norm v) \<le> (\<Squnion>x. norm (f x) / norm x)" + using * + by (auto intro!: cSUP_mono bounded_imp_bdd_above boundedI) +qed auto + +lemma norm_blinfun_normalized_le: "norm (blinfun_apply f v) / norm v \<le> norm f" + by (simp add: blinfun.bounded_linear_right le_onorm norm_blinfun.rep_eq) + +lemma norm_blinfun_mono_eq_nonneg': + fixes f :: "('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('d \<Rightarrow>\<^sub>b real)" + assumes "\<And>v :: 'c \<Rightarrow>\<^sub>b real. 0 \<le> v \<Longrightarrow> 0 \<le> f v" + shows "norm f = (\<Squnion>x \<in> {x. norm x = 1 \<and> x \<ge> 0}. norm (f x))" +proof (subst norm_blinfun_mono_eq_nonneg[OF assms]) + show "(\<Squnion>v\<in>{v. 0 \<le> v}. norm (f v) / norm v) = + (\<Squnion>x\<in>{x. norm x = 1 \<and> 0 \<le> x}. norm (f x))" + proof (rule antisym, rule cSUP_mono) + show "{v::'c \<Rightarrow>\<^sub>b real. 0 \<le> v} \<noteq> {}" by auto + show "bdd_above ((\<lambda>x. norm (f x)) ` {x. norm x = 1 \<and> 0 \<le> x})" + by (fastforce intro: order.trans[OF norm_blinfun[of f]] bounded_imp_bdd_above boundedI) + show "\<exists>m\<in>{x. norm x = 1 \<and> 0 \<le> x}. norm (f n) / norm n \<le> norm (f m)" if "n \<in> {v. 0 \<le> v}" for n + proof (cases "norm (bfun_pos n) = 0") + case True + then show ?thesis by (auto intro!: exI[of _ 1]) + next + case False + then show ?thesis + using that + by (auto simp: scaleR_nonneg_nonneg blinfun.scaleR_right intro!: exI[of _ "(1/norm n) *\<^sub>R n"]) + qed + show "(\<Squnion>x\<in>{x. norm x = 1 \<and> 0 \<le> x}. norm (f x)) \<le> (\<Squnion>v\<in>{v. 0 \<le> v}. norm (f v) / norm v)" + proof (rule cSUP_mono) + show "{x::'c \<Rightarrow>\<^sub>b real. norm x = 1 \<and> 0 \<le> x} \<noteq> {}" + by (auto intro!: exI[of _ 1]) + qed (fastforce intro!: norm_blinfun_normalized_le bounded_imp_bdd_above boundedI)+ + qed +qed auto + +lemma norm_blinfun_mono_le_norm_one: + fixes f :: "('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('d \<Rightarrow>\<^sub>b real)" + assumes "\<And>v :: 'c \<Rightarrow>\<^sub>b real. v \<ge> 0 \<Longrightarrow> f v \<ge> 0" + assumes "norm x = 1" "0 \<le> x" + shows "norm (f x) \<le> norm (f 1)" +proof - + have **: "0 \<le> 1 - x" + using assms + by (auto simp: less_eq_bfun_def intro: order.trans[OF le_norm_bfun]) + show ?thesis + unfolding norm_bfun_def' + proof (intro cSUP_mono) + show"bdd_above (range (\<lambda>x. norm (apply_bfun (blinfun_apply f 1) x)))" + using order.trans abs_le_norm_bfun norm_blinfun + by (fastforce intro!: bounded_imp_bdd_above boundedI) + show "\<exists>m\<in>UNIV. norm (f x n) \<le> norm (f 1 m)" for n + using assms(1) assms(3) assms(1)[of "1 - x"] ** + unfolding less_eq_bfun_def zero_bfun.rep_eq abs_real_def + by (auto simp: blinfun.diff_right linorder_class.not_le[symmetric]) + qed auto +qed + +lemma norm_blinfun_mono_eq_one: + fixes f :: "('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('d \<Rightarrow>\<^sub>b real)" + assumes "\<And>v :: 'c \<Rightarrow>\<^sub>b real. v \<ge> 0 \<Longrightarrow> f v \<ge> 0" + shows "norm f = norm (f 1)" +proof - + have "(\<Squnion>x\<in>{x. norm x = 1 \<and> 0 \<le> x}. norm (f x)) = norm (f 1)" + proof (rule antisym, rule cSUP_least) + show "{x::'c \<Rightarrow>\<^sub>b real. norm x = 1 \<and> 0 \<le> x} \<noteq> {}" + by (auto intro!: exI[of _ 1]) + next + show "\<And>x. x \<in> {x. norm x = 1 \<and> 0 \<le> x} \<Longrightarrow> norm (f x) \<le> norm (f 1)" + by (simp add: assms norm_blinfun_mono_le_norm_one) + next + show "norm (f 1) \<le> (\<Squnion>x\<in>{x. norm x = 1 \<and> 0 \<le> x}. norm (f x))" + by (rule cSUP_upper) (fastforce intro!: bdd_aboveI2 order.trans[OF norm_blinfun])+ + qed + thus ?thesis + using norm_blinfun_mono_eq_nonneg'[OF assms] + by auto +qed + +subsection \<open>Miscellaneous\<close> + +lemma bounded_linear_apply_bfun: "bounded_linear (\<lambda>x. apply_bfun x i)" + using norm_le_norm_bfun + by (fastforce intro: bounded_linear_intro[of _ 1]) + +lemma lim_blinfun_apply: "convergent X \<Longrightarrow> (\<lambda>n. blinfun_apply (X n) u) \<longlonglongrightarrow> lim X u" + using blinfun.bounded_bilinear_axioms + by (auto simp: convergent_LIMSEQ_iff intro: Limits.bounded_bilinear.tendsto) + +lemma bounded_apply_blinfun: + assumes "bounded ((F :: 'c \<Rightarrow> 'd::real_normed_vector \<Rightarrow>\<^sub>L 'b::real_normed_vector) ` S)" + shows "bounded ((\<lambda>b. blinfun_apply (F b) x) ` S)" +proof - + obtain b where "\<forall>x\<in>S. norm (F x) \<le> b" + by (meson \<open>bounded (F ` S)\<close> bounded_pos image_eqI) + thus "bounded ((\<lambda>b. (F b) x) ` S)" + by (auto simp: mult_right_mono mult.commute[of _ b] + intro!: boundedI[of _ "norm x * b"] dual_order.trans[OF _ norm_blinfun]) +qed +end \ No newline at end of file diff --git a/thys/MDP-Rewards/Bounded_Functions.thy b/thys/MDP-Rewards/Bounded_Functions.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/Bounded_Functions.thy @@ -0,0 +1,523 @@ +(* Author: Maximilian Schäffeler, adapted from HOL-Analysis.Bounded_Continuous_Function *) + +section \<open>Bounded Functions\<close> + +theory Bounded_Functions + imports + "HOL.Topological_Spaces" + "HOL-Analysis.Uniform_Limit" + "HOL-Probability.Probability" +begin + +subsection \<open>Definition\<close> + +definition\<^marker>\<open>tag important\<close> "bfun = {f. bounded (range f)}" + +typedef (overloaded) ('a, 'b) bfun ("(_ \<Rightarrow>\<^sub>b _)" [22] 21) = + "bfun::('a \<Rightarrow> 'b :: metric_space) set" + morphisms apply_bfun Bfun + by (fastforce simp: bounded_def bfun_def) + +declare [[coercion "apply_bfun :: ('a \<Rightarrow>\<^sub>b ('b :: metric_space)) \<Rightarrow> 'a \<Rightarrow> 'b"]] + +setup_lifting type_definition_bfun + +lemma bounded_apply_bfun[intro, simp]: "bounded (range (apply_bfun x))" + using apply_bfun by (auto simp: bfun_def) + +lemma bfun_eqI[intro]: "(\<And>x. apply_bfun f x = apply_bfun g x) \<Longrightarrow> f = g" + by transfer auto + +lemma bfun_eqD[dest]: "f = g \<Longrightarrow> (\<And>x. apply_bfun f x = apply_bfun g x)" + by auto + +lemma bfunE: + assumes "f \<in> bfun" + obtains g where "f = apply_bfun g" + by (blast intro: apply_bfun_cases assms) + +lemma const_bfun: "(\<lambda>x. b) \<in> bfun" + by (auto simp: bfun_def image_def) + +lift_definition const_bfun::"'b \<Rightarrow> ('a \<Rightarrow>\<^sub>b ('b :: metric_space))" is "\<lambda>(c::'b) _. c" + by (rule const_bfun) + +lemma bounded_dist_le_SUP_dist: + "bounded (range f) \<Longrightarrow> bounded (range g) \<Longrightarrow> dist (f x) (g x) \<le> (SUP x. dist (f x) (g x))" + by (auto intro!: cSUP_upper bounded_imp_bdd_above bounded_dist_comp) + +instantiation bfun :: (type, metric_space) metric_space +begin + +lift_definition\<^marker>\<open>tag important\<close> dist_bfun :: "('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> real" + is "\<lambda>f g. (SUP x. dist (f x) (g x))" . + +definition uniformity_bfun :: "(('a \<Rightarrow>\<^sub>b 'b) \<times> 'a \<Rightarrow>\<^sub>b 'b) filter" + where "uniformity_bfun = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})" + +definition open_bfun :: "('a \<Rightarrow>\<^sub>b 'b) set \<Rightarrow> bool" + where "open_bfun S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)" + +lemma dist_bounded: + fixes f g :: "'a \<Rightarrow>\<^sub>b 'b" + shows "dist (f x) (g x) \<le> dist f g" + by transfer (auto intro!: bounded_dist_le_SUP_dist simp: bfun_def) + +lemma dist_bound: + fixes f g :: "'a \<Rightarrow>\<^sub>b ('b :: metric_space)" + assumes "\<And>x. dist (f x) (g x) \<le> b" + shows "dist f g \<le> b" + using assms + by transfer (auto intro!: cSUP_least) + +lemma dist_fun_lt_imp_dist_val_lt: + fixes f g :: "'a \<Rightarrow>\<^sub>b 'b" + assumes "dist f g < e" + shows "dist (f x) (g x) < e" + using dist_bounded assms + by (rule le_less_trans) + +instance +proof + fix f g h :: "'a \<Rightarrow>\<^sub>b 'b" + show "dist f g = 0 \<longleftrightarrow> f = g" + proof + have "\<And>x. dist (f x) (g x) \<le> dist f g" + by (rule dist_bounded) + also assume "dist f g = 0" + finally show "f = g" + by (auto simp: apply_bfun_inject[symmetric]) + qed (auto simp: dist_bfun_def intro!: cSup_eq) + show "dist f g \<le> dist f h + dist g h" + proof (rule dist_bound) + fix x + have "dist (f x) (g x) \<le> dist (f x) (h x) + dist (g x) (h x)" + by (rule dist_triangle2) + also have "dist (f x) (h x) \<le> dist f h" + by (rule dist_bounded) + also have "dist (g x) (h x) \<le> dist g h" + by (rule dist_bounded) + finally show "dist (f x) (g x) \<le> dist f h + dist g h" + by simp + qed +qed (rule open_bfun_def uniformity_bfun_def)+ + +end + + +lift_definition PiC::"'a set \<Rightarrow> ('a \<Rightarrow> ('b :: metric_space) set) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b) set" + is "\<lambda>I X. Pi I X \<inter> bfun" + by auto + +lemma mem_PiC_iff: "x \<in> PiC I X \<longleftrightarrow> apply_bfun x \<in> Pi I X" + by transfer simp + +lemmas mem_PiCD = mem_PiC_iff[THEN iffD1] + and mem_PiCI = mem_PiC_iff[THEN iffD2] + +lemma tendsto_bfun_uniform_limit: + fixes f::"'i \<Rightarrow> 'a \<Rightarrow>\<^sub>b ('b :: metric_space)" + assumes "(f \<longlongrightarrow> l) F" + shows "uniform_limit UNIV f l F" +proof (rule uniform_limitI) + fix e::real assume "e > 0" + from tendstoD[OF assms this] have "\<forall>\<^sub>F x in F. dist (f x) l < e" . + then show "\<forall>\<^sub>F n in F. \<forall>x\<in>UNIV. dist ((f n) x) (l x) < e" + by eventually_elim (auto simp: dist_fun_lt_imp_dist_val_lt) +qed + +lemma uniform_limit_tendsto_bfun: + fixes f::"'i \<Rightarrow> 'a \<Rightarrow>\<^sub>b ('b :: metric_space)" + and l::"'a \<Rightarrow>\<^sub>b 'b" + assumes "uniform_limit UNIV f l F" + shows "(f \<longlongrightarrow> l) F" +proof (rule tendstoI) + fix e::real assume "e > 0" + then have "e / 2 > 0" by simp + from uniform_limitD[OF assms this] + have "\<forall>\<^sub>F i in F. \<forall>x. dist (f i x) (l x) < e / 2" by simp + then have "\<forall>\<^sub>F x in F. dist (f x) l \<le> e / 2" + by eventually_elim (blast intro: dist_bound less_imp_le) + then show "\<forall>\<^sub>F x in F. dist (f x) l < e" + by eventually_elim (use \<open>0 < e\<close> in auto) +qed + +subsection\<^marker>\<open>tag unimportant\<close> \<open>Supremum Norm\<close> + +instantiation\<^marker>\<open>tag unimportant\<close> bfun :: (type, real_normed_vector) real_vector +begin + +lemma uminus_cont: "f \<in> bfun \<Longrightarrow> (\<lambda>x. - f x) \<in> bfun" for f::"'a \<Rightarrow> 'b" + by (auto simp: bfun_def) + +lemma plus_cont: "f \<in> bfun \<Longrightarrow> g \<in> bfun \<Longrightarrow> (\<lambda>x. f x + g x) \<in> bfun" for f g::"'a \<Rightarrow> 'b" + by (auto simp: bfun_def bounded_plus_comp) + +lemma minus_cont: "f \<in> bfun \<Longrightarrow> g \<in> bfun \<Longrightarrow> (\<lambda>x. f x - g x) \<in> bfun" for f g::"'a \<Rightarrow> 'b" + by (auto simp: bfun_def bounded_minus_comp) + +lemma scaleR_cont: "f \<in> bfun \<Longrightarrow> (\<lambda>x. a *\<^sub>R f x) \<in> bfun" for f :: "'a \<Rightarrow> 'b" + by (auto simp: bfun_def bounded_scaleR_comp) + +lemma bfun_normI[intro]: "(\<And>x. norm (f x) \<le> b) \<Longrightarrow> f \<in> bfun" + by (auto simp: bfun_def intro: boundedI) + +lift_definition uminus_bfun::"('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b)" is "\<lambda>f x. - f x" + by (rule uminus_cont) + +lift_definition plus_bfun::"('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>b 'b" is "\<lambda>f g x. f x + g x" + by (rule plus_cont) + +lift_definition minus_bfun::"('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>b 'b" is "\<lambda>f g x. f x - g x" + by (rule minus_cont) + +lift_definition zero_bfun::"'a \<Rightarrow>\<^sub>b 'b" is "\<lambda>_. 0" + by (rule const_bfun) + +lemma const_bfun_0_eq_0[simp]: "const_bfun 0 = 0" + by transfer simp + +lift_definition scaleR_bfun::"real \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>b 'b" is "\<lambda>r g x. r *\<^sub>R g x" + by (rule scaleR_cont) + +lemmas [simp] = + const_bfun.rep_eq + uminus_bfun.rep_eq + plus_bfun.rep_eq + minus_bfun.rep_eq + zero_bfun.rep_eq + scaleR_bfun.rep_eq + +instance + by standard (auto simp: algebra_simps) +end + +lemma scaleR_cont': "f \<in> bfun \<Longrightarrow> (\<lambda>x. a * f x) \<in> bfun" for f :: "'a \<Rightarrow> real" + using scaleR_cont[of f a] by auto + +lemma bfun_norm_le_SUP_norm: + "f \<in> bfun \<Longrightarrow> norm (f x) \<le> (SUP x. norm (f x))" + by (auto intro!: cSUP_upper bounded_imp_bdd_above simp: bfun_def bounded_norm_comp) + + +instantiation\<^marker>\<open>tag unimportant\<close> bfun :: (type, real_normed_vector) real_normed_vector +begin + +definition norm_bfun :: "('a, 'b) bfun \<Rightarrow> real" + where "norm_bfun f = dist f 0" + +definition "sgn (f::('a,'b) bfun) = f /\<^sub>R norm f" + +instance +proof + fix a :: real + fix f g :: "('a, 'b) bfun" + show "dist f g = norm (f - g)" + unfolding norm_bfun_def + by transfer (simp add: dist_norm) + show "norm (f + g) \<le> norm f + norm g" + unfolding norm_bfun_def + by transfer + (auto intro!: cSUP_least norm_triangle_le add_mono bfun_norm_le_SUP_norm simp: dist_norm) + show "norm (a *\<^sub>R f) = \<bar>a\<bar> * norm f" + unfolding norm_bfun_def dist_bfun.rep_eq + by (subst continuous_at_Sup_mono[of "\<lambda>x. \<bar>a\<bar> * x"]) + (fastforce intro!: monoI mult_left_mono continuous_intros bounded_imp_bdd_above + simp: bounded_norm_comp image_comp)+ +qed (auto simp: norm_bfun_def sgn_bfun_def) +end + +lemma norm_bfun_def': "norm f = (\<Squnion>x. norm ((f :: 'a \<Rightarrow>\<^sub>b 'b :: real_normed_vector) x))" + by(subst norm_conv_dist, simp add: dist_bfun.rep_eq) + +lemma norm_le_norm_bfun: "norm (apply_bfun f x) \<le> norm f" + by (simp add: apply_bfun bfun_norm_le_SUP_norm norm_bfun_def dist_bfun_def) + +lemma abs_le_norm_bfun: "abs (apply_bfun f x) \<le> norm f" + by (subst real_norm_def[symmetric]) (rule norm_le_norm_bfun) + +lemma le_norm_bfun: "apply_bfun f x \<le> norm f" + using abs_ge_self abs_le_norm_bfun + by (rule order.trans) + +subsection \<open>Complete Space\<close> + +lemma tendsto_add: "P \<longlonglongrightarrow> (L :: 'a :: real_normed_vector) \<Longrightarrow> (\<lambda>n. P n + c) \<longlonglongrightarrow> L + c" + by (intro tendsto_intros) + +lemma lim_add: "convergent P \<Longrightarrow> lim (\<lambda>n. P n + (c :: 'a ::real_normed_vector)) = lim P + c" + by (auto intro: limI dest: Bounded_Functions.tendsto_add simp add: convergent_LIMSEQ_iff) + +lemma complete_bfun: + assumes cauchy_f: "Cauchy (f :: nat \<Rightarrow> ('a, 'b :: {complete_space, real_normed_vector}) bfun)" + shows "convergent f" +proof - + let ?f = "\<lambda>x. lim (\<lambda>n. f n x)" + + from cauchy_f have cauchy_fx: "Cauchy (\<lambda>n. f n x)" for x + by(fastforce intro: dist_fun_lt_imp_dist_val_lt CauchyI' dest: metric_CauchyD)+ + + hence conv_fx: "convergent (\<lambda>n. f n x)" for x + by(auto intro: Cauchy_convergent) + + have lim_f_bfun: "?f \<in> bfun" + proof - + have "\<exists>b. \<forall>x. norm (lim (\<lambda>n. f n x)) \<le> b" + proof - + obtain N b where dist_N: "dist (f n x) (f m x) < b" if "n \<ge> N" " m \<ge> N" for x m n + using metric_CauchyD[OF cauchy_f zero_less_numeral] dist_fun_lt_imp_dist_val_lt + by metis + have aux: "norm (lim (\<lambda>n. f n x)) \<le> b + norm (f N x)" for x + proof- + from conv_fx[unfolded convergent_LIMSEQ_iff] + have tendsto_f_N: "(\<lambda>n. f (n + N) x) \<longlonglongrightarrow> ?f x" + by (auto dest: LIMSEQ_ignore_initial_segment) + hence tendsto_f_dist: "(\<lambda>n. dist (f (n + N) x) (f N x)) \<longlonglongrightarrow> dist (?f x) (f N x)" + by (auto intro: tendsto_intros) + have "dist (f (n + N) x) (f N x) \<le> b" for n + by (auto intro!: less_imp_le simp: dist_N) + hence "dist (?f x) (f N x) \<le> b" + using lim_le[OF convergentI[OF tendsto_f_dist]] + by (auto simp: limI[OF tendsto_f_dist, symmetric]) + thus "norm (?f x) \<le> b + norm (f N x)" + using norm_triangle_ineq2 order_trans + by (fastforce simp: dist_norm) + qed + show ?thesis + by (auto intro!: exI[of _ "b + norm (f N)"] order.trans[OF aux] norm_le_norm_bfun) + qed + thus ?thesis + by (auto intro: boundedI simp: bfun_def) + qed + + hence bfun_lim_f_inv: "apply_bfun (Bfun ?f) = ?f" + using bfun.Bfun_inverse by blast + + have "f \<longlonglongrightarrow> Bfun ?f" + proof - + have "\<And>e. e > 0 \<Longrightarrow> \<exists>N. \<forall>n \<ge> N. dist (Bfun ?f) (f n) < e" + proof - + fix e :: real + assume "e > 0" + hence "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. dist (f n) (f m) < 0.5 * e" (is "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. ?P n m N e") + by(force intro!: metric_CauchyD[OF cauchy_f]) + then obtain N where dist_N: "?P n m N e" if "n \<ge> N" "m \<ge> N" for n m + by auto + have "\<forall>n x. dist (?f x) (f (n + N) x) \<le> 0.5 * e" + proof safe + fix n x + have "(\<lambda>m. f m x) \<longlonglongrightarrow> ?f x" + using conv_fx convergent_LIMSEQ_iff + by blast + hence tendsto_f_N: "(\<lambda>m. f (m + N) x) \<longlonglongrightarrow> ?f x" + using LIMSEQ_ignore_initial_segment + by auto + hence tendsto_f_dist: + "(\<lambda>m. dist (f (m + N) x) (f (n + N) x)) \<longlonglongrightarrow> dist (?f x) (f (n + N) x)" + by (simp add: tendsto_dist) + have "dist (f (m + N) x) (f (n + N) x) < 0.5 * e" for m + by (fastforce intro!: dist_fun_lt_imp_dist_val_lt[OF dist_N]) + thus "dist (?f x) (f (n + N) x) \<le> 0.5 * e" + by (fastforce intro: less_imp_le convergentI[OF tendsto_f_dist] intro!: lim_le + simp only: limI[OF tendsto_f_dist, symmetric]) + qed + hence "\<forall>n. (SUP x. dist (?f x) (f (n + N) x)) \<le> 0.5 * e" + by (fastforce intro!: cSUP_least) + hence aux: "\<forall>n. dist (Bfun ?f) (f (n + N)) \<le> 0.5 * e" + unfolding dist_bfun_def + by (simp add: bfun_lim_f_inv) + have "0.5 * e < e" by (simp add: \<open>0 < e\<close>) + hence "\<forall>n. dist (Bfun ?f) (f (n + N)) < e" + using aux le_less_trans by blast + thus "\<exists>N. \<forall>n\<ge>N. dist (Bfun ?f) (f n) < e" + by (metis add.commute less_eqE) + qed + thus ?thesis + by (simp add: dist_commute metric_LIMSEQ_I) + qed + thus "convergent f" + unfolding convergent_def + by blast +qed + +lemma norm_bound: + fixes f :: "('a, 'b::real_normed_vector) bfun" + assumes "\<And>x. norm (apply_bfun f x) \<le> b" + shows "norm f \<le> b" + using dist_bound[of f 0 b] assms + by (simp add: dist_norm) + +lemma bfun_bounded_norm_range: "bounded (range (\<lambda>s. norm (apply_bfun v s)))" +proof - + obtain b where "\<forall>s. norm (v s) \<le> b" + using norm_le_norm_bfun + by fast + thus ?thesis + by (simp add: bounded_norm_comp) +qed + +instance bfun :: (type, banach) banach + by standard (auto simp: complete_bfun) + +lemma bfun_prob_space_integrable: + assumes "prob_space S" "v \<in> borel_measurable S" + assumes "(v :: 'a \<Rightarrow> 'b :: {second_countable_topology, banach}) \<in> bfun" + shows "integrable S v" + using prob_space.finite_measure norm_le_norm_bfun[of "Bfun v"] Bfun_inverse[OF assms(3)] assms + by (auto intro: finite_measure.integrable_const_bound) + +lemma bfun_integral_bound: + assumes "(v :: 'a \<Rightarrow> 'c :: {euclidean_space}) \<in> bfun" + shows "(\<lambda>S. \<integral>x. v x \<partial>(S :: 'a pmf)) \<in> bfun" +proof - + obtain b where bH: "\<forall>x. norm (v x) \<le> b" + using bfun_norm_le_SUP_norm assms by fast + have "(\<integral>x. norm (v x) \<partial>S) \<le> b" for S :: "'a pmf" + using \<open>v \<in> bfun\<close> bfun_def bounded_norm_comp bH bfun_prob_space_integrable + by (fastforce intro!: prob_space.integral_le_const prob_space_measure_pmf simp: bfun_def) + hence "\<forall>S :: 'a pmf. norm (\<integral>x. (v x) \<partial>S) \<le> b" + using integral_norm_bound order_trans by blast + thus ?thesis + unfolding bfun_def + by (auto intro: boundedI) +qed + +lemma scale_bfun[intro!]: "f \<in> bfun \<Longrightarrow> (\<lambda>x. (k::real) * f x) \<in> bfun" + using scaleR_cont[of f k] by auto + +lemma bfun_spec[intro]: "f \<in> bfun \<Longrightarrow> (\<lambda>x. f (g x)) \<in> bfun" + unfolding bfun_def bounded_def by auto + +lemma apply_bfun_bfun[simp]: "apply_bfun f \<in> bfun" + using apply_bfun . + +lemma bfun_integral_bound'[intro]: "(v :: 'a \<Rightarrow> 'c :: {euclidean_space}) \<in> bfun \<Longrightarrow> + (\<lambda>S. \<integral>x. v x \<partial>((F S) :: 'a pmf)) \<in> bfun" + using bfun_integral_bound + by (subst bfun_spec[of _ F]) auto + +lift_definition bfun_comp :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow>\<^sub>b 'c::metric_space) \<Rightarrow> ('a \<Rightarrow>\<^sub>b 'c)" is + "\<lambda>g bf x. bf (g x)" + by auto + + +subsection \<open>Order Instance\<close> + +class ordered_real_normed_vector = real_normed_vector + ordered_real_vector + +instance real :: ordered_real_normed_vector + by standard + +instantiation bfun :: (_, ordered_real_normed_vector) ordered_real_normed_vector begin + +definition "less_eq_bfun f g \<equiv> \<forall>x. apply_bfun f x \<le> apply_bfun g x" +definition "less_bfun f g \<equiv> \<forall>x. apply_bfun f x \<le> apply_bfun g x \<and> (\<exists>y. f y < g y)" + +instance +proof (standard, goal_cases) + case (1 x y) + then show ?case + by (auto dest: leD simp add: less_bfun_def less_eq_bfun_def) + (metis order.not_eq_order_implies_strict) +qed (auto intro: order_trans antisym dest: leD not_le_imp_less + simp: less_eq_bfun_def less_bfun_def eq_iff scaleR_left_mono scaleR_right_mono) +end + +lemma less_eq_bfunI[intro]: "(\<And>x. apply_bfun f x \<le> apply_bfun g x) \<Longrightarrow> f \<le> g" + unfolding less_eq_bfun_def + by auto + +lemma less_eq_bfunD[dest]: "f \<le> g \<Longrightarrow> (\<And>x. apply_bfun f x \<le> apply_bfun g x)" + unfolding less_eq_bfun_def + by auto + +subsection \<open>Miscellaneous\<close> +instantiation bfun :: (type, one) one begin + +lift_definition one_bfun :: "'s \<Rightarrow>\<^sub>b real" is "\<lambda>x. 1" + using const_bfun . + +instance + by standard +end + +declare one_bfun.rep_eq [simp] + +lemma apply_bfun_one [simp]: "apply_bfun (1 :: _ \<Rightarrow>\<^sub>b real) x = 1" + using one_bfun.rep_eq + by auto + +lemma norm_bfun_one[simp]: "norm (1 :: 'a \<Rightarrow>\<^sub>b real) = 1" + unfolding norm_bfun_def' by auto + + +lemma range_bfunI[intro]: "bounded (range f) \<Longrightarrow> f \<in> bfun" + by (simp add: bfun_def) + +lemma finite_bfun[simp]: "(\<lambda>(i::_::finite). f i) \<in> bfun" + by (meson finite finite_imageI finite_imp_bounded range_bfunI) + +lemma bounded_apply_bfun': + assumes "bounded ((F :: 'c \<Rightarrow> 'd \<Rightarrow>\<^sub>b 'b::real_normed_vector) ` S)" + shows "bounded ((\<lambda>b. (F b) x) ` S)" +proof - + obtain b where "\<forall>x\<in>S. norm (F x) \<le> b" + by (meson assms bounded_pos image_eqI) + thus "bounded ((\<lambda>b. (F b) x) ` S)" + by (fastforce intro: norm_le_norm_bfun dual_order.trans boundedI[of _ b]) +qed + + +lemma bfun_tendsto_apply_bfun: + assumes h: "(F :: (nat \<Rightarrow> 'a \<Rightarrow>\<^sub>b real)) \<longlonglongrightarrow> (y :: 'a \<Rightarrow>\<^sub>b real)" + shows "(\<lambda>n. F n x) \<longlonglongrightarrow> y x" +proof - + have aux: "(\<lambda>n. dist (F n) y) \<longlonglongrightarrow> 0" + using h + using tendsto_dist_iff by blast + have "\<And>n. dist (F n x) (y x) \<le> dist (F n) y" + unfolding dist_bfun_def + using Bounded_Continuous_Function.bounded_dist_le_SUP_dist by fastforce + hence "\<And>n. norm (dist (F n x) (y x)) \<le> norm(dist (F n) y)" + by auto + hence "(\<lambda>n. dist (F n x) (y x)) \<longlonglongrightarrow> 0" + by (subst Lim_transform_bound[OF _ aux]) auto + thus ?thesis + using tendsto_dist_iff by blast +qed + +subsection \<open>Bounded Functions and Vectors\<close> +lemma vec_bfun[simp, intro]: "($) x \<in> bfun" + using finite_bfun. + +lemma norm_bfun_le_norm_vec: "norm (bfun.Bfun (($) (x :: real^'c :: finite))) \<le> norm x" +proof - + have "norm (bfun.Bfun (($) (x :: real^'c :: finite))) \<le> (\<Squnion>xa. \<bar>x $ xa\<bar>)" + unfolding norm_bfun_def dist_bfun_def + by (auto simp: Bfun_inverse) + also have "\<dots> \<le> norm x" + using component_le_norm_cart + by (auto intro: cSUP_least) + finally show ?thesis + by auto +qed + +lemma bounded_linear_bfun_nth: "bounded_linear f \<Longrightarrow> bounded_linear (\<lambda>v. bfun.Bfun (($) (f v)))" + using order_trans[OF Finite_Cartesian_Product.norm_nth_le onorm, of f] + by (auto simp: Bfun_inverse mult.commute linear_simps dist_bfun_def norm_bfun_def + intro!: bounded_linear_intro cSup_least) + +lemma norm_vec_le_norm_bfun: + "norm (vec_lambda (apply_bfun (x :: 'd::finite \<Rightarrow>\<^sub>b real))) \<le> norm x * card (UNIV :: 'd set)" +proof - + have "norm (vec_lambda (apply_bfun x)) \<le> (\<Sum> i \<in> UNIV . \<bar>(apply_bfun x i)\<bar>)" + using L2_set_le_sum_abs + unfolding norm_vec_def L2_set_def + by auto + also have "\<dots> \<le> (card (UNIV :: 'd set) * (\<Squnion>xa. \<bar>apply_bfun x xa\<bar>))" + by (auto intro!: sum_bounded_above cSup_upper) + finally show ?thesis + by (simp add: norm_bfun_def dist_bfun_def mult.commute) +qed + +end diff --git a/thys/MDP-Rewards/MDP_cont.thy b/thys/MDP-Rewards/MDP_cont.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/MDP_cont.thy @@ -0,0 +1,1015 @@ +(* Author: Maximilian Schäffeler, adapted from Markov_Models.Discrete_Time_Markov_Process *) + +section \<open>Discrete-Time Markov Decision Processes with Arbitrary State Spaces\<close> + +text \<open> + In this file we construct discrete-time Markov decision processes, + e.g. with arbitrary state spaces. + Proofs and definitions are adapted from Markov\_Models.Discrete\_Time\_Markov\_Process. +\<close> + +theory MDP_cont + imports "HOL-Probability.Probability" +begin + +lemma Ionescu_Tulcea_C_eq: + assumes "\<And>i h. h \<in> space (PiM {0..<i} N) \<Longrightarrow> P i h = P' i h" + assumes h: "Ionescu_Tulcea P N" "Ionescu_Tulcea P' N" + shows "Ionescu_Tulcea.C P N 0 n (\<lambda>x. undefined) = Ionescu_Tulcea.C P' N 0 n (\<lambda>x. undefined)" +proof (induction n) + case 0 + then show ?case using h by (auto simp: Ionescu_Tulcea.C_def) +next + case (Suc n) + have aux: "space (PiM {0..<0 + n} N) = space (rec_nat (\<lambda>n. return (Pi\<^sub>M {0..<n} N)) + (\<lambda>m ma n \<omega>. ma n \<omega> \<bind> Ionescu_Tulcea.eP P' N (n + m)) n 0 (\<lambda>x. undefined))" + using h + by (subst Ionescu_Tulcea.space_C[symmetric, where P = P', where x = "(\<lambda>x. undefined)"]) + (auto simp add: Ionescu_Tulcea.C_def) + have "\<And>i h. h \<in> space (PiM {0..<i} N) \<Longrightarrow> Ionescu_Tulcea.eP P N i h = Ionescu_Tulcea.eP P' N i h" + by (auto simp add: Ionescu_Tulcea.eP_def assms) + then show ?case + using Suc.IH h + using aux[symmetric] + by (auto intro!: bind_cong simp: Ionescu_Tulcea.C_def) +qed + +lemma Ionescu_Tulcea_CI_eq: + assumes "\<And>i h. h \<in> space (PiM {0..<i} N) \<Longrightarrow> P i h = P' i h" + assumes h: "Ionescu_Tulcea P N" "Ionescu_Tulcea P' N" + shows "Ionescu_Tulcea.CI P N = Ionescu_Tulcea.CI P' N" +proof - + have "\<And>J. Ionescu_Tulcea.CI P N J = Ionescu_Tulcea.CI P' N J" + unfolding Ionescu_Tulcea.CI_def[OF h(1)] Ionescu_Tulcea.CI_def[OF h(2)] + using assms + by (auto intro!: distr_cong Ionescu_Tulcea_C_eq) + thus ?thesis by auto +qed + +lemma measure_eqI_PiM_sequence: + fixes M :: "nat \<Rightarrow> 'a measure" + assumes *[simp]: "sets P = PiM UNIV M" "sets Q = PiM UNIV M" + assumes eq: "\<And>A n. (\<And>i. A i \<in> sets (M i)) \<Longrightarrow> + P (prod_emb UNIV M {..n} (Pi\<^sub>E {..n} A)) = Q (prod_emb UNIV M {..n} (Pi\<^sub>E {..n} A))" + assumes A: "finite_measure P" + shows "P = Q" +proof (rule measure_eqI_PiM_infinite[OF * _ A]) + fix J :: "nat set" and F' + assume J: "finite J" "\<And>i. i \<in> J \<Longrightarrow> F' i \<in> sets (M i)" + + define n where "n = (if J = {} then 0 else Max J)" + define F where "F i = (if i \<in> J then F' i else space (M i))" for i + then have F[simp, measurable]: "F i \<in> sets (M i)" for i + using J by auto + have emb_eq: "prod_emb UNIV M J (Pi\<^sub>E J F') = prod_emb UNIV M {..n} (Pi\<^sub>E {..n} F)" + proof cases + assume "J = {}" then show ?thesis + by (auto simp add: n_def F_def[abs_def] prod_emb_def PiE_def) + next + assume "J \<noteq> {}" then show ?thesis + by (auto simp: prod_emb_def PiE_iff F_def n_def less_Suc_eq_le \<open>finite J\<close> split: if_split_asm) + qed + + show "emeasure P (prod_emb UNIV M J (Pi\<^sub>E J F')) = emeasure Q (prod_emb UNIV M J (Pi\<^sub>E J F'))" + unfolding emb_eq by (rule eq) fact +qed + +lemma distr_cong_simp: + "M = K \<Longrightarrow> sets N = sets L \<Longrightarrow> (\<And>x. x \<in> space M =simp=> f x = g x) \<Longrightarrow> distr M N f = distr K L g" + unfolding simp_implies_def by (rule distr_cong) + +subsection \<open>Definition and Basic Properties\<close> + +locale discrete_MDP = + fixes Ms :: "'s measure" + and Ma :: "'a measure" + and A :: "'s \<Rightarrow> 'a set" + and K :: "'s \<times> 'a \<Rightarrow> 's measure" + (* The valid actions are measurable subsets of all actions *) + assumes A_s: "\<And>s. A s \<in> sets Ma" + (* There always exists a valid action *) + assumes A_ne: "\<And>s. A s \<noteq> {}" + (* Assume the existence of at least 1 policy *) + assumes ex_pol: "\<exists>\<delta> \<in> Ms \<rightarrow>\<^sub>M Ma. \<forall>s. \<delta> s \<in> A s" + (* The kernel maps a state-action pair to a distribution over states *) + assumes K[measurable]: "K \<in> Ms \<Otimes>\<^sub>M Ma \<rightarrow>\<^sub>M prob_algebra Ms" +begin + +lemma space_prodI[intro]: "x \<in> space A' \<Longrightarrow> y \<in> space B \<Longrightarrow> (x,y) \<in> space (A' \<Otimes>\<^sub>M B)" + by (auto simp add: space_pair_measure) + +abbreviation "M \<equiv> Ms \<Otimes>\<^sub>M Ma" +abbreviation "Ma_A s \<equiv> restrict_space Ma (A s)" + +lemma space_ma[intro]: "s \<in> space Ms \<Longrightarrow> a \<in> space Ma \<Longrightarrow> (s,a) \<in> space M" + by (simp add: space_pair_measure) + +lemma space_x0[simp]: "x0 \<in> space (prob_algebra Ms) \<Longrightarrow> space x0 = space Ms" + by (metis (mono_tags, lifting) space_prob_algebra mem_Collect_eq sets_eq_imp_space_eq) + +lemma A_subs_Ma: "A s \<subseteq> space Ma" + by (simp add: A_s sets.sets_into_space) + +lemma space_Ma_A_subset: "s \<in> space Ms \<Longrightarrow> space (Ma_A s) \<subseteq> A s" + by (simp add: space_restrict_space) + +lemma K_restrict [measurable]: "K \<in> (Ms \<Otimes>\<^sub>M Ma_A s) \<rightarrow>\<^sub>M prob_algebra Ms" + by measurable (metis measurable_id measurable_pair_iff measurable_restrict_space2_iff) + +lemma measurable_K_act[measurable, intro]: "s \<in> space Ms \<Longrightarrow> (\<lambda>a. K (s, a)) \<in> Ma \<rightarrow>\<^sub>M prob_algebra Ms" + by measurable + +lemma measurable_K_st[measurable, intro]: "a \<in> space Ma \<Longrightarrow> (\<lambda>s. K (s, a)) \<in> Ms \<rightarrow>\<^sub>M prob_algebra Ms" + by measurable + +lemma space_K[simp]: "sa \<in> space M \<Longrightarrow> space (K sa) = space Ms" + using K unfolding prob_algebra_def measurable_restrict_space2_iff + by (auto dest: subprob_measurableD) + +lemma space_K2[simp]: "s \<in> space Ms \<Longrightarrow> a \<in> space Ma \<Longrightarrow> space (K (s, a)) = space Ms" + by (simp add: space_pair_measure) + +lemma space_K_E: "s' \<in> space (K (s,a)) \<Longrightarrow> s \<in> space Ms \<Longrightarrow> a \<in> space Ma \<Longrightarrow> s' \<in> space Ms" + by auto + +lemma sets_K: "sa \<in> space M \<Longrightarrow> sets (K sa) = sets Ms" + using K unfolding prob_algebra_def unfolding measurable_restrict_space2_iff + by (auto dest: subprob_measurableD) + +lemma sets_K'[measurable_cong]: "s \<in> space Ms \<Longrightarrow> a \<in> space Ma \<Longrightarrow> sets (K (s,a)) = sets Ms" + by (simp add: sets_K space_pair_measure) + +lemma prob_space_K[intro]: "sa \<in> space M \<Longrightarrow> prob_space (K sa)" + using measurable_space[OF K] by (simp add: space_prob_algebra) + +lemma prob_space_K2[intro]: "s \<in> space Ms \<Longrightarrow> a \<in> space Ma \<Longrightarrow> prob_space (K (s,a))" + using prob_space_K by (simp add: space_pair_measure) + +lemma K_in_space [intro]: "m \<in> space M \<Longrightarrow> K m \<in> space (prob_algebra Ms)" + by (meson K measurable_space) + +subsection \<open>Policies\<close> + (* This section represents our own developments. *) + +type_synonym ('c, 'd) pol = "nat \<Rightarrow> ((nat \<Rightarrow> 'c \<times> 'd) \<times> 'c) \<Rightarrow> 'd measure" + +(* History of i steps *) +abbreviation "H i \<equiv> Pi\<^sub>M {0..<i} (\<lambda>_. M)" + (* + current state *) +abbreviation "Hs i \<equiv> H i \<Otimes>\<^sub>M Ms" + +lemma space_H1: "j < (i :: nat) \<Longrightarrow> \<omega> \<in> space (H i) \<Longrightarrow> \<omega> j \<in> space M" + using PiE_def + by (auto simp: space_PiM) + +lemma space_case_nat[intro]: + assumes "\<omega> \<in> space (H i)" "s \<in> space Ms" + shows "case_nat s (fst \<circ> \<omega>) i \<in> space Ms" + using assms + by (cases i) (auto intro!: space_H1 measurable_space[OF measurable_fst]) + +lemma undefined_in_H0: "(\<lambda>_. undefined) \<in> space (H (0 :: nat))" + by auto + +lemma sets_K_Suc[measurable_cong]: "h \<in> space (H (Suc n)) \<Longrightarrow> sets (K (h n)) = sets Ms" + using sets_K space_H1 by blast + +text\<open>A decision rule is a function from states to distributions over enabled actions.\<close> +definition "is_dec0 d \<equiv> d \<in> Ms \<rightarrow>\<^sub>M prob_algebra Ma " + +definition "is_dec (t :: nat) d \<equiv> (d \<in> Hs t \<rightarrow>\<^sub>M prob_algebra Ma) " + +lemma "is_dec0 d \<Longrightarrow> is_dec t (\<lambda>(_,s). d s)" + unfolding is_dec0_def is_dec_def by auto + +text\<open>A policy is a function from histories to valid decision rules.\<close> +definition is_policy :: "('s, 'a) pol \<Rightarrow> bool" where + "is_policy p \<equiv> \<forall>i. is_dec i (p i)" + +(* selects the next action without history *) +abbreviation p0 :: "('s, 'a) pol \<Rightarrow> 's \<Rightarrow> 'a measure" where + "p0 p s \<equiv> p (0 ::nat) (\<lambda>_. undefined, s)" + +context + fixes p assumes p[simp]: "is_policy p" +begin + +lemma is_policyD[measurable]: "p i \<in> Hs i \<rightarrow>\<^sub>M prob_algebra Ma" + using p unfolding is_policy_def is_dec_def by auto + +lemma space_policy[simp]: "hs \<in> space (Hs i) \<Longrightarrow> space (p i hs) = space Ma" + using K is_policyD unfolding prob_algebra_def measurable_restrict_space2_iff + by (auto dest: subprob_measurableD) + +lemma space_policy'[simp]: "h \<in> space (H i) \<Longrightarrow> s \<in> space Ms \<Longrightarrow> space (p i (h,s)) = space Ma" + using space_policy + by (simp add: space_pair_measure) + +lemma space_policyI[intro]: + assumes "s \<in> space Ms" "h \<in> space (H i)" "a \<in> space Ma" + shows "a \<in> space (p i (h,s))" + using space_policy assms + by (auto simp: space_pair_measure) + +lemma sets_policy[simp]: "hs \<in> space (Hs i) \<Longrightarrow> sets (p i hs) = sets Ma" + using p K is_policyD + unfolding prob_algebra_def measurable_restrict_space2_iff + by (auto dest: subprob_measurableD) + +lemma sets_policy'[measurable_cong, simp]: + "h \<in> space (H i) \<Longrightarrow> s \<in> space Ms \<Longrightarrow> sets (p i (h,s)) = sets Ma" + using sets_policy + by (auto simp: space_pair_measure) + +lemma sets_policy''[measurable_cong, simp]: + "h \<in> space ((Pi\<^sub>M {} (\<lambda>_. M))) \<Longrightarrow> s \<in> space Ms \<Longrightarrow> sets (p 0 (h,s)) = sets Ma" + using sets_policy + by (auto simp: space_pair_measure) + +lemma policy_prob_space: "hs \<in> space (Hs i) \<Longrightarrow> prob_space (p i hs)" +proof - + assume h: "hs \<in> space (Hs i)" + hence "p i hs \<in> space (prob_algebra Ma)" + using p by (auto intro: measurable_space) + thus "prob_space (p i hs)" + unfolding prob_algebra_def by (simp add: space_restrict_space) +qed + +lemma policy_prob_space': "h \<in> space (H i) \<Longrightarrow> s \<in> space Ms \<Longrightarrow> prob_space (p i (h,s))" + using policy_prob_space by (simp add: space_pair_measure) + +lemma prob_space_p0: "x \<in> space Ms \<Longrightarrow> prob_space (p0 p x)" + by (simp add: policy_prob_space') + +lemma p0_sets[measurable_cong]: "x \<in> space Ms \<Longrightarrow> sets (p 0 (\<lambda>_. undefined,x)) = sets Ma" + using subprob_measurableD(2) measurable_prob_algebraD by simp + +lemma space_p0[simp]: "s \<in> space Ms \<Longrightarrow> space (p0 p s) = space Ma" + by auto + +lemma return_policy_prob_algebra [measurable]: + "h \<in> space (H n) \<Longrightarrow> x \<in> space Ms \<Longrightarrow> (\<lambda>a. return M (x, a)) \<in> p n (h, x) \<rightarrow>\<^sub>M prob_algebra M" + by measurable +end + +subsection \<open>Successor Policy\<close> +text \<open>To shift the policy by one step, we provide a single state-action pair as history\<close> +definition "Suc_policy p sa = (\<lambda>i (h, s). p (Suc i) (\<lambda>i'. case_nat sa h i', s))" + +lemma p_as_Suc_policy: "p (Suc i) (h, s) = Suc_policy p ((h 0)) i (\<lambda>i. h (Suc i), s)" +proof - + have *: "case_nat (f 0) (\<lambda>i. f (Suc i)) = f" for f + by (auto split: nat.splits) + show ?thesis + unfolding Suc_policy_def + by (auto simp: *) +qed + +lemma is_policy_Suc_policy[intro]: + assumes s: "sa \<in> space M" and p: "is_policy p" + shows "is_policy (Suc_policy p sa)" +proof - + have *: "(\<lambda>x. case_nat sa (fst x)) \<in> Pi\<^sub>M {0..<i} (\<lambda>_. M) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M Pi\<^sub>M {0..<Suc i} (\<lambda>_. M)" for i + using s space_H1 + by (intro measurable_PiM_single) (fastforce simp: space_PiM space_pair_measure split: nat.splits)+ + have "\<And>i. p i \<in> Pi\<^sub>M {0..<i} (\<lambda>_. M) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M prob_algebra Ma" + using is_policyD p by blast + hence "\<And>i. Suc_policy p sa i \<in> Pi\<^sub>M {0..<i} (\<lambda>_. M) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M prob_algebra Ma" + unfolding Suc_policy_def + using * + by measurable + thus ?thesis unfolding is_policy_def is_dec_def + by blast +qed + +lemma Suc_policy_measurable_step[measurable]: + assumes "is_policy p" + shows "(\<lambda>x. Suc_policy p (fst (fst x)) n (snd (fst x), snd x)) \<in> + (M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M)) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M prob_algebra Ma" + unfolding Suc_policy_def + using assms + by measurable (auto + intro: measurable_PiM_single' + simp: space_pair_measure PiE_iff space_PiM extensional_def + split: nat.split) + +subsection \<open>Single-Step Distribution\<close> + +text\<open>@{term "K'"} takes + a policy, + a distribution over 's, + the epoch, + and a history, + produces a distribution over the next state-action pair.\<close> +definition K' :: "('s, 'a) pol \<Rightarrow> 's measure \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> ('s \<times> 'a)) \<Rightarrow> ('s \<times> 'a) measure" + where + "K' p s0 n \<omega> = do { + s \<leftarrow> case_nat s0 (K \<circ> \<omega>) n; + a \<leftarrow> p n (\<omega>, s); + return M (s, a) +}" + +lemma prob_space_K': + assumes p: "is_policy p" and x: "x0 \<in> space (prob_algebra Ms)" and h: "h \<in> space (H n)" + shows "prob_space (K' p x0 n h)" + unfolding K'_def +proof (intro prob_space.prob_space_bind[where S = M]) + show "prob_space (case n of 0 \<Rightarrow> x0 | Suc x \<Rightarrow> (K \<circ> h) x)" + using x h space_H1 by (auto split: nat.splits simp: space_prob_algebra) +next + show "AE x in case n of 0 \<Rightarrow> x0 | Suc x \<Rightarrow> (K \<circ> h) x. + prob_space (p n (h, x) \<bind> (\<lambda>a. return M (x, a)))" + proof (cases n) + case 0 + then have h': "h \<in> space (Pi\<^sub>M {0..<0} (\<lambda>_. M))" + using h by auto + show ?thesis + using 0 p h x sets_policy' + by (fastforce intro: prob_space.prob_space_bind[where S=M] + policy_prob_space prob_space_return + cong: measurable_cong_sets) + next + case (Suc nat) + then show ?thesis + proof (intro AE_I2 prob_space.prob_space_bind[of _ _ M], goal_cases) + case (1 x) + then show ?case + using p space_H1 h x + by (fastforce intro!: policy_prob_space) + next + case (2 x a) + then show ?case + using h p space_H1 + by (fastforce intro!: prob_space_return) + next + case (3 x) + then show ?case + using p h x space_K space_H1 + by (fastforce intro!: measurable_prob_algebraD return_policy_prob_algebra) + qed + qed +next + show "(\<lambda>s. p n (h, s) \<bind> (\<lambda>a. return M (s, a))) \<in> + (case n of 0 \<Rightarrow> x0 | Suc x \<Rightarrow> (K \<circ> h) x) \<rightarrow>\<^sub>M subprob_algebra M" + proof (intro measurable_bind[where N = Ma]) + show " (\<lambda>x. p n (h, x)) \<in> (case n of 0 \<Rightarrow> x0 | Suc x \<Rightarrow> (K \<circ> h) x) \<rightarrow>\<^sub>M subprob_algebra Ma" + using p h x + by (auto split: nat.splits intro!: measurable_prob_algebraD simp: space_prob_algebra) + next + show "(\<lambda>s. return M (fst s, snd s)) \<in> + (case n of 0 \<Rightarrow> x0 | Suc x \<Rightarrow> (K \<circ> h) x) \<Otimes>\<^sub>M Ma \<rightarrow>\<^sub>M subprob_algebra M" + using h x sets_K_Suc + by (auto split: nat.splits simp: sets_K space_prob_algebra cong: measurable_cong_sets) + qed +qed + +lemma measurable_K'[measurable]: + assumes p: "is_policy p" and x: "x \<in> space (prob_algebra Ms)" + shows "K' p x i \<in> H i \<rightarrow>\<^sub>M prob_algebra M" +proof - + fix i + show "K' p x i \<in> Pi\<^sub>M {0..<i} (\<lambda>_. M) \<rightarrow>\<^sub>M prob_algebra M" + unfolding K'_def + proof (intro measurable_bind_prob_space2[where N = Ms]) + show "(\<lambda>a. case i of 0 \<Rightarrow> x | Suc x \<Rightarrow> (K \<circ> a) x) \<in> Pi\<^sub>M {0..<i} (\<lambda>_. M) \<rightarrow>\<^sub>M prob_algebra Ms" + using x by measurable auto + next + show "(\<lambda>(\<omega>, y). p i (\<omega>, y) \<bind> (\<lambda>a. return M (y, a))) \<in> + Pi\<^sub>M {0..<i} (\<lambda>_. M) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M prob_algebra M" + using x p by auto + qed +qed + +subsection \<open>Initial State-Action Distribution\<close> + +text \<open>@{term "K0"} produces the initial state-action distribution from a state distribution + and a policy.\<close> + +definition "K0 p s0 = K' p s0 0 (\<lambda>_. undefined)" + +lemma K0_def': + "K0 p s0 = do { + s \<leftarrow> s0; + a \<leftarrow> p0 p s; + return M (s, a)}" + unfolding K0_def K'_def by auto + +lemma K0_prob[measurable]: "is_policy p \<Longrightarrow> K0 p \<in> prob_algebra Ms \<rightarrow>\<^sub>M prob_algebra M" + unfolding K0_def' + by measurable + +lemma prob_space_K0: "is_policy p \<Longrightarrow> x0 \<in> space (prob_algebra Ms) \<Longrightarrow> prob_space (K0 p x0)" + by (simp add: K0_def prob_space_K') + +lemma space_K0[simp]: "is_policy p \<Longrightarrow> s \<in> space (prob_algebra Ms) \<Longrightarrow> space (K0 p s) = space M" + by (meson K0_prob measurable_prob_algebraD sets_eq_imp_space_eq sets_kernel) + +lemma sets_K0[measurable_cong]: + assumes "is_policy p" "s \<in> space (prob_algebra Ms)" + shows "sets (K0 p s) = sets M" + using assms by (meson K0_prob measurable_prob_algebraD subprob_measurableD(2)) + +lemma K0_return_eq_p0: + assumes "is_policy p" "s \<in> space Ms" + shows "K0 p (return Ms s) = p0 p s \<bind> (\<lambda>a. return M (s,a))" + unfolding K0_def' + using assms + by (subst bind_return[where N = M]) (auto intro!: measurable_prob_algebraD) + +lemma M_ne_policy[intro]: "is_policy p \<Longrightarrow> s \<in> space (prob_algebra Ms) \<Longrightarrow> space M \<noteq> {}" + using space_K0 prob_space.not_empty prob_space_K0 + by force + +subsection \<open>Sequence Space of the MDP\<close> +text\<open>We can instantiate @{const Ionescu_Tulcea} with @{const K'}.\<close> +lemma IT_K': "is_policy p \<Longrightarrow> x \<in> space (prob_algebra Ms) \<Longrightarrow> Ionescu_Tulcea (K' p x) (\<lambda>_. M)" + unfolding Ionescu_Tulcea_def using measurable_K' prob_space_K' + by (fast dest: measurable_prob_algebraD) + +definition lim_sequence :: "('s, 'a) pol \<Rightarrow> 's measure \<Rightarrow> (nat \<Rightarrow> ('s \<times> 'a)) measure" + where + "lim_sequence p x = projective_family.lim UNIV (Ionescu_Tulcea.CI (K' p x) (\<lambda>_. M)) (\<lambda>_. M)" + +lemma + assumes x: "x \<in> space (prob_algebra Ms)" and p: "is_policy p" + shows space_lim_sequence: "space (lim_sequence p x) = space (\<Pi>\<^sub>M i\<in>UNIV. M)" + and sets_lim_sequence[measurable_cong]: "sets (lim_sequence p x) = sets (\<Pi>\<^sub>M i\<in>UNIV. M)" + and emeasure_lim_sequence_emb: "\<And>J X. finite J \<Longrightarrow> X \<in> sets (\<Pi>\<^sub>M j\<in>J. M) \<Longrightarrow> + emeasure (lim_sequence p x) (prod_emb UNIV (\<lambda>_. M) J X) = + emeasure (Ionescu_Tulcea.CI (K' p x) (\<lambda>_. M) J) X" + and emeasure_lim_sequence_emb_I0o: "\<And>n X. X \<in> sets (\<Pi>\<^sub>M i \<in> {0..<n}. M) \<Longrightarrow> + emeasure (lim_sequence p x) (prod_emb UNIV (\<lambda>_. M) {0..<n} X) = + emeasure (Ionescu_Tulcea.C (K' p x) (\<lambda>_. M) 0 n (\<lambda>x. undefined)) X" +proof - + interpret Ionescu_Tulcea "K' p x" "\<lambda>_. M" + using IT_K'[OF p x] . + show "space (lim_sequence p x) = space (\<Pi>\<^sub>M i\<in>UNIV. M)" + unfolding lim_sequence_def by simp + show "sets (lim_sequence p x) = sets (\<Pi>\<^sub>M i\<in>UNIV. M)" + unfolding lim_sequence_def by simp + + { fix J :: "nat set" and X assume "finite J" "X \<in> sets (\<Pi>\<^sub>M j\<in>J. M)" + then show "emeasure (lim_sequence p x) (PF.emb UNIV J X) = emeasure (CI J) X" + unfolding lim_sequence_def by (rule lim) } + note emb = this + + have up_to_I0o[simp]: "up_to {0..<n} = n" for n + unfolding up_to_def by (rule Least_equality) auto + + { fix n :: nat and X assume "X \<in> sets (\<Pi>\<^sub>M j\<in>{0..<n}. M)" + thus "emeasure (lim_sequence p x) (PF.emb UNIV {0..<n} X) = emeasure (C 0 n (\<lambda>x. undefined)) X" + by (simp add: space_C emb CI_def space_PiM distr_id2 sets_C cong: distr_cong_simp) } +qed + +lemma lim_sequence_prob_space: + assumes "is_policy p" "s \<in> space (prob_algebra Ms)" + shows "prob_space (lim_sequence p s)" + using assms proof - + assume p: "is_policy p" + fix s assume [simp]: "s \<in> space (prob_algebra Ms)" + interpret Ionescu_Tulcea "K' p s" "\<lambda>_. M" + using IT_K' p by simp + have sp: + "space (lim_sequence p s) = prod_emb UNIV (\<lambda>_. M) {} (\<Pi>\<^sub>E j\<in>{}. space M)" + "space (CI {}) = {} \<rightarrow>\<^sub>E space M" + by (auto simp: p space_lim_sequence space_PiM prod_emb_def PF.space_P) + show "prob_space (lim_sequence p s)" + using PF.prob_space_P[THEN prob_space.emeasure_space_1, of "{}"] + by (auto intro!: prob_spaceI simp add: p sp emeasure_lim_sequence_emb simp del: PiE_empty_domain) +qed + +subsection \<open>Measurablility of the Sequence Space\<close> +lemma lim_sequence[measurable]: + assumes p: "is_policy p" + shows "lim_sequence p \<in> prob_algebra Ms \<rightarrow>\<^sub>M prob_algebra (\<Pi>\<^sub>M i\<in>UNIV. M)" +proof (intro measurable_prob_algebra_generated[OF sets_PiM Int_stable_prod_algebra + prod_algebra_sets_into_space]) + show "\<And>a. a \<in> space (prob_algebra Ms) \<Longrightarrow> prob_space (lim_sequence p a)" + using lim_sequence_prob_space p by blast +next + fix a assume [simp]: "a \<in> space (prob_algebra Ms)" + show "sets (lim_sequence p a) = sets (Pi\<^sub>M UNIV (\<lambda>i. M))" + by (simp add: p sets_lim_sequence) +next + fix X :: "(nat \<Rightarrow> 's \<times> 'a) set" assume "X \<in> prod_algebra UNIV (\<lambda>i. M)" + then obtain J :: "nat set" and F where J: "J \<noteq> {}" "finite J" "F \<in> J \<rightarrow> sets M" + and X: "X = prod_emb UNIV (\<lambda>_. M) J (Pi\<^sub>E J F)" + unfolding prod_algebra_def by auto + then have Pi_F: "finite J" "Pi\<^sub>E J F \<in> sets (Pi\<^sub>M J (\<lambda>_. M))" + by (auto intro: sets_PiM_I_finite) + + define n where "n = (LEAST n. \<forall>i\<ge>n. i \<notin> J)" + have J_le_n: "J \<subseteq> {0..<n}" + proof - + have "\<And>x. x \<in> J \<Longrightarrow> \<forall>i\<ge>Suc (Max J). i \<notin> J" + using not_le Max_less_iff[OF \<open>finite J\<close>] + by (auto simp: Suc_le_eq) + moreover have "x \<in> J \<Longrightarrow> \<forall>i\<ge>a. i \<notin> J \<Longrightarrow> x < a" for x a + using not_le by auto + ultimately show ?thesis + unfolding n_def + by (fastforce intro!: LeastI2[of "\<lambda>n. \<forall>i\<ge>n. i \<notin> J" "Suc (Max J)" "\<lambda>x. _ < x"]) + qed + + have C: "(\<lambda>x. Ionescu_Tulcea.C (K' p x) (\<lambda>_. M) 0 n (\<lambda>x. undefined)) \<in> prob_algebra Ms \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<n} (\<lambda>_. M))" + proof (induction n) + case 0 + thus ?case + by (auto simp: measurable_cong[OF Ionescu_Tulcea.C.simps(1)[OF IT_K', OF p]]) + next + case (Suc n) + have "(\<lambda>w. Ionescu_Tulcea.eP (K' p (fst w)) (\<lambda>_. M) n (snd w)) + \<in> prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + proof (subst measurable_cong) + fix w assume "w \<in> space (prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M))" + then show "Ionescu_Tulcea.eP (K' p (fst w)) (\<lambda>_. M) n (snd w) = + distr (K' p (fst w) n (snd w)) (\<Pi>\<^sub>M i\<in>{0..<Suc n}. M) (fun_upd (snd w) n)" + by (auto simp: p space_pair_measure Ionescu_Tulcea.eP_def[OF IT_K'] split: prod.split) + next + show "(\<lambda>w. distr (K' p (fst w) n (snd w)) (\<Pi>\<^sub>M i\<in>{0..<Suc n}. M) (fun_upd (snd w) n)) + \<in> prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + proof (rule measurable_distr2[where M = M]) + show "(\<lambda>(x, y). (snd x)(n := y)) \<in> (prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M)) \<Otimes>\<^sub>M M \<rightarrow>\<^sub>M Pi\<^sub>M {0..<Suc n} (\<lambda>i. M)" + proof (rule measurable_PiM_single') + fix i assume "i \<in> {0..<Suc n}" + then show "(\<lambda>\<omega>. (case \<omega> of (x, y) \<Rightarrow> (snd x)(n := y)) i) \<in> (prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M)) \<Otimes>\<^sub>M M \<rightarrow>\<^sub>M M" + unfolding split_beta' + by (cases "i = n") auto + next + show "(\<lambda>\<omega>. case \<omega> of (x, y) \<Rightarrow> (snd x)(n := y)) \<in> space ((prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M)) \<Otimes>\<^sub>M M) \<rightarrow> {0..<Suc n} \<rightarrow>\<^sub>E space M" + by (auto simp: space_pair_measure space_PiM less_Suc_eq PiE_iff) + qed + next + show "(\<lambda>x. K' p (fst x) n (snd x)) \<in> prob_algebra Ms \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra M" + unfolding K'_def comp_def + using p + by (auto intro!: measurable_prob_algebraD) + qed + qed + then show ?case + using Suc.IH + by (subst measurable_cong[OF Ionescu_Tulcea.C.simps(2)[OF IT_K', where p1 = p, OF p]]) + (auto intro!: measurable_bind) + qed + + have *: "(\<lambda>x. Ionescu_Tulcea.CI (K' p x) (\<lambda>_. M) J) \<in> prob_algebra Ms \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M J (\<lambda>_. M))" + using measurable_distr[OF measurable_restrict_subset[OF J_le_n], of "(\<lambda>_. M)"] C p + by (subst measurable_cong) + (auto simp: Ionescu_Tulcea.up_to_def[OF IT_K'] n_def Ionescu_Tulcea.CI_def[OF IT_K']) + + have "(\<lambda>a. emeasure (lim_sequence p a) X) \<in> borel_measurable (prob_algebra Ms) \<longleftrightarrow> + (\<lambda>a. emeasure (Ionescu_Tulcea.CI (K' p a) (\<lambda>_. M) J) (Pi\<^sub>E J F)) \<in> + borel_measurable (prob_algebra Ms)" + unfolding X using J Pi_F by (intro p measurable_cong emeasure_lim_sequence_emb) auto + also have "\<dots>" + using * measurable_emeasure_subprob_algebra Pi_F(2) + by auto + finally show "(\<lambda>a. emeasure (lim_sequence p a) X) \<in> borel_measurable (prob_algebra Ms)" . +qed + +lemma lim_sequence_aux[measurable]: + assumes p: "is_policy p" + assumes f : "\<And>x. x \<in> space M \<Longrightarrow> is_policy (f x)" + assumes f': "\<And>n. (\<lambda>x. f (fst (fst x)) n (snd (fst x), snd x)) \<in> + (M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M)) \<Otimes>\<^sub>M Ms \<rightarrow>\<^sub>M prob_algebra Ma" + assumes gm: "g \<in> M \<rightarrow>\<^sub>M prob_algebra Ms" + shows "(\<lambda>x. lim_sequence (f x) (g x)) \<in> M \<rightarrow>\<^sub>M prob_algebra (Pi\<^sub>M UNIV (\<lambda>_. M))" +proof (intro measurable_prob_algebra_generated[OF sets_PiM Int_stable_prod_algebra prod_algebra_sets_into_space]) + fix a assume a[simp]: "a \<in> space M" + have g: "\<And>x. x \<in> space M \<Longrightarrow> g x \<in> space (prob_algebra Ms)" + by (meson gm measurable_space) + interpret Ionescu_Tulcea "K' (f a) (g a)" "\<lambda>_. M" + using IT_K' p + using f[OF \<open>a \<in> space M\<close>] g by measurable + have p': "is_policy (f a)" + using \<open>a \<in> space M\<close> p f by auto + have sp: + "space (lim_sequence (f a) (g a)) = prod_emb UNIV (\<lambda>_. M) {} (\<Pi>\<^sub>E j\<in>{}. space M)" + "space (CI {}) = {} \<rightarrow>\<^sub>E space M" + using g a p' by (auto simp: space_lim_sequence p' space_PiM prod_emb_def PF.space_P) + have "emeasure (lim_sequence (f a) (g a)) (space (lim_sequence (f a) (g a))) = 1" + unfolding sp + using g a p' sets.top[of "(Pi\<^sub>M {} (\<lambda>_. M))", unfolded space_PiM_empty] + PF.prob_space_P[THEN prob_space.emeasure_space_1, of "{}"] + by (subst emeasure_lim_sequence_emb) (auto simp: emeasure_lim_sequence_emb sp) + thus "prob_space (lim_sequence (f a) (g a))" + by (auto intro: prob_spaceI) + show "sets (lim_sequence (f a) (g a)) = sets (Pi\<^sub>M UNIV (\<lambda>i. M))" + by (simp add: lim_sequence_def) +next + fix X :: "(nat \<Rightarrow> 's \<times> 'a) set" assume "X \<in> prod_algebra UNIV (\<lambda>i. M)" + then obtain J :: "nat set" and F where J: "J \<noteq> {}" "finite J" "F \<in> J \<rightarrow> sets M" + and X: "X = prod_emb UNIV (\<lambda>_. M) J (Pi\<^sub>E J F)" + unfolding prod_algebra_def by auto + then have Pi_F: "finite J" "Pi\<^sub>E J F \<in> sets (Pi\<^sub>M J (\<lambda>_. M))" + by (auto intro: sets_PiM_I_finite) + + define n where "n = (LEAST n. \<forall>i\<ge>n. i \<notin> J)" + have J_le_n: "J \<subseteq> {0..<n}" + unfolding n_def + by (rule LeastI2[of _ "Suc (Max J)"]) (auto simp: \<open>finite J\<close> Suc_le_eq not_le[symmetric]) + + have g: "\<And>x. x \<in> space M \<Longrightarrow> g x \<in> space (prob_algebra Ms)" + by (meson gm measurable_space) + + have C: "(\<lambda>x. Ionescu_Tulcea.C (K' (f x) (g x)) (\<lambda>_. M) 0 n (\<lambda>x. undefined)) \<in> + M \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<n} (\<lambda>_. M))" + proof (induction n) + case 0 + then show ?case + using g f + by (auto simp: measurable_cong[OF Ionescu_Tulcea.C.simps(1)[OF IT_K']]) + next + case (Suc n) + then show ?case + proof (subst measurable_cong[OF Ionescu_Tulcea.C.simps(2)[OF IT_K']]) + show "(\<lambda>w. Ionescu_Tulcea.C (K' (f w) (g w)) (\<lambda>_. M) 0 n (\<lambda>x. undefined) \<bind> Ionescu_Tulcea.eP (K' (f w) (g w)) (\<lambda>_. M) (0 + n)) + \<in> M \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + if h: "(\<lambda>x. Ionescu_Tulcea.C (K' (f x) (g x)) (\<lambda>_. M) 0 n (\<lambda>x. undefined)) \<in> M \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<n} (\<lambda>_. M))" + proof (rule measurable_bind'[OF h]) + show "(\<lambda>(x, y). Ionescu_Tulcea.eP (K' (f x) (g x)) (\<lambda>_. M) (0 + n) y) \<in> M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + proof (subst measurable_cong) + fix n :: nat and w assume "w \<in> space (M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M))" + then show "(case w of (x, a) \<Rightarrow> Ionescu_Tulcea.eP (K' (f x) (g x)) (\<lambda>_. M) (0 + n) a) = + (case w of (x, a) \<Rightarrow> distr (K' (f x) (g x) n a) (\<Pi>\<^sub>M i\<in>{0..<Suc n}. M) (fun_upd a n))" + by (auto simp: IT_K' Ionescu_Tulcea.eP_def f g space_ma p space_pair_measure + Ionescu_Tulcea.eP_def[OF IT_K']) + next + fix n + have "(\<lambda>w. distr (K' (f (fst w)) (g (fst w)) n (snd w)) (Pi\<^sub>M {0..<Suc n} (\<lambda>i. M)) (fun_upd (snd w) n)) + \<in> M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + proof (intro measurable_distr2[where M=M] measurable_PiM_single', goal_cases) + case (1 i) + then show ?case + by (cases "i = n") (auto simp: split_beta') + next + case 2 + then show ?case + by (auto simp: split_beta' PiE_iff extensional_def Pi_iff space_pair_measure space_PiM) + next + case 3 + then show ?case + unfolding K'_def + proof (intro measurable_bind[where N = Ms], goal_cases) + case 1 + then show ?case + unfolding measurable_pair_swap_iff[of _ M] + by measurable (auto simp: gm measurable_snd'' intro: measurable_prob_algebraD) + next + case 2 + then show ?case + unfolding Suc_policy_def + using f' + by (auto intro!: measurable_bind[where N = Ma] measurable_prob_algebraD) + qed + qed + thus "(\<lambda>w. case w of (x, a) \<Rightarrow> distr ((K' (f x) (g x)) n a) (Pi\<^sub>M {0..<Suc n} (\<lambda>i. M)) (fun_upd a n)) \<in> M \<Otimes>\<^sub>M Pi\<^sub>M {0..<n} (\<lambda>_. M) \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M {0..<Suc n} (\<lambda>_. M))" + by measurable + qed + qed + qed (auto simp: f g) + qed + + have p': "\<And>a. a \<in> space M \<Longrightarrow> is_policy (f a)" + using f by auto + have "(\<lambda>a. emeasure (lim_sequence (f a) (g a)) X) \<in> borel_measurable M \<longleftrightarrow> + (\<lambda>a. emeasure (Ionescu_Tulcea.CI (K' (f a) (g a)) (\<lambda>_. M) J) (Pi\<^sub>E J F)) \<in> borel_measurable M" + unfolding X using J Pi_F + by (fastforce simp add: g f K space_pair_measure intro!: p p' measurable_cong emeasure_lim_sequence_emb) + also have "..." + proof (intro measurable_compose[OF _ measurable_emeasure_subprob_algebra[OF Pi_F(2)]], + subst measurable_cong[where g = "(\<lambda>w. distr (Ionescu_Tulcea.C (K' (f w) (g w)) + (\<lambda>_. M) 0 n (\<lambda>x. undefined)) (Pi\<^sub>M J (\<lambda>_. M)) (\<lambda>f. restrict f J))"], goal_cases) + case (1 w) + then show ?case + unfolding Ionescu_Tulcea.CI_def[OF IT_K'[OF f[OF 1] g[OF 1]]] + using p + by (subst Ionescu_Tulcea.up_to_def[OF IT_K'[of "Suc_policy p w" "K w"]]) + (auto simp add: n_def \<open>w \<in> space M\<close> prob_space_K sets_K space_prob_algebra) + next + case 2 + then show ?case + using measurable_compose measurable_distr[OF measurable_restrict_subset[OF J_le_n]] C + by blast + qed + thus "(\<lambda>a. emeasure (lim_sequence (f a) (g a)) X) \<in> borel_measurable M" + using calculation by blast +qed + +lemma lim_sequence_Suc_return[measurable]: + assumes p: "is_policy p" + assumes s: "s \<in> space Ms" + shows "(\<lambda>x. lim_sequence (Suc_policy p (s, snd x)) (return Ms (fst x))) \<in> + M \<rightarrow>\<^sub>M prob_algebra (Pi\<^sub>M UNIV (\<lambda>_. M))" +proof (intro lim_sequence_aux[OF p], goal_cases) + case (1 x) + then show ?case + by (meson is_policy_Suc_policy measurable_snd measurable_space p s space_ma) +next + case (2 n) + then show ?case + using p + unfolding Suc_policy_def + by measurable (auto intro: measurable_PiM_single' + simp: s space_pair_measure space_PiM PiE_iff extensional_def split: nat.split) +qed measurable + +lemma lim_sequence_Suc_K[measurable]: + assumes "is_policy p" + shows "(\<lambda>x. lim_sequence (Suc_policy p x) (K x)) \<in> M \<rightarrow>\<^sub>M prob_algebra (Pi\<^sub>M UNIV (\<lambda>_. M))" + using assms + by (fastforce intro!: lim_sequence_aux) + +subsection \<open>Iteration Rule\<close> +lemma step_C: + assumes x: "x \<in> space (prob_algebra Ms)" and p: "is_policy p" + shows "Ionescu_Tulcea.C (K' p x) (\<lambda>_. M) 0 1 (\<lambda>_. undefined) \<bind> + Ionescu_Tulcea.C (K' p x) (\<lambda>_. M) 1 n = + K0 p x \<bind> (\<lambda>a. Ionescu_Tulcea.C (K' p x) (\<lambda>_. M) 1 n (case_nat a (\<lambda>_. undefined)))" +proof - + interpret Ionescu_Tulcea "K' p x" "\<lambda>_. M" + using IT_K'[OF p x] . + + have [simp]: "space (K0 p x) \<noteq> {}" + using space_K0[OF p x] x by auto + + have [simp]: "((\<lambda>_. undefined)(0 := x::('s \<times> 'a))) = case_nat x (\<lambda>_. undefined)" for x + by (auto simp: fun_eq_iff split: nat.split) + + have "C 0 1 (\<lambda>_. undefined) \<bind> C 1 n = eP 0 (\<lambda>_. undefined) \<bind> C 1 n" + using measurable_eP[of 0] measurable_C[of 1 n, measurable del] + by (simp add: bind_return[where N="Pi\<^sub>M {0} (\<lambda>_. M)"]) + also have "\<dots> = K0 p x \<bind> (\<lambda>a. C 1 n (case_nat a (\<lambda>_. undefined)))" + unfolding eP_def + proof (subst bind_distr[where K = "Pi\<^sub>M {0..<Suc n} (\<lambda>_. M)"], goal_cases) + case 1 + then show ?case + using measurable_C[of 1 n, measurable del] x[THEN sets_K0[OF p]] + unfolding K0_def + apply auto + apply measurable + by (auto simp: space_P measurable_ident_sets sets_P) + next + case 2 + then show ?case + using measurable_C[of 1 n] + by auto + next + case 3 + then show ?case + by (simp add: space_P) + next + case 4 + then show ?case + unfolding K0_def + by (auto intro!: bind_cong) + qed + finally show + "C 0 1 (\<lambda>_. undefined) \<bind> C 1 n = K0 p x \<bind> (\<lambda>a. C 1 n (case_nat a (\<lambda>_. undefined)))" . +qed + +lemma lim_sequence_eq: + assumes x: "x \<in> space (prob_algebra Ms)" assumes p: "is_policy p" + shows "lim_sequence p x = + K0 p x \<bind> (\<lambda>y. distr (lim_sequence (Suc_policy p y) (K y)) (\<Pi>\<^sub>M _\<in>UNIV. M) (case_nat y))" + (is "_ = ?B p x") +proof (rule measure_eqI_PiM_infinite) + show "sets (lim_sequence p x) = sets (\<Pi>\<^sub>M j\<in>UNIV. M)" + using x p by (rule sets_lim_sequence) + have [simp]: "space (K' p x 0 (\<lambda>n. undefined)) \<noteq> {}" + using p + using IT_K' Ionescu_Tulcea.non_empty Ionescu_Tulcea.space_P x by fastforce + show "sets (?B p x) = sets (Pi\<^sub>M UNIV (\<lambda>j. M))" + using p x M_ne_policy space_K0 by auto + + interpret lim_sequence: prob_space "lim_sequence p x" + using lim_sequence x p by (auto simp: measurable_restrict_space2_iff prob_algebra_def) + show "finite_measure (lim_sequence p x)" + by (rule lim_sequence.finite_measure) + + interpret Ionescu_Tulcea "K' p x" "\<lambda>_. M" + using IT_K'[OF p x] . + + let ?U = "\<lambda>_::nat. undefined :: ('s \<times> 'a)" + + fix J :: "nat set" and F' + assume J: "finite J" "\<And>i. i \<in> J \<Longrightarrow> F' i \<in> sets M" + + define n where "n = (if J = {} then 0 else Max J)" + define F where "F i = (if i \<in> J then F' i else space M)" for i + then have F[simp, measurable]: "F i \<in> sets M" for i + using J by auto + have emb_eq: "PF.emb UNIV J (Pi\<^sub>E J F') = PF.emb UNIV {0..<Suc n} (Pi\<^sub>E {0..<Suc n} F)" + proof cases + assume "J = {}" then show ?thesis + by (auto simp add: n_def F_def[abs_def] prod_emb_def PiE_def) + next + assume "J \<noteq> {}" then show ?thesis + by (auto simp: prod_emb_def PiE_iff F_def n_def less_Suc_eq_le \<open>finite J\<close> split: if_split_asm) + qed + + have "emeasure (lim_sequence p x) (PF.emb UNIV J (Pi\<^sub>E J F')) = + emeasure (C 0 (Suc n) ?U) (Pi\<^sub>E {0..<Suc n} F)" + using x p unfolding emb_eq + by (rule emeasure_lim_sequence_emb_I0o) (auto intro!: sets_PiM_I_finite) + also have "C 0 (Suc n) ?U = K0 p x \<bind> (\<lambda>y. C 1 n (case_nat y ?U))" + using split_C[of ?U 0 "Suc 0" n] step_C[OF x p] by simp + also have "emeasure (K0 p x \<bind> (\<lambda>y. C 1 n (case_nat y ?U))) (Pi\<^sub>E {0..<Suc n} F) = + (\<integral>\<^sup>+y. C 1 n (case_nat y ?U) (Pi\<^sub>E {0..<Suc n} F) \<partial>K0 p x)" + using measurable_C[of 1 n, measurable del] sets_K0[OF p x] F x p non_empty space_K0 + by (intro emeasure_bind[OF _ measurable_compose[OF _ measurable_C]]) + (auto cong: measurable_cong_sets intro!: measurable_PiM_single' split: nat.split_asm) + also have "\<dots> = (\<integral>\<^sup>+y. distr (lim_sequence (Suc_policy p y) (K y)) + (Pi\<^sub>M UNIV (\<lambda>j. M)) (case_nat y) (PF.emb UNIV J (Pi\<^sub>E J F')) \<partial>K0 p x)" + proof (intro nn_integral_cong) + fix y assume "y \<in> space (K0 p x)" + then have y: "y \<in> space M" + using x p space_K0 by blast + then interpret y: Ionescu_Tulcea "K' (Suc_policy p y) (K y)" "\<lambda>_. M" + using p by (auto intro!: IT_K') + have "fst y \<in> space Ms" + by (meson measurable_fst measurable_space y) + let ?y = "case_nat y" + have [simp]: "?y ?U \<in> space (Pi\<^sub>M {0} (\<lambda>i. M))" + using y by (auto simp: space_PiM PiE_iff extensional_def split: nat.split) + have yM[measurable]: "?y \<in> Pi\<^sub>M {0..<m} (\<lambda>_. M) \<rightarrow>\<^sub>M Pi\<^sub>M {0..<Suc m} (\<lambda>i. M)" for m + using y + by (auto intro: measurable_PiM_single' simp: space_PiM PiE_iff extensional_def split: nat.split) + have y': "?y ?U \<in> space (Pi\<^sub>M {0..<1} (\<lambda>i. M))" + by (simp add: space_PiM PiE_def y extensional_def split: nat.split) + + have eq1: "?y -` Pi\<^sub>E {0..<Suc n} F \<inter> space (Pi\<^sub>M {0..<n} (\<lambda>_. M)) = + (if y \<in> F 0 then Pi\<^sub>E {0..<n} (F\<circ>Suc) else {})" + unfolding set_eq_iff using y sets.sets_into_space[OF F] + by (auto simp: space_PiM PiE_iff extensional_def Ball_def split: nat.split nat.split_asm) + + have eq2: "?y -` PF.emb UNIV {0..<Suc n} (Pi\<^sub>E {0..<Suc n} F) \<inter> space (Pi\<^sub>M UNIV (\<lambda>_. M)) = + (if y \<in> F 0 then PF.emb UNIV {0..<n} (Pi\<^sub>E {0..<n} (F\<circ>Suc)) else {})" + unfolding set_eq_iff using y sets.sets_into_space[OF F] + by (auto simp: space_PiM PiE_iff prod_emb_def extensional_def Ball_def split: nat.splits) + + let ?I = "indicator (F 0) y" + have "fst y \<in> space Ms" + using y by (meson measurable_fst measurable_space) + have "C 1 n (?y ?U) = distr (y.C 0 n ?U) (\<Pi>\<^sub>M i\<in>{0..<Suc n}. M) ?y" + proof (induction n) + case (Suc m) + + have "C 1 (Suc m) (?y ?U) = distr (y.C 0 m ?U) (Pi\<^sub>M {0..<Suc m} (\<lambda>i. M)) ?y \<bind> eP (Suc m)" + using Suc by simp + also have "\<dots> = y.C 0 m ?U \<bind> (\<lambda>x. eP (Suc m) (?y x))" + by (auto intro!: bind_distr[where K="Pi\<^sub>M {0..<Suc (Suc m)} (\<lambda>_. M)"] simp: y y.space_C y.sets_C cong: measurable_cong_sets) + also have "\<dots> = y.C 0 m ?U \<bind> (\<lambda>x. distr (y.eP m x) (Pi\<^sub>M {0..<Suc (Suc m)} (\<lambda>i. M)) ?y)" + proof (intro bind_cong refl) + fix \<omega>' assume \<omega>': "\<omega>' \<in> space (y.C 0 m ?U)" + moreover have "K' p x (Suc m) (?y \<omega>') = K' (Suc_policy p y) (K y) m \<omega>'" + unfolding K'_def Suc_policy_def + by (auto split: nat.splits) + ultimately show "eP (Suc m) (?y \<omega>') = distr (y.eP m \<omega>') (Pi\<^sub>M {0..<Suc (Suc m)} (\<lambda>i. M)) ?y" + unfolding eP_def y.eP_def + by (subst distr_distr) (auto simp: y.space_C y.sets_P split: nat.split cong: measurable_cong_sets + intro!: distr_cong measurable_fun_upd[where J="{0..<m}"]) + qed + also have "\<dots> = distr (y.C 0 m ?U \<bind> y.eP m) (Pi\<^sub>M {0..<Suc (Suc m)} (\<lambda>i. M)) ?y" + by (auto intro!: distr_bind[symmetric, OF _ _ yM] simp: y.space_C y.sets_C cong: measurable_cong_sets) + finally show ?case + by simp + qed (use y in \<open>simp add: PiM_empty distr_return\<close>) + then have "C 1 n (case_nat y ?U) (Pi\<^sub>E {0..<Suc n} F) = + (distr (y.C 0 n ?U) (\<Pi>\<^sub>M i\<in>{0..<Suc n}. M) ?y) (Pi\<^sub>E {0..<Suc n} F)" by simp + also have "\<dots> = ?I * y.C 0 n ?U (Pi\<^sub>E {0..<n} (F \<circ> Suc))" + by (subst emeasure_distr) (auto simp: y.sets_C y.space_C eq1 cong: measurable_cong_sets) + also have + "\<dots> = ?I * lim_sequence (Suc_policy p y) (K y) (PF.emb UNIV {0..<n} (Pi\<^sub>E {0..<n} (F \<circ> Suc)))" + using y sets_PiM_I_finite + by (subst emeasure_lim_sequence_emb_I0o) (auto simp add: p sets_PiM_I_finite) + also have "\<dots> = distr (lim_sequence (Suc_policy p y) (K y)) (Pi\<^sub>M UNIV (\<lambda>j. M)) ?y + (PF.emb UNIV {0..<Suc n} (Pi\<^sub>E {0..<Suc n} F))" + proof (subst emeasure_distr, goal_cases) + case 1 + thus ?case + using y + by measurable (simp add: lim_sequence_def measurable_ident_sets) + case 2 + thus ?case + by auto + case 3 + thus ?case + using y + by (subst space_lim_sequence[OF _ is_policy_Suc_policy[OF _ p]]) (auto simp: eq2) + qed + finally show "emeasure (C 1 n (case_nat y (\<lambda>_. undefined))) (Pi\<^sub>E {0..<Suc n} F) = + emeasure (distr (lim_sequence (Suc_policy p y) (K y)) (Pi\<^sub>M UNIV (\<lambda>j. M)) (case_nat y)) + (y.PF.emb UNIV J (Pi\<^sub>E J F'))" + unfolding emb_eq . + qed + also have "\<dots> = emeasure (K0 p x \<bind> (\<lambda>y. distr (lim_sequence (Suc_policy p y) (K y)) + (Pi\<^sub>M UNIV (\<lambda>j. M)) (case_nat y))) (PF.emb UNIV J (Pi\<^sub>E J F'))" + using J sets_K0[OF \<open>is_policy p\<close> \<open>x \<in> space (prob_algebra Ms)\<close>] p + by (subst emeasure_bind[where N="PiM UNIV (\<lambda>_. M)"]) (auto simp: sets_K x cong: measurable_cong_sets + intro!: measurable_distr2[OF _ measurable_prob_algebraD[OF lim_sequence]] + measurable_prob_algebraD + measurable_distr2[where M = "PiM UNIV (\<lambda>_. M)"]) + finally show "emeasure (lim_sequence p x) (PF.emb UNIV J (Pi\<^sub>E J F')) = + emeasure (K0 p x \<bind> (\<lambda>y. distr (lim_sequence (Suc_policy p y) (K y)) (Pi\<^sub>M UNIV (\<lambda>j. M)) + (case_nat y))) (PF.emb UNIV J (Pi\<^sub>E J F'))". +qed + +subsection \<open>Stream Space of the MDP\<close> +definition lim_stream :: "('s, 'a) pol \<Rightarrow> 's measure \<Rightarrow> ('s \<times> 'a) stream measure" + where + "lim_stream p x = distr (lim_sequence p x) (stream_space M) to_stream" + +lemma space_lim_stream: "space (lim_stream p x) = streams (space M)" + unfolding lim_stream_def by (simp add: space_stream_space) + +lemma sets_lim_stream[measurable_cong]: "sets (lim_stream p x) = sets (stream_space M)" + unfolding lim_stream_def by simp + +lemma lim_stream[measurable]: + assumes "is_policy p" + shows "lim_stream p \<in> prob_algebra Ms \<rightarrow>\<^sub>M prob_algebra (stream_space M)" + unfolding lim_stream_def[abs_def] + using assms + by (auto intro: measurable_distr_prob_space2[OF lim_sequence]) + +lemma lim_stream_Suc[measurable]: + assumes p: "is_policy p" + shows "(\<lambda>a. lim_stream (Suc_policy p a) (K a)) \<in> M \<rightarrow>\<^sub>M prob_algebra (stream_space M)" + unfolding lim_stream_def[abs_def] + using p + by (auto intro: measurable_distr_prob_space2[OF lim_sequence_Suc_K]) + +lemma space_stream_space_M_ne: "x \<in> space M \<Longrightarrow> space (stream_space M) \<noteq> {}" + using sconst_streams[of x "space M"] by (auto simp: space_stream_space) + +lemma prob_space_lim_stream[intro]: + assumes "is_policy p" "x \<in> space (prob_algebra Ms)" + shows "prob_space (lim_stream p x)" + by (metis (no_types, lifting) space_prob_algebra measurable_space assms lim_stream mem_Collect_eq) + +lemma prob_space_step: + assumes "is_policy p" "x \<in> space M" + shows "prob_space (lim_stream (Suc_policy p x) (K x))" + by (auto simp: assms K_in_space is_policy_Suc_policy) + + +lemma lim_stream_eq: + assumes p: "is_policy p" + assumes x: "x \<in> space (prob_algebra Ms)" + shows "lim_stream p x = do { + y \<leftarrow> K0 p x; + \<omega> \<leftarrow> lim_stream (Suc_policy p y) (K y); + return (stream_space M) (y ## \<omega>) + }" + unfolding lim_stream_def lim_sequence_eq[OF x p] +proof (subst distr_bind[OF _ _ measurable_to_stream]) + show "(\<lambda>y. distr (lim_sequence (Suc_policy p y) (K y)) (Pi\<^sub>M UNIV (\<lambda>j. M)) (case_nat y)) \<in> + K0 p x \<rightarrow>\<^sub>M subprob_algebra (Pi\<^sub>M UNIV (\<lambda>i. M))" + proof (intro measurable_prob_algebraD measurable_distr_prob_space2[where M="Pi\<^sub>M UNIV (\<lambda>j. M)"]) + show "(\<lambda>x. lim_sequence (Suc_policy p x) (K x)) \<in> K0 p x \<rightarrow>\<^sub>M prob_algebra (Pi\<^sub>M UNIV (\<lambda>j. M))" + using lim_sequence_Suc_K[OF p] sets_K0[OF p x] measurable_cong_sets + by blast + next show "(\<lambda>(ya, y). case_nat ya y) \<in> K0 p x \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>j. M) \<rightarrow>\<^sub>M Pi\<^sub>M UNIV (\<lambda>j. M)" + using sets_K0[OF p x] + by (subst measurable_cong_sets[of _ "M \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>j. M)"]) auto + qed +next + show "space (K0 p x) \<noteq> {}" + using x p prob_space.not_empty prob_space_K0 + by blast +next + show "K0 p x \<bind> (\<lambda>x. distr (distr (lim_sequence (Suc_policy p x) (K x)) (Pi\<^sub>M UNIV (\<lambda>j. M)) + (case_nat x)) (stream_space M) to_stream) = K0 p x \<bind> (\<lambda>y. distr (lim_sequence (Suc_policy p y) + (K y)) (stream_space M) to_stream \<bind> (\<lambda>\<omega>. return (stream_space M) (y ## \<omega>)))" + proof (intro bind_cong refl, subst distr_distr) + show "to_stream \<in> Pi\<^sub>M UNIV (\<lambda>j. M) \<rightarrow>\<^sub>M stream_space M" + by measurable + next + show "\<And>a. a \<in> space (K0 p x) \<Longrightarrow> + case_nat a \<in> lim_sequence (Suc_policy p a) (K a) \<rightarrow>\<^sub>M Pi\<^sub>M UNIV (\<lambda>j. M)" + by measurable (auto simp: p x intro!: measurable_ident_sets sets_lim_sequence intro: measurable_space) + next + show "\<And>a. a \<in> space (K0 p x) \<Longrightarrow> + distr (lim_sequence (Suc_policy p a) (K a)) (stream_space M) (to_stream \<circ> case_nat a) = + distr (lim_sequence (Suc_policy p a) (K a)) (stream_space M) to_stream \<bind> + (\<lambda>\<omega>. return (stream_space M) (a ## \<omega>))" + + proof (subst bind_return_distr', goal_cases) + case (1 a) + then show ?case by (simp add: p space_stream_space_M_ne x) + next + case (2 a) + then show ?case using p x by (auto simp: sets_lim_sequence cong: measurable_cong_sets intro!: distr_cong)[1] + next + case (3 a) + then show ?case + using p x + by (subst distr_distr) (auto simp: to_stream_nat_case intro!: measurable_compose[OF _ measurable_to_stream] + sets_lim_sequence distr_cong measurable_ident_sets) + qed + qed +qed + +end +end \ No newline at end of file diff --git a/thys/MDP-Rewards/MDP_disc.thy b/thys/MDP-Rewards/MDP_disc.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/MDP_disc.thy @@ -0,0 +1,925 @@ +(* Author: Maximilian Schäffeler *) + +theory MDP_disc + imports + MDP_cont + "HOL-Library.Omega_Words_Fun" +begin + +section \<open>Markov Decision Processes with Discrete State Spaces\<close> + +(* counterpart to nn_integral_stream_space *) +lemma (in prob_space) integral_stream_space: + fixes f :: "'a stream \<Rightarrow> ('b :: {banach, second_countable_topology,real_normed_vector})" + assumes int_f: "integrable (stream_space M) f" + assumes [measurable]: "f \<in> borel_measurable (stream_space M)" + shows "(\<integral>X. f X \<partial>stream_space M) = (\<integral>x. (\<integral>X. f (x ## X) \<partial>stream_space M) \<partial>M)" +proof - + interpret S: sequence_space M .. + interpret P: pair_sigma_finite M "\<Pi>\<^sub>M i::nat\<in>UNIV. M" .. + + interpret P': pair_sigma_finite "\<Pi>\<^sub>M i::nat\<in>UNIV. M" M .. + + obtain i where "has_bochner_integral (stream_space M) f i" + using int_f + using integrable.cases by blast + have "integrable S.S (\<lambda>X. f (to_stream X))" + using int_f + by (metis integrable_distr measurable_to_stream stream_space_eq_distr) + hence "integrable (distr (M \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>i. M)) (Pi\<^sub>M UNIV (\<lambda>i. M)) + (\<lambda>(x, y). case_nat x y)) (\<lambda>X. f (to_stream X))" + by (auto simp: S.PiM_iter) + moreover have "integrable (distr (M \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>i. M)) (Pi\<^sub>M UNIV (\<lambda>i. M)) (\<lambda>(x, y). case_nat x y)) + (\<lambda>X. f (to_stream X)) \<longleftrightarrow> + integrable (M \<Otimes>\<^sub>M S.S) (\<lambda>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) X)))" + by (auto simp: integrable_distr_eq) + ultimately have "integrable (M \<Otimes>\<^sub>M S.S) (\<lambda>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) X)))" + by auto + hence "integrable (M \<Otimes>\<^sub>M (Pi\<^sub>M UNIV (\<lambda>i. M))) + (\<lambda>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) X)))" + by auto + moreover have "integrable (M \<Otimes>\<^sub>M (Pi\<^sub>M UNIV (\<lambda>i. M))) + (\<lambda>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) X))) = + integrable (M \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>i. M)) (\<lambda>(x, X). f (to_stream (case_nat x X)))" + by (fastforce intro!: integrable_cong) + ultimately have *: "integrable (M \<Otimes>\<^sub>M Pi\<^sub>M UNIV (\<lambda>i. M)) (\<lambda>(x, X). f (to_stream (case_nat x X)))" + by auto + + have "(\<integral>X. f X \<partial>stream_space M) = (\<integral>X. f (to_stream X) \<partial>S.S)" + by (subst stream_space_eq_distr) (simp add: integral_distr) + also have "\<dots> = (\<integral>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) X)) \<partial>(M \<Otimes>\<^sub>M S.S))" + by (subst S.PiM_iter[symmetric]) (simp add: integral_distr) + also have "\<dots> = (\<integral>x. \<integral>X. f (to_stream ((\<lambda>(s, \<omega>). case_nat s \<omega>) (x, X)))\<partial>S.S \<partial>M)" + using * + by (auto simp: pair_sigma_finite.integral_fst P.pair_sigma_finite_axioms case_prod_unfold) + also have "\<dots> = (\<integral>x. \<integral>X. f (x ## to_stream X) \<partial>S.S \<partial>M)" + by (auto intro!: integral_cong simp: to_stream_nat_case) + also have "\<dots> = (\<integral>x. \<integral>X. f (x ## X) \<partial>distr (Pi\<^sub>M UNIV (\<lambda>i. M)) (stream_space M) to_stream \<partial>M)" + by (subst Bochner_Integration.integral_cong[OF refl]) (auto simp: integral_distr) + also have "\<dots> = (\<integral>x. \<integral>X. f (x ## X) \<partial>stream_space M \<partial>M)" + using stream_space_eq_distr by metis + finally show ?thesis . +qed + +lemma prefix_cons: + "Omega_Words_Fun.prefix (Suc n) seq = seq 0#Omega_Words_Fun.prefix n (\<lambda>n. seq (Suc n))" + by (metis map_upt_Suc subsequence_def) + +lemma restrict_Suc: "restrict y {0..<Suc i} (Suc n) = (restrict (\<lambda>n. y (Suc n)) {0..<i}) n" + by auto + +lemma prefix_restrict: "Omega_Words_Fun.prefix i (restrict y {0..<i}) = Omega_Words_Fun.prefix i y" +proof (induction i arbitrary: y) + case (Suc i) + then show ?case + unfolding restrict_Suc prefix_cons + by fastforce+ +qed simp + +lemma prefix_measurable[measurable]: + "Omega_Words_Fun.prefix i \<in> Pi\<^sub>M {0..<i} + (\<lambda>_. count_space (UNIV :: ('s ::countable \<times> 'a::countable) set)) \<rightarrow>\<^sub>M count_space UNIV" +proof (induction i) + case 0 + then show ?case by simp +next + case (Suc i) + have aux: "(\<lambda>w. (restrict w {0..<i}, w i)) \<in> Pi\<^sub>M {0..<Suc i} (\<lambda>_. count_space UNIV) \<rightarrow>\<^sub>M + Pi\<^sub>M {0..<i} (\<lambda>_. count_space UNIV) \<Otimes>\<^sub>M (count_space UNIV)" + by auto + have aux': "(\<lambda>(w,wi). Omega_Words_Fun.prefix i (restrict w {0..<i})@[wi]) \<in> Pi\<^sub>M {0..<i} + (\<lambda>_. count_space (UNIV :: ('s \<times> 'a) set)) \<Otimes>\<^sub>M (count_space UNIV) \<rightarrow>\<^sub>M count_space UNIV" + using Suc.IH by auto + have f_eq: "\<And>w. Omega_Words_Fun.prefix i (restrict w {0..<i}) @ [w i] = + (\<lambda>(w,wi). Omega_Words_Fun.prefix i w @[wi]) ((restrict w {0..<i}), w i)" + by auto + have "(\<lambda>w:: nat \<Rightarrow> 's \<times> 'a. Omega_Words_Fun.prefix i (restrict w {0..<i}) @ [w i]) \<in> Pi\<^sub>M {0..<Suc i} (\<lambda>_. count_space UNIV) \<rightarrow>\<^sub>M count_space UNIV" + using aux aux'[unfolded prefix_restrict] + by (subst f_eq) auto + thus ?case + unfolding prefix_restrict[of _ "i"] + by auto +qed + +no_notation Omega_Words_Fun.build (infixr \<open>##\<close> 65) + +locale discrete_MDP = + fixes A :: "'s::countable \<Rightarrow> 'a::countable set" \<comment> \<open>enabled actions\<close> + and K :: "'s \<times> 'a \<Rightarrow> 's pmf" \<comment> \<open>MDP kernel, transition probabilities\<close> + assumes + A_ne: "\<And>s. A s \<noteq> {}" \<comment> \<open>set of enabled actions is nonempty\<close> +begin + +subsection \<open>Policies\<close> +text \<open>Type synonym for decision rules.\<close> +type_synonym ('c, 'd) dec = "'c \<Rightarrow> 'd pmf" + +definition is_dec :: "('s, 'a) dec \<Rightarrow> bool" where + "is_dec d \<equiv> \<forall>s. d s \<subseteq> A s" + +lemma is_decI[intro]: + "(\<And>s. set_pmf (d s) \<subseteq> A s) \<Longrightarrow> is_dec d" + unfolding is_dec_def + by auto + +abbreviation "D\<^sub>R \<equiv> {d. is_dec d}" + +definition is_dec_det :: "('s \<Rightarrow> 'a) \<Rightarrow> bool" where + "is_dec_det d \<equiv> \<forall>s. d s \<in> A s" + +abbreviation "D\<^sub>D \<equiv> {d. is_dec_det d}" + +definition "mk_dec_det d s = return_pmf (d s)" + +lemma is_dec_mk_dec_det_iff [simp]: "is_dec (mk_dec_det d) \<longleftrightarrow> is_dec_det d" + by (simp add: is_dec_def is_dec_det_def mk_dec_det_def) + +lemma D_det_to_MR[intro]: "is_dec_det d \<Longrightarrow> is_dec (mk_dec_det d)" + by simp + +text \<open> +Due to the assumption @{thm A_ne}, a deterministic decision rule always exists. +It immediately follows via @{thm is_dec_mk_dec_det_iff} that a randomized decision rule also exists. +\<close> + +lemma SOME_is_dec_det: "is_dec_det (\<lambda>s. SOME a. a \<in> A s)" + using A_ne by (simp add: is_dec_det_def some_in_eq) + +lemma ex_dec_det [simp]: "\<exists>d. is_dec_det d" + using SOME_is_dec_det by blast + +lemma D_det_ne [simp]: "D\<^sub>D \<noteq> {}" + by simp + +lemma D\<^sub>R_ne [simp]: "D\<^sub>R \<noteq> {}" + using D_det_ne D_det_to_MR by blast + +lemma ex_dec[intro, simp]: "\<exists>d. is_dec d" + using ex_dec_det by blast + +text \<open>Type synonym for policies.\<close> +type_synonym ('c, 'd) pol = "('c \<times> 'd) list \<Rightarrow> ('c, 'd) dec" + + +text \<open>A policy assigns a decision rule to each observed past.\<close> +definition is_policy :: "('s, 'a) pol \<Rightarrow> bool" where + "is_policy p \<equiv> \<forall>hs. is_dec (p hs)" + +abbreviation "\<Pi>\<^sub>H\<^sub>R \<equiv> {p. is_policy p}" + +text \<open>Deterministic policies\<close> +definition "is_deterministic p \<equiv> is_policy p \<and> (\<forall>h s. \<exists>a. p h s = return_pmf a)" + +definition "mk_det p h s \<equiv> return_pmf (p h s)" + +abbreviation "\<Pi>\<^sub>H\<^sub>D \<equiv> {p. \<forall>h. p h \<in> D\<^sub>D}" + +text \<open>Markovian policies\<close> +definition "is_markovian p \<equiv> is_policy p \<and> (\<forall>h h'. length h = length h' \<longrightarrow> p h = p h')" + +definition mk_markovian :: "(nat \<Rightarrow> ('s, 'a) dec) \<Rightarrow> ('s, 'a) pol" where + "mk_markovian p \<equiv> (\<lambda>h. p (length h))" + +lemma is_markovian_mk_iff[simp]: "is_markovian (mk_markovian p) \<longleftrightarrow> (\<forall>n. is_dec (p n))" + unfolding is_markovian_def mk_markovian_def is_policy_def + by (metis (mono_tags, opaque_lifting) Ex_list_of_length) + +lemma is_markovian_mk[intro]: "\<forall>n. is_dec (p n) \<Longrightarrow> is_markovian (mk_markovian p)" + unfolding is_markovian_def mk_markovian_def is_policy_def + by auto + +lemma mk_markovian_nil [simp]: "mk_markovian p [] = p 0" + unfolding mk_markovian_def by auto + +definition "mk_markovian_det p \<equiv> (\<lambda>h s. return_pmf (p (length h) s))" + +abbreviation "\<Pi>\<^sub>M\<^sub>D \<equiv> {p. \<forall>n. p n \<in> D\<^sub>D}" +abbreviation "\<Pi>\<^sub>M\<^sub>R \<equiv> {p. \<forall>n. p n \<in> D\<^sub>R}" + +lemma \<Pi>\<^sub>M\<^sub>R_imp_policies[intro]: "p \<in> \<Pi>\<^sub>M\<^sub>R \<Longrightarrow> mk_markovian p \<in> \<Pi>\<^sub>H\<^sub>R" + unfolding is_policy_def mk_markovian_def by auto + +lemma \<Pi>\<^sub>M\<^sub>D_MR_iff[simp]: "(\<lambda>n. mk_dec_det (p n)) \<in> \<Pi>\<^sub>M\<^sub>R \<longleftrightarrow> p \<in> \<Pi>\<^sub>M\<^sub>D" + by auto + +lemma \<Pi>\<^sub>M\<^sub>D_to_MR[intro]: "p \<in> \<Pi>\<^sub>M\<^sub>D \<Longrightarrow> (\<lambda>n. mk_dec_det (p n)) \<in> \<Pi>\<^sub>M\<^sub>R" + by simp + +lemma \<Pi>\<^sub>M\<^sub>D_ne[simp]: "\<Pi>\<^sub>M\<^sub>D \<noteq> {}" + by (auto simp: someI_ex[OF ex_dec_det] intro: exI[of _ "\<lambda>n. (SOME d. is_dec_det d)"]) + +lemma \<Pi>\<^sub>M\<^sub>R_ne[simp]: "\<Pi>\<^sub>M\<^sub>R \<noteq> {}" + using \<Pi>\<^sub>M\<^sub>D_ne by fast + +lemma policies_ne[simp, intro]: "\<Pi>\<^sub>H\<^sub>R \<noteq> {}" + using \<Pi>\<^sub>M\<^sub>R_ne is_policy_def by auto + + +text \<open>Stationary policies\<close> +definition "is_stationary p \<equiv> is_policy p \<and> (\<forall>h h'. p h = p h')" + +lemma is_stationary_const_iff[simp]: "is_stationary (\<lambda>_. d) = is_dec d" + unfolding is_stationary_def is_policy_def by simp + +lemma is_stationary_const[intro]: "is_dec d \<Longrightarrow> is_stationary (\<lambda>_. d)" + by simp + +abbreviation "mk_stationary p \<equiv> mk_markovian (\<lambda>_. p)" +abbreviation "mk_stationary_det d \<equiv> mk_markovian (\<lambda>_. mk_dec_det d)" + +subsubsection \<open>Successor Policy\<close> +text \<open> +After taking the first step in the MDP, we will know which state and which action got selected +during the initial epoch. To obtain a policy that acts as if the current epoch was the initial one, +we prepend the observed state-action pair to the history. The result is again a policy, +i.e. it satisfies @{const is_policy}. +\<close> +definition "\<pi>_Suc p sa h = p (sa#h)" + +lemma is_policy_\<pi>_Suc [intro]: "is_policy p \<Longrightarrow> is_policy (\<pi>_Suc p sa)" + unfolding is_policy_def \<pi>_Suc_def by force + +lemma Suc_mk_markovian[simp]: "\<pi>_Suc (mk_markovian p) x = mk_markovian (\<lambda>n. p (Suc n))" + unfolding \<pi>_Suc_def mk_markovian_def by auto + +subsection \<open>Stream Space of the MDP\<close> +subsubsection \<open>Initial State-Action Distribution\<close> +text \<open> +If we fix a decision rule @{term d} and an initial distribution of states @{term "S0"}, +we obtain a distribution over state-action pairs in the following way: +First, the initial state @{term "s"} is sampled from @{term S0}, +then an action @{term a} is selected from @{term "d s"}. +\<close> + +definition "K0 d S0 = do { + s \<leftarrow> S0; + a \<leftarrow> d s; + return_pmf (s,a) +}" + +notation K0 ("K\<^sub>0") + +lemma K0_iff: "K0 d S0 = S0 \<bind> (\<lambda>s. map_pmf (\<lambda>a. (s,a)) (d s))" + by (simp add: K0_def map_pmf_def) + +lemma vimage_pair[simp]: "Pair x -` {p} = (if x = fst p then {snd p} else {})" + by auto + +lemma pmf_K0 [simp]: "pmf (K0 d S0) (s,a) = pmf S0 s * pmf (d s) a" + unfolding K0_iff pmf_bind + by (subst integral_measure_pmf[where A = "{s}"]) (auto simp: pmf_map pmf.rep_eq split: if_splits) + +lemma set_pmf_K0: "set_pmf (K0 p S0) = {(s,a). s \<in> S0 \<and> a \<in> p s}" + by (auto simp add: K0_def) + +lemma fst_K0[simp]: "map_pmf fst (K0 p S0) = S0" + unfolding K0_def + by (simp add: map_bind_pmf map_pmf_comp bind_return_pmf') + +abbreviation "S \<equiv> stream_space (count_space UNIV)" + +text \<open>We inherit the trace space from MDPs with continuous state-action spaces\<close> +interpretation MDP_cont: MDP_cont.discrete_MDP "count_space UNIV" "count_space UNIV" A K +proof standard + show "(\<lambda>x. measure_pmf (K x)) \<in> + count_space UNIV \<Otimes>\<^sub>M count_space UNIV \<rightarrow>\<^sub>M prob_algebra (count_space UNIV)" + using measurable_prob_algebraI + by (measurable, auto simp: prob_space_measure_pmf measurable_pair_measure_countable1)+ + show "\<exists>\<delta>\<in>count_space UNIV \<rightarrow>\<^sub>M count_space UNIV. \<forall>s. \<delta> s \<in> A s" + by (auto simp: A_ne some_in_eq intro: bexI[of _ "\<lambda>s. SOME a. a \<in> A s"]) +qed (auto simp: A_ne) + +lemma count_space_M[simp]: "MDP_cont.M = count_space UNIV" + by (auto simp: pair_measure_countable) + +lemma space_M[simp]: "space MDP_cont.M = UNIV" + by (auto simp: MDP_cont.space_lim_stream) + +text \<open>We reuse the stream space provided by @{const MDP_cont.lim_stream}\<close> +definition T :: "('s, 'a) pol \<Rightarrow> 's pmf \<Rightarrow> ('s \<times> 'a) stream measure" + where "T p = MDP_cont.lim_stream (\<lambda>n (h,s). p (Omega_Words_Fun.prefix n h) s)" + +lemma sets_T[measurable_cong]: + "sets (T p x) = sets S" + by (auto simp: T_def MDP_cont.sets_lim_stream) + +lemma space_stream_space_ne[simp]: "space S \<noteq> {}" + by (auto simp: space_stream_space) + +lemma space_T[simp]: "space (T p S0) = space S" + by (simp add: MDP_cont.space_lim_stream T_def space_stream_space) + +lemma is_policy_MDP_cont[intro]: + fixes p :: "('s \<times> 'a) list \<Rightarrow> 's \<Rightarrow> 'a pmf" + shows "MDP_cont.is_policy (\<lambda>n (h,s). p (Omega_Words_Fun.prefix n h) s)" + unfolding MDP_cont.is_policy_def MDP_cont.is_dec_def + using prefix_measurable measurable_pair_swap_iff + by (auto simp: prob_space_measure_pmf + intro: measurable_pair_measure_countable1 measurable_prob_algebraI) + +lemma prob_space_T[intro, simp]: "prob_space (T p x)" + by (auto simp add: T_def prob_space_measure_pmf space_prob_algebra) + +lemma T_subprob[simp]: + "T p S0 \<in> space (subprob_algebra S)" + by (metis prob_space.M_in_subprob prob_space_T sets_T subprob_algebra_cong) + +lemma T_subprob_space [simp]: "subprob_space (T p S0)" + by (auto intro: prob_space_imp_subprob_space) + +lemma K0_MDP_cont_eq: + "MDP_cont.K0 (\<lambda>x (h,s). measure_pmf (p (Omega_Words_Fun.prefix x h) s)) (measure_pmf S0) = + K0 (p []) S0" + unfolding MDP_cont.K0_def K0_def MDP_cont.K'_def map_pmf_def + by (simp add: measure_pmf_bind return_pmf.rep_eq) + +subsubsection \<open>Decomposition of the Stream Space\<close> +text \<open> +The distribution of traces/walks the MDP allows should intuitively satisfy the following rule: + +\<^enum> select the initial state @{term s} from @{term S0} +\<^enum> pass it to the decision rule @{term "p []"} to determine a distribution over actions +\<^enum> select the action @{term a} +\<^item> finally pass the state-action pair @{term "(s,a)"} to the kernel @{term K} to get a new + distribution over states @{term s0'} + +Then the iteration repeats with the updated policy @{term "\<pi>_Suc p (s,a)"}. + +The result carries over from @{thm MDP_cont.lim_stream_eq}. +\<close> + +lemma T_eq: + shows "T p S0 = do { + sa \<leftarrow> measure_pmf (K0 (p []) S0); + \<omega> \<leftarrow> T (\<pi>_Suc p sa) (K sa); + return S (sa ## \<omega>) + }" + unfolding T_def +proof (subst MDP_cont.lim_stream_eq) + show "MDP_cont.is_policy (\<lambda>x xa. measure_pmf (case xa of (h, xa) \<Rightarrow> p (Omega_Words_Fun.prefix x h) xa))" + by auto +qed (auto simp: space_prob_algebra prob_space_measure_pmf \<pi>_Suc_def MDP_cont.Suc_policy_def + prefix_cons K0_MDP_cont_eq prod.case_distrib) + +lemma T_eq_distr: + shows "T p S0 = measure_pmf (K0 (p []) S0) \<bind> (\<lambda>sa. distr (T (\<pi>_Suc p sa) (K sa)) S ((##) sa))" + by (simp add: T_eq[symmetric] bind_return_distr'[symmetric]) + +text \<open> +The iteration rule lets us nicely decompose integrals (expected values) over functions on traces of +the MDP. +\<close> +lemma integral_T: + fixes f :: "('s \<times> 'a) stream \<Rightarrow> real" + assumes f_bounded: "\<And>x. \<bar>f x\<bar> \<le> B" + assumes f: "f \<in> borel_measurable S" + shows "(\<integral>t. f t \<partial>T p x) = \<integral>sa. \<integral>t'. f (sa##t') \<partial>T (\<pi>_Suc p sa) (K sa) \<partial>K0 (p []) x" +proof - + note T_eq_distr + have "(\<integral>t. f t \<partial>T p x) = (\<integral>t. f t \<partial>measure_pmf (K\<^sub>0 (p []) x) \<bind> (\<lambda>sa. distr (T (\<pi>_Suc p sa) (K sa)) (stream_space (count_space UNIV)) ((##) sa)))" + using T_eq_distr by metis + also have "\<dots> = measure_pmf.expectation (K\<^sub>0 (p []) x) (\<lambda>sa. LINT t'|T (\<pi>_Suc p sa) (K sa). f (sa ## t'))" + proof (subst integral_bind[OF f f_bounded, where B' = 1], goal_cases) + case 1 + then show ?case + by (auto intro!: prob_space_imp_subprob_space prob_space.prob_space_distr + simp: space_subprob_algebra) + next + case 3 + then show ?case + by (auto intro!: prob_space.emeasure_le_1 prob_space.prob_space_distr) + next + case 4 + then show ?case + by (auto simp: f integral_distr intro: Bochner_Integration.integral_cong) + qed auto + finally show ?thesis. +qed + + +lemma nn_integral_T: + assumes f: "f \<in> borel_measurable S" + shows "(\<integral>\<^sup>+t. f t \<partial>T p x) = (\<integral>\<^sup>+sa. \<integral>\<^sup>+ t'. f (sa##t') \<partial>T (\<pi>_Suc p sa) (K sa) \<partial>K0 (p []) x)" + unfolding T_eq_distr[of p] + by (subst nn_integral_bind[OF f]) + (auto intro!: prob_space_imp_subprob_space prob_space.prob_space_distr + simp: f nn_integral_distr space_subprob_algebra) + +subsubsection \<open>A Denotational View on the Stochastic Process\<close> +text \<open> +Many definitions on MDPs do not rely on the individual traces but only on the distribution +of states and actions at each epoch. + +We define this view on the trace space as the repeated iteration of @{const K0} and @{term K}. +It conincides with the definition of @{const T}. +\<close> + +primrec Pn :: "('s, 'a) pol \<Rightarrow> 's pmf \<Rightarrow> nat \<Rightarrow> ('s \<times> 'a) pmf" where + "Pn p S0 0 = K0 (p []) S0" +| "Pn p S0 (Suc n) = K0 (p []) S0 \<bind> (\<lambda>sa. Pn (\<pi>_Suc p sa) (K sa) n)" +declare Pn.simps(2)[simp del] + +lemma Pn_eq_T: + shows "measure_pmf (Pn p S0 n) = distr (T p S0) (count_space UNIV) (\<lambda>t. t !! n)" +proof (induction n arbitrary: p S0) + case (0 p S0) + then show ?case + unfolding T_eq[of p] + proof (subst distr_bind[where K = S], goal_cases) + case 1 + then show ?case + by (auto intro!: prob_space_imp_subprob_space subprob_space.bind_in_space) + next + case 4 + then show ?case + by (subst bind_cong[OF refl, where g = "return (count_space UNIV)"]) + (auto intro!: bind_const' simp: distr_bind[where K = S] distr_return bind_return'' space_stream_space subprob_space_return_ne) + qed auto +next + case (Suc n) + show ?case + unfolding T_eq[of p] + proof (subst distr_bind[where K = S], goal_cases) + case 1 + then show ?case + by (auto intro!: prob_space_imp_subprob_space subprob_space.bind_in_space)[1] + next + case 4 + then show ?case + by (auto simp: Pn.simps(2) measure_pmf_bind Suc bind_return_distr' distr_distr comp_def intro!: bind_cong) + qed auto +qed + +text \<open> +The definition of @{const Pn} also allows us to easily prove that only enabled actions can occur in +the traces of the MDP. +\<close> + +lemma Pn_in_A: "is_policy p \<Longrightarrow> (s, a) \<in> Pn p S0 n \<Longrightarrow> a \<in> A s" +proof (induction n arbitrary: S0 p) + case 0 + then show ?case + using 0 unfolding is_policy_def is_dec_def + by (auto simp: K0_def) +next + case (Suc n) + then show ?case + by (auto simp: Pn.simps(2) K0_def) +qed + +lemma T_in_A: + assumes "is_policy p" + shows "AE t in T p S0. snd (t !! n) \<in> A (fst (t !! n))" +proof - + have aux: "AE t in distr (T p S0) (count_space UNIV) (\<lambda>t. t !! n). snd t \<in> A (fst t)" + using assms Pn_eq_T[symmetric] + by (auto simp: Pn_in_A intro!: AE_pmfI cong: AE_cong_simp) + show ?thesis + by (auto intro!: AE_distrD[OF _ aux]) +qed + +subsubsection \<open>State Process\<close> +text \<open>Alongside @{const Pn}, we also define the state and action distributions as projections.\<close> + +definition "Xn p S0 n = map_pmf fst (Pn p S0 n)" + +lemma X0 [simp]: "Xn p S0 0 = S0" + using fst_K0 Xn_def by auto + +lemma Xn_Suc: "Xn p S0 (Suc n) = Pn p S0 n \<bind> K" +proof (induction n arbitrary: p S0) + case 0 + then show ?case + by (simp add: Pn.simps(2) Xn_def map_bind_pmf) +next + case (Suc n) + then show ?case + by (simp add: Pn.simps(2) Xn_def map_bind_pmf bind_assoc_pmf) +qed + +lemma Pn_markovian_eq_Xn_bind: "Pn (mk_markovian p) S0 n = K0 (p n) (Xn (mk_markovian p) S0 n)" +proof (induction n arbitrary: p S0) + case 0 + then show ?case + unfolding Xn_def by auto +next + case (Suc n) + then show ?case + unfolding Xn_def K0_def + by (auto intro!: bind_pmf_cong simp: Pn.simps(2) map_bind_pmf Suc bind_assoc_pmf) +qed + +lemma Xn_Suc': "Xn p S0 (Suc n) = K0 (p []) S0 \<bind> (\<lambda>sa. Xn (\<pi>_Suc p sa) (K sa) n)" + unfolding Xn_def by (auto simp: Pn.simps(2) map_bind_pmf) + +lemma set_pmf_X0 [simp]: "set_pmf (Xn p S0 0) = S0" + using X0 by auto + +lemma set_pmf_PSuc: "set_pmf (Pn (mk_markovian p) S0 n) = + {(s, a). s \<in> set_pmf (Xn (mk_markovian p) S0 n) \<and> a \<in> p n s}" + using set_pmf_K0 Pn_markovian_eq_Xn_bind + by auto + +subsubsection \<open>The Conditional Distribution of Actions\<close> +text \<open> +Actions are selected wrt. the whole history of state-action pairs encountered so far. +The following definition defines the expected action selection when only the current state is given.\<close> +definition "Y_cond_X p S0 n x = map_pmf snd (cond_pmf (Pn p S0 n) {(s,a). s = x})" + +lemma prob_K0_X [simp]: "measure_pmf.prob (K0 p S0) {(s, a). s = x} = pmf S0 x" + unfolding K0_iff +proof (subst measure_pmf_bind, subst measure_pmf.measure_bind[of _ _ "count_space UNIV"], goal_cases) + case 1 + then show ?case + by (simp add: measure_pmf_in_subprob_algebra) +next + case 3 + then show ?case + by (subst integral_measure_pmf_real[of "{x}"]) (auto split: if_splits) +qed simp + +lemma prob_Pn_X[simp]: "measure_pmf.prob (Pn p S0 n) {(s, a). s = x} = pmf (Xn p S0 n) x" +proof (induction n arbitrary: p S0) + case 0 + then show ?case + by auto +next + case (Suc n) + show ?case + unfolding Xn_Suc' Pn.simps(2) measure_pmf_bind + using Suc + by (simp add: measure_pmf.measure_bind[of _ _ "count_space UNIV"] K0_def + measure_pmf_in_subprob_algebra pmf_bind) +qed + +lemma pmf_Pn_pair: + assumes "sa \<in> set_pmf (Pn p S0 n)" + shows "pmf (Pn p S0 n) sa = pmf (Y_cond_X p S0 n (fst sa)) (snd sa) * pmf (Xn p S0 n) (fst sa)" +proof - + have aux: "set_pmf (Pn p S0 n) \<inter> {(s, a). s = fst sa} \<noteq> {}" + using Xn_def assms + by auto + have aux': "({(s, a). s = fst sa} \<inter> snd -` {snd sa}) = {sa}" + by auto + show ?thesis + using assms + unfolding Y_cond_X_def pmf_map cond_pmf.rep_eq[OF aux] + by (auto simp: Xn_def pmf_eq_0_set_pmf measure_pmf.emeasure_eq_measure aux' measure_pmf_single) +qed + +lemma pmf_Pn: + assumes "x \<in> set_pmf (Xn p S0 n)" + shows "pmf (Pn p S0 n) (x,a) = pmf (Y_cond_X p S0 n x) a * pmf (Xn p S0 n) x" +proof - + have aux: "set_pmf (Pn p S0 n) \<inter> {(s, a). s = x} \<noteq> {}" + using Xn_def assms by auto + have aux': "({(s, a). s = x} \<inter> snd -` {a}) = {(x, a)}" + by auto + show ?thesis + using assms + unfolding Y_cond_X_def cond_pmf.rep_eq[OF aux] pmf_map + by (auto simp: pmf_eq_0_set_pmf measure_pmf.emeasure_eq_measure aux' measure_pmf_single) +qed + +lemma pmf_Y_cond_X: + assumes "x \<in> set_pmf (Xn p S0 n)" + shows "pmf (Y_cond_X p S0 n x) a = pmf (Pn p S0 n) (x,a) / pmf (Xn p S0 n) x" +proof - + have aux: "set_pmf (Pn p S0 n) \<inter> {(s, a). s = x} \<noteq> {}" + using Xn_def assms by auto + have aux': "({(s, a). s = x} \<inter> snd -` {a}) = {(x, a)}" + by auto + show ?thesis + using assms aux' + unfolding Y_cond_X_def + by (auto simp: cond_pmf.rep_eq[OF aux] pmf_map pmf_eq_0_set_pmf measure_pmf.emeasure_eq_measure + measure_pmf_single) +qed + +lemma Y_cond_X_0[simp]: + assumes "x \<in> set_pmf S0" + shows "Y_cond_X p S0 0 x = p [] x" + by (auto intro: pmf_eqI simp: assms pmf_Y_cond_X pmf_eq_0_set_pmf) + +(* eqn 5.5.3 in Puterman *) +lemma Y_cond_X_markovian[simp]: + assumes h: "x \<in> Xn (mk_markovian p) S0 n" + shows "Y_cond_X (mk_markovian p) S0 n x = p n x" + by (auto intro!: pmf_eqI simp: pmf_Y_cond_X h Pn_markovian_eq_Xn_bind pmf_eq_0_set_pmf) + +lemma Pn_eq_Xn_Y_cond: "Pn p S0 n = Xn p S0 n \<bind> (\<lambda>x. map_pmf (\<lambda>a. (x, a)) (Y_cond_X p S0 n x))" +proof (induction n) + case 0 + then show ?case + by (auto simp: K0_iff intro: bind_pmf_cong) +next + case (Suc n) + show ?case + proof (intro pmf_eqI; safe) + fix a :: 's + fix b :: 'a + have aux': "pmf (Xn p S0 (Suc n) \<bind> (\<lambda>x. map_pmf (Pair x) (Y_cond_X p S0 (Suc n) x))) (a,b) + = measure_pmf.expectation (Pn p S0 (Suc n)) (\<lambda>x. + if fst x = a then pmf (Y_cond_X p S0 (Suc n) a) b else 0)" + by (auto intro!: Bochner_Integration.integral_cong[OF refl] + simp: Xn_def bind_map_pmf pmf_map pmf_bind measure_pmf_single) + also have "\<dots> = measure_pmf.expectation (Pn p S0 (Suc n)) + (\<lambda>x. indicator {(s',a'). s' = a} x * (pmf (Pn p S0 (Suc n)) (a, b) / pmf (Xn p S0 (Suc n)) a))" + proof (intro Bochner_Integration.integral_cong_AE AE_pmfI) + fix y + assume h: "y \<in> set_pmf (Pn p S0 (Suc n))" + hence h': "fst y \<in> set_pmf (Xn p S0 (Suc n))" + by (metis mult_eq_0_iff pmf_Pn_pair pmf_eq_0_set_pmf) + show "(if fst y = a then pmf (Y_cond_X p S0 (Suc n) a) b else 0) = + indicat_real {(s', a'). s' = a} y * + (pmf (Pn p S0 (Suc n)) (a, b) / pmf (Xn p S0 (Suc n)) a)" + by (auto simp: case_prod_beta' pmf_Y_cond_X[of "fst y" p S0 "(Suc n)" b, OF h']) + qed auto + also have "\<dots> = measure_pmf.prob (Pn p S0 (Suc n)) {(s',a'). s' = a} * + pmf (Pn p S0 (Suc n)) (a, b) / pmf (Xn p S0 (Suc n)) a" + by auto + also have "\<dots> = pmf (Pn p S0 (Suc n)) (a,b)" + using prob_Pn_X Xn_def pmf_Pn_pair pmf_eq_0_set_pmf by fastforce + finally show "pmf (Pn p S0 (Suc n)) (a, b) = pmf (Xn p S0 (Suc n) \<bind> + (\<lambda>x. map_pmf (Pair x) (Y_cond_X p S0 (Suc n) x))) (a, b)" + by auto + qed +qed + +lemma Pn_eq_Xn_Y_cond': + "Pn p S0 n = Xn p S0 n \<bind> (\<lambda>s. Y_cond_X p S0 n s \<bind> (\<lambda>a. return_pmf (s,a)))" + by (metis K0_def K0_iff Pn_eq_Xn_Y_cond) + +lemma Pn_markovian_Suc: "Pn (mk_markovian p) S0 (Suc n) = + Pn (mk_markovian p) S0 n \<bind> (\<lambda>sa. K0 (p (Suc n)) (K sa))" +proof (induction n arbitrary: S0 p) + case 0 + then show ?case + by (auto intro: bind_pmf_cong simp: Pn.simps(2) \<pi>_Suc_def) +next + case (Suc n) + show ?case + by (auto simp add: Suc bind_assoc_pmf Pn.simps(2)[of _ S0] intro: bind_pmf_cong) +qed + +subsubsection \<open>Action Process\<close> +text \<open>The distribution of actions.\<close> +definition "Yn p S0 n = map_pmf snd (Pn p S0 n)" + +lemma Y0: "Yn p S0 0 = S0 \<bind> p []" + by (simp add: Yn_def K0_iff map_bind_pmf map_pmf_comp) + +text \<open> +For markovian policies, the decision rules at each epoch are independent of each other, +hence we may express @{const Yn} solely in terms of @{const Xn} and the current decision rule. +\<close> + +lemma Yn_markovian: "Yn (mk_markovian p) S0 n = Xn (mk_markovian p) S0 n \<bind> p n" +proof (induction n arbitrary: p S0) + case 0 + then show ?case + by (auto simp: Y0) +next + case (Suc n) + then show ?case + by (simp add: Xn_def Yn_def map_bind_pmf Suc Pn.simps(2) bind_assoc_pmf) +qed + +subsection \<open>Restriction to Markovian Policies\<close> +abbreviation "as_markovian p S0 n x \<equiv> + if x \<in> (Xn p S0 n) then Y_cond_X p S0 n x else return_pmf (SOME a. a \<in> A x)" + +text \<open> +For states which cannot occur we choose an arbitrary enabled action, as in this case we cannot make +any statements about @{const Y_cond_X} (a distribution conditioned on an event with probability 0). +\<close> + +lemma is_\<Pi>\<^sub>M\<^sub>R_as_markovian: + assumes p: "is_policy p" + shows "as_markovian p S0 \<in> \<Pi>\<^sub>M\<^sub>R" +proof - + have aux: "\<And>hs s. s \<in> set_pmf (Xn p S0 hs) \<Longrightarrow> set_pmf ((Pn p S0 hs)) \<inter> {(s', a). s' = s} \<noteq> {}" + by (simp add: measure_pmf_zero_iff[symmetric] pmf_eq_0_set_pmf) + thus ?thesis + using assms A_ne Pn_in_A + unfolding is_dec_def Y_cond_X_def + by (auto simp: some_in_eq) +qed + +lemma is_policy_as_markovian: "is_policy p \<Longrightarrow> is_policy (mk_markovian (as_markovian p S0))" + using is_\<Pi>\<^sub>M\<^sub>R_as_markovian \<Pi>\<^sub>M\<^sub>R_imp_policies by auto + +theorem Pn_as_markovian_eq: "Pn (mk_markovian (as_markovian p S0)) S0 = Pn p S0" +proof + fix n show "Pn (mk_markovian (as_markovian p S0)) S0 n = Pn p S0 n" + proof (induction n) + case 0 + thus ?case + by (auto intro!: map_pmf_cong bind_pmf_cong simp: K0_def) + next + case (Suc n) + have "\<And>x. x \<in> Xn p S0 (Suc n) \<Longrightarrow> + Y_cond_X (mk_markovian (as_markovian p S0)) S0 (Suc n) x = Y_cond_X p S0 (Suc n) x" + by (auto simp: Suc.IH Xn_Suc) + moreover have "Xn (mk_markovian (as_markovian p S0)) S0 (Suc n) = Xn p S0 (Suc n)" + by (simp add: Xn_Suc Suc.IH) + ultimately show "Pn (mk_markovian (as_markovian p S0)) S0 (Suc n) = Pn p S0 (Suc n)" + by (auto intro: bind_pmf_cong simp: Pn_eq_Xn_Y_cond) + qed +qed + +subsection \<open>MDPs without Initial Distribution\<close> +text \<open> +From now on, we assume a known, deterministic initial state. +All results from the previous discussion carry over as we are now in the special case +where we the initial state is of the form @{term "return_pmf s"}. +\<close> +definition "\<T> p s \<equiv> T p (return_pmf s)" + +lemma \<T>_eq_return_distr: "\<T> p s = + measure_pmf (p [] s) \<bind> (\<lambda>a. distr (T (\<pi>_Suc p (s,a)) (K (s,a))) S ((##) (s,a)))" + unfolding \<T>_def + by (subst T_eq_distr) (fastforce intro!: bind_distr subprob_space.subprob_space_distr + simp: K0_iff map_pmf_rep_eq space_subprob_algebra bind_return_pmf)+ + +lemma \<T>_eq_return: + shows "\<T> p s = do { + y \<leftarrow> measure_pmf (p [] s); + \<omega> \<leftarrow> T (\<pi>_Suc p (s,y)) (K (s,y)); + return S ((s,y) ## \<omega>) + }" + by (auto simp: \<T>_eq_return_distr bind_return_distr' prob_space.not_empty intro!: bind_cong) + +lemma \<T>_return: + shows "T p S0 = measure_pmf S0 \<bind> \<T> p" +proof - + have "T p S0 = measure_pmf S0 \<bind> (\<lambda>x. measure_pmf (map_pmf (Pair x) (p [] x))) \<bind> + (\<lambda>sa. distr (T (\<pi>_Suc p sa) (K sa)) (stream_space (count_space UNIV)) ((##) sa))" + unfolding T_eq_distr[of p] K0_iff measure_pmf_bind + by auto + also have "\<dots> = measure_pmf S0 \<bind> + (\<lambda>x. distr (measure_pmf (p [] x)) (count_space UNIV) (Pair x) \<bind> + (\<lambda>sa. distr (T (\<pi>_Suc p sa) (K sa)) (stream_space (count_space UNIV)) ((##) sa)))" + using measurable_measure_pmf + by (subst bind_assoc[where N = "count_space UNIV", where R = S]) + (fastforce intro!: prob_space_imp_subprob_space prob_space.prob_space_distr + simp: space_subprob_algebra prob_space_measure_pmf map_pmf_rep_eq)+ + also have "\<dots> = measure_pmf S0 \<bind> \<T> p" + by (subst bind_distr[where K = S]) + (auto intro!: prob_space_imp_subprob_space prob_space.prob_space_distr bind_cong + simp: space_subprob_algebra \<T>_eq_return_distr) + finally show ?thesis. +qed + +lemma \<T>_return_eq: + shows + "\<T> p s = do { + a \<leftarrow> measure_pmf (p [] s); + s' \<leftarrow> measure_pmf (K (s,a)); + w \<leftarrow> T (\<pi>_Suc p (s,a)) (return_pmf s'); + return S ((s,a)##w) +}" +proof - + have "\<T> p s = do { + a \<leftarrow> measure_pmf (p [] s); + \<omega> \<leftarrow> T (\<pi>_Suc p (s, a)) (K (s, a)); + return S ((s, a) ## \<omega>)}" + using \<T>_eq_return + by auto + also have "\<dots> = do { + a \<leftarrow> measure_pmf (p [] s); + s' \<leftarrow> measure_pmf (K (s, a)); + \<omega> \<leftarrow> T (\<pi>_Suc p (s, a)) (return_pmf s'); + return S ((s, a) ## \<omega>)}" + unfolding \<T>_return + by (subst bind_assoc[of _ _ S _ S]) (auto simp add: \<T>_def \<T>_return[symmetric]) + finally show ?thesis. +qed + +lemma \<T>_eq: + shows "\<T> p s = do { + a \<leftarrow> measure_pmf (p [] s); + s' \<leftarrow> measure_pmf (K (s,a)); + w \<leftarrow> \<T> (\<pi>_Suc p (s,a)) s'; + return S ((s,a)##w) +}" + by (subst \<T>_return_eq) (auto simp add: \<T>_def ) + +lemma \<T>_prob_space[intro]: "prob_space (\<T> p s)" + by (metis \<T>_def prob_space_T) + +lemma \<T>_sets[measurable_cong]: + "sets (\<T> p s) = sets S" + by (simp add: \<T>_def sets_T) + +lemma measurable_ident_Suc'[measurable]: + "(\<lambda>x. x) \<in> \<T> (\<pi>_Suc p sa) s' \<rightarrow>\<^sub>M S" + by (simp add: \<T>_def) + +lemma nn_integral_\<T>: + fixes f :: "('s \<times> 'a) stream \<Rightarrow> real" + assumes f[measurable]: "f \<in> borel_measurable S" + shows "(\<integral>\<^sup>+t. f t \<partial>\<T> p s) + = \<integral>\<^sup>+a. \<integral>\<^sup>+s'. \<integral>\<^sup>+t'. f ((s,a)##t') \<partial>\<T> (\<pi>_Suc p (s,a)) s' \<partial>K (s,a) \<partial>p [] s" +proof - + have "(\<integral>\<^sup>+t. f t \<partial>\<T> p s) = + \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. (f y) \<partial>measure_pmf (K (s, x)) \<bind> (\<lambda>s'. \<T> (\<pi>_Suc p (s, x)) s' \<bind> (\<lambda>w. return S ((s, x) ## w))) \<partial>(p [] s)" + unfolding \<T>_eq[of p] + by (subst nn_integral_bind[of _ S]) + (auto intro!: measure_pmf.bind_in_space subprob_space.bind_in_space simp: \<T>_prob_space prob_space_imp_subprob_space) + also have "\<dots> = \<integral>\<^sup>+ x. \<integral>\<^sup>+ xa. \<integral>\<^sup>+ y. (f y) \<partial>\<T> (\<pi>_Suc p (s, x)) xa \<bind> (\<lambda>w. return S ((s, x) ## w)) + \<partial>measure_pmf (K (s, x)) \<partial>(p [] s)" + by (subst nn_integral_bind[of _ S]) + (auto intro!: subprob_space.bind_in_space simp: \<T>_prob_space prob_space_imp_subprob_space) + also have "\<dots> = \<integral>\<^sup>+ x. \<integral>\<^sup>+ xa. \<integral>\<^sup>+ y. (f y) \<partial>distr (\<T> (\<pi>_Suc p (s, x)) xa) S ((##) (s, x)) \<partial>measure_pmf (K (s, x)) \<partial>(p [] s)" + by (auto simp add: bind_return_distr' \<T>_prob_space prob_space.not_empty) + also have "\<dots> = \<integral>\<^sup>+ x. \<integral>\<^sup>+ xa. \<integral>\<^sup>+ xa. (f ((s, x) ## xa)) \<partial>\<T> (\<pi>_Suc p (s, x)) xa \<partial>measure_pmf (K (s, x)) \<partial>(p [] s)" + by (auto simp: nn_integral_distr) + finally show ?thesis. +qed + +lemma integral_\<T>: + fixes f :: "('s \<times> 'a) stream \<Rightarrow> real" + assumes f_bounded: "\<And>x. \<bar>f x\<bar> \<le> B" + assumes f[measurable]: "f \<in> borel_measurable S" + shows "(\<integral>t. f t \<partial>\<T> p s) + = \<integral>a. \<integral>s'. \<integral>t'. f ((s,a)##t') \<partial>\<T> (\<pi>_Suc p (s,a)) s' \<partial>K (s,a) \<partial>p [] s" + unfolding \<T>_def integral_T[OF f_bounded f] K0_iff bind_return_pmf + unfolding \<T>_return[of "\<pi>_Suc p _"] integral_map_pmf + using \<T>_return[of "\<pi>_Suc p _", symmetric] + by (subst integral_bind[OF _ f_bounded, where B' = 1, where K = S]) + (auto simp: \<T>_def intro: prob_space.emeasure_le_1) + +lemma integrable_\<T>_bounded[intro]: + fixes f :: "('s \<times> 'a) stream \<Rightarrow> 'd :: {second_countable_topology,banach}" + assumes f[measurable]: "f \<in> borel_measurable S" + assumes b: "bounded (range f)" + shows "integrable (\<T> p s) f" + using b + by (auto simp: prob_space.finite_measure \<T>_prob_space bounded_iff + intro!: finite_measure.integrable_const_bound) + +definition "Pn' p s = Pn p (return_pmf s)" +definition "Xn' p s = Xn p (return_pmf s)" +definition "Yn' p s = Yn p (return_pmf s)" +definition "K0' d s \<equiv> map_pmf (\<lambda>a. (s, a)) (d s)" + +definition "K_st d s \<equiv> d s \<bind> (\<lambda>a. K (s,a))" + +lemma pmf_K_st: "pmf (K_st d s) t = \<integral>a. pmf (K(s, a)) t \<partial>d s" + unfolding K_st_def + by (subst pmf_bind) auto + +text \<open> +@{const K_st} defines the distribution over the successor states for a given decision rule and state. +It is mostly useful for markovian policies, as the information which action was selected is lost.\<close> + +lemma P0'[simp]: "Pn' p s 0 = K0' (p []) s" + by (simp add: Pn'_def K0'_def K0_iff bind_return_pmf) + +lemma X0'[simp]: "Xn' p s 0 = return_pmf s" + using X0 Xn'_def by auto + +lemma Pn_return_pmf: "S0 \<bind> (\<lambda>s'. Pn p (return_pmf s') n) = Pn p S0 n" + by (induction n arbitrary: p S0) + (auto intro: bind_pmf_cong simp add: Pn.simps(2) K0_def bind_assoc_pmf bind_return_pmf) + +lemma PSuc': "Pn' p s (Suc n) = K0' (p []) s \<bind> (\<lambda>sa. K sa \<bind> (\<lambda>s'. Pn' (\<pi>_Suc p sa) s' n))" + unfolding Pn'_def + by (auto intro!: bind_pmf_cong + simp: Pn.simps(2) Pn_return_pmf K0_iff K0'_def bind_return_pmf map_bind_pmf bind_map_pmf) + +lemma PSuc'_markovian: + "Pn' (mk_markovian p) s (Suc n) = K_st (p 0) s \<bind> (\<lambda>s'. Pn' (mk_markovian (p \<circ> Suc)) s' n)" + unfolding PSuc' + by (auto simp: bind_map_pmf bind_assoc_pmf comp_def K0'_def K_st_def intro!: bind_pmf_cong) + +lemma Xn'_Suc: "Xn' p s (Suc n) = Pn' p s n \<bind> K" + by (auto simp: Xn_Suc Xn'_def Pn'_def) + +lemma Xn'_Pn': "Xn' p s n = map_pmf fst (Pn' p s n)" + by (simp add: Xn_def Xn'_def Pn'_def) + +lemma Suc_Xn': "Xn' p s (Suc n) = p [] s \<bind> (\<lambda>a. K (s,a) \<bind> (\<lambda>s'. Xn' (\<pi>_Suc p (s,a)) s' n))" + by (auto simp: Xn'_Pn' map_bind_pmf bind_map_pmf PSuc' K0'_def) + +lemma Suc_Xn'_markovian: + "Xn' (mk_markovian p) s (Suc n) = K_st (p 0) s \<bind> (\<lambda>s'. Xn' (mk_markovian (\<lambda>n. p (Suc n))) s' n)" + by (auto simp: K_st_def bind_assoc_pmf Suc_Xn') + +lemma Xn'_split: "Xn' (mk_markovian p) s (n + m) = + Xn' (mk_markovian p) s n \<bind> (\<lambda>s. Xn' (mk_markovian (\<lambda>i. p (i + n))) s m)" + by (induction n arbitrary: p s) (auto intro!: bind_pmf_cong simp: bind_assoc_pmf bind_return_pmf Suc_Xn') + +lemma Yn'_markovian: "Yn' (mk_markovian p) s n = Xn' (mk_markovian p) s n \<bind> p n" + unfolding Yn'_def Xn'_def Yn_markovian + by simp + +lemma Pn'_markovian_eq_Xn'_bind: "Pn' (mk_markovian p) s n = Xn' (mk_markovian p) s n \<bind> K0' (p n)" + unfolding Xn'_def Pn'_def K0'_def K0_iff Pn_markovian_eq_Xn_bind + by simp + +lemma Pn'_eq_\<T>: "measure_pmf (Pn' p s n) = distr (\<T> p s) (count_space UNIV) (\<lambda>t. t !! n)" + by (auto simp: \<T>_def Pn'_def Pn_eq_T) +end +end \ No newline at end of file diff --git a/thys/MDP-Rewards/MDP_reward.thy b/thys/MDP-Rewards/MDP_reward.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/MDP_reward.thy @@ -0,0 +1,1540 @@ +(* Author: Maximilian Schäffeler *) + +theory MDP_reward + imports + Bounded_Functions + MDP_reward_Util + Blinfun_Util + MDP_disc +begin + +section \<open>Markov Decision Processes with Rewards\<close> + +locale MDP_reward = discrete_MDP A K + for + A and + K :: "'s ::countable \<times> 'a ::countable \<Rightarrow> 's pmf" + + fixes + r :: "('s \<times> 'a) \<Rightarrow> real" and + l :: real + assumes + zero_le_disc [simp]: "0 \<le> l" and + disc_lt_one [simp]: "l < 1" and + r_bounded: "bounded (range r)" +begin + +text \<open> +This extension to the basic MDPs is formalized with another locale. +It assumes the existence of a reward function @{term r} which takes a state-action pair to a real +number. We assume that the function is bounded @{prop r_bounded}. + +Furthermore, we fix a discounting factor @{term l}, where @{term "0 \<le> l \<and> l < 1"}. +\<close> + + +subsection \<open>Basic Properties\<close> +lemma r_bfun: "r \<in> bfun" + using r_bounded + by auto + +lemma r_bounded': "bounded (r ` X)" + by (auto intro: r_bounded bounded_subset) + +lemma abs_disc_eq[simp]: "\<bar>l ^ i * x\<bar> = l ^ i * \<bar>x\<bar>" + by (auto simp: abs_mult) + +definition "r\<^sub>M = (\<Squnion>sa. \<bar>r sa\<bar>)" + +lemma abs_r_le_r\<^sub>M: "\<bar>r sa\<bar> \<le> r\<^sub>M" + using bounded_norm_le_SUP_norm r_bounded r\<^sub>M_def + by fastforce + +lemma abs_r\<^sub>M_eq_r\<^sub>M [simp]: "\<bar>r\<^sub>M\<bar> = r\<^sub>M" + using abs_r_le_r\<^sub>M + by fastforce + +lemma r\<^sub>M_nonneg: "0 \<le> r\<^sub>M" + using abs_r\<^sub>M_eq_r\<^sub>M + by linarith + +subsection \<open>Summability\<close> +lemma summable_disc [intro, simp]: "summable (\<lambda>i. l ^ i * x)" + by (simp add: mult.commute) + +lemma summable_r_disc[intro, simp]: + "summable (\<lambda>i. \<bar>l ^ i * r (sa i)\<bar>)" + "summable (\<lambda>i. l ^ i * \<bar>r (sa i)\<bar>)" + "summable (\<lambda>i. l ^ i * r (sa i))" +proof - + show "summable (\<lambda>i. \<bar>l ^ i * r (sa i)\<bar>)" + using abs_r_le_r\<^sub>M + by (fastforce intro!: mult_left_mono summable_comparison_test'[OF summable_disc]) + thus "summable (\<lambda>i. l ^ i * r (sa i))" "summable (\<lambda>i. l ^ i * \<bar>r (sa i)\<bar>)" + by (auto intro: summable_rabs_cancel) +qed + +subsection \<open>Reward over a Trace\<close> +abbreviation "\<nu>_trace_fin t N \<equiv> \<Sum>i < N. l ^ i * r (t !! i)" +abbreviation "\<nu>_trace t \<equiv> \<Sum>i. l ^ i * r (t !! i)" + +lemma abs_\<nu>_trace_le: "\<bar>\<nu>_trace t\<bar> \<le> (\<Sum>i. l ^ i * r\<^sub>M)" +proof - + have "(\<Sum>i. l ^ i * \<bar>r (t !! i)\<bar>) \<le> (\<Sum>i. l ^ i * r\<^sub>M)" + by (auto simp: mult_left_mono abs_r_le_r\<^sub>M intro: suminf_le) + thus ?thesis + by (auto intro!: order_trans[OF summable_rabs]) +qed + +lemma abs_\<nu>_trace_fin_le: "\<bar>\<nu>_trace_fin t N\<bar> \<le> (\<Sum>i < N. l^i * r\<^sub>M)" +proof - + have "\<bar>\<nu>_trace_fin t N\<bar> \<le> (\<Sum>i < N. \<bar>l ^ i * r (t !! i)\<bar>)" + by blast + also have "\<dots> \<le> (\<Sum>i < N. l ^ i * r\<^sub>M)" + by (auto intro: sum_mono simp: mult_left_mono abs_r_le_r\<^sub>M) + finally show ?thesis . +qed + +lemma measurable_suminf_reward [measurable]: "\<nu>_trace \<in> borel_measurable S" + by measurable + +lemma integrable_\<nu>_trace_fin: "integrable (\<T> p s) (\<lambda>t. \<nu>_trace_fin t N)" + by (fastforce simp: bounded_iff intro: abs_\<nu>_trace_fin_le) + +lemma integrable_\<nu>_trace: "integrable (\<T> p s) \<nu>_trace" + by (fastforce simp: bounded_iff intro: abs_\<nu>_trace_le) + +subsection \<open>Integrals over Rewards\<close> +lemma measurable_r_nth [measurable]: "(\<lambda>t. r (t !! i)) \<in> borel_measurable S" + by measurable + +lemma integrable_r_nth [simp]: "integrable (\<T> p s) (\<lambda>t. r (t !! i))" + by (fastforce simp: bounded_iff intro: abs_r_le_r\<^sub>M) + +lemma expectation_abs_r_le: "measure_pmf.expectation d (\<lambda>a. \<bar>r (s, a)\<bar>) \<le> r\<^sub>M" +proof - + have "integrable (measure_pmf P) (\<lambda>a. \<bar>r (s, a)\<bar>)" for P + using abs_r_le_r\<^sub>M + by (fastforce intro!: measure_pmf.integrable_const_bound) + thus ?thesis + by (auto simp: abs_r_le_r\<^sub>M intro: measure_pmf.integral_le_const) +qed + +subsection \<open>Expected Total Discounted Reward\<close> +context + fixes p :: "('s, 'a) pol" +begin + +subsection \<open>Expected Finite-Horizon Discounted Reward\<close> +definition "\<nu>_fin n s = \<integral>t. \<nu>_trace_fin t n \<partial>\<T> p s" + +lemma abs_\<nu>_fin_le: "\<bar>\<nu>_fin N s\<bar> \<le> (\<Sum>i<N. l^i * r\<^sub>M)" + unfolding \<nu>_fin_def + using abs_\<nu>_trace_fin_le + by (fastforce intro!: prob_space.integral_le_const order_trans[OF integral_abs_bound]) + +lemma \<nu>_fin_Suc[simp]: "\<nu>_fin (Suc n) s = \<nu>_fin n s + l ^ n * \<integral>t. r (t !! n) \<partial>\<T> p s" + by (simp add: \<nu>_fin_def) + +lemma \<nu>_fin_zero[simp]: "\<nu>_fin 0 s = 0" + by (simp add: \<nu>_fin_def) + +lemma \<nu>_fin_eq_Pn: "\<nu>_fin n s = (\<Sum>i<n. l^i * measure_pmf.expectation (Pn' p s i) r)" + by (induction n; simp add: Pn'_eq_\<T> integral_distr) + +definition "\<nu> s = lim (\<lambda>n. \<nu>_fin n s)" + +lemma \<nu>_eq_lim: "\<nu> s = lim (\<lambda>n. \<nu>_fin n s)" + using \<nu>_def. + +lemma \<nu>_eq_\<nu>_trace: "\<nu> s = \<integral>t. \<nu>_trace t \<partial>\<T> p s" +proof - + have "(\<lambda>n. \<nu>_fin n s) \<longlonglongrightarrow> \<integral>t. \<nu>_trace t \<partial>\<T> p s" + unfolding \<nu>_fin_def + proof(intro integral_dominated_convergence) + show "AE x in \<T> p s. \<nu>_trace_fin x \<longlonglongrightarrow> \<nu>_trace x" + using summable_LIMSEQ + by blast + next + have "(\<Sum>i<N. l ^ i * r\<^sub>M) \<le> (\<Sum>N. l ^ N * r\<^sub>M)" for N + by (auto intro: sum_le_suminf simp: r\<^sub>M_nonneg) + thus "AE x in \<T> p s. norm (\<nu>_trace_fin x N) \<le> (\<Sum>N. l ^ N * r\<^sub>M)" for N + using abs_\<nu>_trace_fin_le order_trans + by fastforce + qed auto + thus ?thesis + using \<nu>_eq_lim limI by fastforce +qed + +lemma abs_\<nu>_le: "\<bar>\<nu> s\<bar> \<le> (\<Sum>i. l^i * r\<^sub>M)" + using abs_\<nu>_trace_le \<nu>_eq_\<nu>_trace integrable_\<nu>_trace + by (auto intro!: prob_space.integral_le_const order_trans[OF integral_abs_bound]) + +lemma \<nu>_le: "\<nu> s \<le> (\<Sum>i. l^i * r\<^sub>M)" + by (auto intro: abs_\<nu>_le abs_le_D1) + +lemma \<nu>_eq_Pn: "\<nu> s = (\<Sum>i. l^i * measure_pmf.expectation (Pn' p s i) r)" + by (simp add: \<nu>_fin_eq_Pn \<nu>_eq_lim suminf_eq_lim) + +(* 6.1.2 in Puterman *) +lemma \<nu>_bfun: "\<nu> \<in> bfun" + by (auto intro!: abs_\<nu>_le) + +lemma \<nu>_fin_bfun: "(\<lambda>s. \<nu>_fin N s) \<in> bfun" + by (auto intro!: abs_\<nu>_fin_le) + +lift_definition \<nu>\<^sub>b :: "'s \<Rightarrow>\<^sub>b real" is \<nu> + using \<nu>_bfun . + +lemma norm_\<nu>_le: "norm \<nu>\<^sub>b \<le> r\<^sub>M / (1-l)" + using abs_\<nu>_le sum_disc_lim + by (auto simp: \<nu>\<^sub>b.rep_eq norm_bfun_def' intro: cSUP_least) +end + +lemma \<nu>_as_markovian: "\<nu> (mk_markovian (as_markovian p (return_pmf s))) s = \<nu> p s" + by (auto simp: \<nu>_eq_Pn Pn_as_markovian_eq Pn'_def) + +subsubsection \<open>Optimal Reward\<close> +definition "\<nu>_MD s \<equiv> \<Squnion>p \<in> \<Pi>\<^sub>M\<^sub>D. \<nu> (mk_markovian_det p) s" +definition "\<nu>_opt s \<equiv> \<Squnion>p \<in> \<Pi>\<^sub>H\<^sub>R. \<nu> p s" + +lemma \<nu>_le_\<nu>_opt [intro]: + assumes "is_policy p" + shows "\<nu> p s \<le> \<nu>_opt s" + unfolding \<nu>_opt_def + using abs_\<nu>_le assms + by (force intro: cSUP_upper intro!: bounded_imp_bdd_above boundedI) + +lemma \<nu>_opt_eq_MR: "\<nu>_opt s = (\<Squnion>p \<in> \<Pi>\<^sub>M\<^sub>R. \<nu> (mk_markovian p) s)" +proof (rule antisym) + show "\<nu>_opt s \<le> (\<Squnion>p\<in>\<Pi>\<^sub>M\<^sub>R. \<nu> (mk_markovian p) s)" + unfolding \<nu>_opt_def + proof (rule cSUP_mono) + show "\<Pi>\<^sub>H\<^sub>R \<noteq> {}" + using policies_ne by simp + show "bdd_above ((\<lambda>p. \<nu> (mk_markovian p) s) ` \<Pi>\<^sub>M\<^sub>R)" + by (auto intro!: boundedI bounded_imp_bdd_above abs_\<nu>_le) + show "n \<in> \<Pi>\<^sub>H\<^sub>R \<Longrightarrow> \<exists>m\<in>\<Pi>\<^sub>M\<^sub>R. \<nu> n s \<le> \<nu> (mk_markovian m) s" for n + using is_\<Pi>\<^sub>M\<^sub>R_as_markovian order_refl mem_Collect_eq \<nu>_as_markovian + by (subst \<nu>_as_markovian[symmetric]; blast) + qed + show "(\<Squnion>p\<in>\<Pi>\<^sub>M\<^sub>R. \<nu> (mk_markovian p) s) \<le> \<nu>_opt s" + using \<Pi>\<^sub>M\<^sub>R_ne \<Pi>\<^sub>M\<^sub>R_imp_policies + by (auto intro!: cSUP_least) +qed + +lemma \<nu>_opt_bfun: "\<nu>_opt \<in> bfun" + unfolding \<nu>_opt_def + using abs_\<nu>_le policies_ne + by (fastforce intro!: order_trans[OF cSup_abs_le] bfun_normI) + +lift_definition \<nu>\<^sub>b_opt :: "'s \<Rightarrow>\<^sub>b real" is \<nu>_opt + using \<nu>_opt_bfun . + +subsection \<open>Reward of a Decision Rule\<close> +context + fixes d :: "('s, 'a) dec" +begin +abbreviation "r_dec s \<equiv> \<integral>a. r (s, a) \<partial>d s" + +lemma abs_r_dec_le: "\<bar>r_dec s\<bar> \<le> r\<^sub>M" + using expectation_abs_r_le integral_abs_bound order_trans + by fast + +lemma r_dec_eq_r_K0: "r_dec s = measure_pmf.expectation (K0' d s) r" + by (simp add: K0'_def) + +lemma r_dec_bfun: "r_dec \<in> bfun" + using abs_r_dec_le + by (fastforce intro!: bfun_normI) + +lift_definition r_dec\<^sub>b :: "'s \<Rightarrow>\<^sub>b real" is "r_dec" + using r_dec_bfun . + +lemma norm_r_dec_le: "norm r_dec\<^sub>b \<le> r\<^sub>M" + by (simp add: abs_r_dec_le norm_bound r_dec\<^sub>b.rep_eq) +end + +lemma r_dec_det [simp]: "r_dec (mk_dec_det d) s = r (s, d s)" + unfolding mk_dec_det_def + by auto + + +declare r_dec\<^sub>b.rep_eq[simp] bfun.Bfun_inverse[simp] + + +subsection \<open>Push-Forward of a Function Through the MDP\<close> + + +lemma norm_l_pow_eq[simp]: "norm (l^t *\<^sub>R F) = l^t * norm F" + by auto + +lemma summable_norm_disc_I [intro]: + assumes "summable (\<lambda>t. (l^t * norm F))" + shows "summable (\<lambda>t. norm (l^t *\<^sub>R F))" + using assms by auto + +lemma summable_norm_disc_I'[intro]: + assumes "summable (\<lambda>t. (l^t * norm (F t)))" + shows "summable (\<lambda>t. norm (l^t *\<^sub>R F t))" + using assms by auto + +lemma summable_discI [intro]: + assumes "bounded (range F)" + shows "summable (\<lambda>t. l^t * norm (F t))" +proof - + obtain b where "norm (F x) \<le> b" for x + using assms + by (auto simp: bounded_iff) + thus ?thesis + using Abel_lemma[of l 1 F b] + by (auto simp: mult.commute) +qed + +lemma summable_disc_reward [intro]: + assumes "bounded (range (F :: nat \<Rightarrow> 'b :: banach))" + shows "summable (\<lambda>t. l^t *\<^sub>R (F t))" + using assms + by (auto intro: summable_norm_cancel) + +context + fixes p :: "nat \<Rightarrow> ('s, 'a) dec" +begin +definition "\\<^sub>X n = push_exp (\<lambda>s. Xn' (mk_markovian p) s n)" + +lemma \\<^sub>X_0[simp]: "\\<^sub>X 0 = id" + by (simp add: \\<^sub>X_def) + +lemma \\<^sub>X_bounded_linear[simp]: "bounded_linear (\\<^sub>X t)" + unfolding \\<^sub>X_def by simp + +lemma norm_\\<^sub>X [simp]: "onorm (\\<^sub>X t) = 1" + unfolding \\<^sub>X_def by simp + +lemma norm_\\<^sub>X_apply[simp]: "norm (\\<^sub>X n x) \<le> norm x" + using onorm[OF \\<^sub>X_bounded_linear] + by simp + +lemma \\<^sub>X_bound_r: "norm (\\<^sub>X t (r_dec\<^sub>b (p t))) \<le> r\<^sub>M" + using norm_\\<^sub>X_apply norm_r_dec_le order.trans + by blast + +lemma \\<^sub>X_bounded_r: "bounded (range (\<lambda>t. (\\<^sub>X t (r_dec\<^sub>b (p t)))))" + using \\<^sub>X_bound_r + by (auto intro!: boundedI) + +lemma summable_norm_disc_reward'[simp]: + shows "summable (\<lambda>t. l^t * norm (\\<^sub>X t (r_dec\<^sub>b (p t))))" + using \\<^sub>X_bounded_r by auto + +lemma summable_disc_reward_\\<^sub>X [simp]: + shows "summable (\<lambda>t. l^t *\<^sub>R \\<^sub>X t (r_dec\<^sub>b (p t)))" + using summable_disc_reward \\<^sub>X_bounded_r + by blast + +lemma disc_reward_tendsto: + "(\<lambda>n. \<Sum>t<n. l^t *\<^sub>R \\<^sub>X t (r_dec\<^sub>b (p t))) \<longlonglongrightarrow> (\<Sum>t. l^t *\<^sub>R \\<^sub>X t (r_dec\<^sub>b (p t)))" + by (simp add: summable_LIMSEQ) + + +end + +lemma \\<^sub>X_Suc: "\\<^sub>X p (Suc n) v = push_exp (K_st (p 0)) ((\\<^sub>X (\<lambda>n. p (Suc n)) n) v)" + unfolding \\<^sub>X_def + by (fastforce intro!: abs_le_norm_bfun integral_bind[where K = "count_space UNIV"] + simp: measure_pmf_in_subprob_algebra measure_pmf_bind Suc_Xn'_markovian) + +lemma \\<^sub>X_Suc': "\\<^sub>X p (Suc n) v = \\<^sub>X p n (push_exp (K_st (p n)) v)" +proof (induction n arbitrary: p) + case 0 + thus ?case + by (simp add: \\<^sub>X_Suc) +next + case (Suc n) + thus ?case + by (metis \\<^sub>X_Suc) +qed + +lemma \\<^sub>X_sconst: "\\<^sub>X (\<lambda>_. p) n = (push_exp (K_st p))^^n" + by (induction n) (auto simp: \\<^sub>X_Suc' funpow_swap1) + +lemma norm_P_n[simp]: "onorm (push_exp (K_st p) ^^ n) = 1" + using norm_\\<^sub>X[of "\<lambda>_. p"] by (auto simp: \\<^sub>X_sconst) + +lemma summable_norm_bfun_disc: "summable (\<lambda>t. l^t * norm (apply_bfun f t))" + using norm_le_norm_bfun + by (auto simp: mult.commute[of "l^_"] intro!: Abel_lemma[of _ 1 _ "norm f"]) + +lemma summable_bfun_disc [simp]: "summable (\<lambda>t. l^t * (apply_bfun f t))" +proof - + have "norm (l^t * apply_bfun f t) = l^t * norm (apply_bfun f t)" for t + by (auto simp: abs_mult) + hence "summable (\<lambda>t. norm (l^t * (apply_bfun f t)))" + by (auto simp only: abs_mult) + thus ?thesis + by (auto intro: summable_norm_cancel) +qed + +lemma summable_disc_norm: "summable (\<lambda>x. l^x * norm c)" + using summable_disc. + +lemma norm_bfun_disc_le: "norm f \<le> B \<Longrightarrow> (\<Sum>x. l^x * norm (apply_bfun f x)) \<le> (\<Sum>x. l^x * B)" + by (fastforce intro!: suminf_le mult_left_mono norm_le_norm_bfun intro: order.trans) + +lemma norm_bfun_disc_le': "norm f \<le> B \<Longrightarrow> (\<Sum>x. l^x * (apply_bfun f x)) \<le> (\<Sum>x. l^x * B)" + by (auto simp: mult_left_mono intro!: suminf_le order.trans[OF _ norm_bfun_disc_le]) + +lemma sum_disc_lim_l: "(\<Sum>x. l^x * B) = B /(1-l)" + by (simp add: suminf_mult2[symmetric] summable_geometric suminf_geometric[of l]) + +lemma sum_disc_bound: "(\<Sum>x. l^x * apply_bfun f x) \<le> (norm f) /(1-l)" + using norm_bfun_disc_le' sum_disc_lim + by auto + +lemma sum_disc_bound': + fixes f :: "nat \<Rightarrow> 'b \<Rightarrow>\<^sub>b real" + assumes h: "\<forall>n. norm (f n) \<le> B" + shows "norm (\<Sum>x. l^x *\<^sub>R f x) \<le> B /(1-l)" +proof - + have "norm (\<Sum>x. l^x *\<^sub>R f x) \<le> (\<Sum>x. norm (l^x *\<^sub>R f x))" + using h + by (fastforce intro!: boundedI summable_norm) + also have "\<dots> \<le> (\<Sum>x. l^x * B)" + using h + by (auto intro!: suminf_le boundedI simp: mult_mono') + also have "\<dots> = B /(1-l)" + by (simp add: sum_disc_lim) + finally show "norm (\<Sum>x. l^x *\<^sub>R f x) \<le> B /(1-l)" . +qed + +lemma \<nu>\<^sub>b_le_opt [intro]: "p \<in> \<Pi>\<^sub>H\<^sub>R \<Longrightarrow> \<nu>\<^sub>b p \<le> \<nu>\<^sub>b_opt" + using \<nu>_le + by (fastforce simp: \<nu>\<^sub>b.rep_eq \<nu>\<^sub>b_opt.rep_eq) + +lemma \<nu>\<^sub>b_le_opt_MD [intro]: "p \<in> \<Pi>\<^sub>M\<^sub>D \<Longrightarrow> \<nu>\<^sub>b (mk_markovian_det p) \<le> \<nu>\<^sub>b_opt" + by (auto simp: mk_markovian_det_def is_dec_det_def is_dec_def is_policy_def) + +lemma \<nu>\<^sub>b_le_opt_DD [intro]: "is_dec_det d \<Longrightarrow> \<nu>\<^sub>b (mk_stationary_det d) \<le> \<nu>\<^sub>b_opt" + by (auto simp add: is_policy_def mk_markovian_def) + +lemma \<nu>\<^sub>b_le_opt_DR [intro]: "is_dec d \<Longrightarrow> \<nu>\<^sub>b (mk_stationary d) \<le> \<nu>\<^sub>b_opt" + by (auto simp add: is_policy_def mk_markovian_def) + +lemma \<nu>\<^sub>b_opt_eq_MR: "\<nu>\<^sub>b_opt s = (\<Squnion>p \<in> \<Pi>\<^sub>M\<^sub>R. \<nu>\<^sub>b (mk_markovian p) s)" + by (auto simp: \<nu>_opt_eq_MR \<nu>\<^sub>b.rep_eq \<nu>\<^sub>b_opt.rep_eq) + +lemma \<nu>\<^sub>b_as_markovian: "\<nu>\<^sub>b (mk_markovian (as_markovian p (return_pmf s))) s = \<nu>\<^sub>b p s" + using \<nu>_as_markovian + by (auto simp: \<nu>\<^sub>b.rep_eq) + +lemma \<nu>_elem: "\<nu> (mk_markovian p) s = (\<Sum>i. l^i * \\<^sub>X p i (r_dec\<^sub>b (p i)) s)" + unfolding \<nu>\<^sub>b.rep_eq \\<^sub>X_def \<nu>_eq_Pn Pn'_markovian_eq_Xn'_bind measure_pmf_bind + using measure_pmf_in_subprob_algebra abs_r_le_r\<^sub>M + by (subst integral_bind) (auto simp: r_dec_eq_r_K0) + +lemma \<nu>\<^sub>b_eq_\\<^sub>X: "\<nu>\<^sub>b (mk_markovian p) = (\<Sum>i. l^i *\<^sub>R \\<^sub>X p i (r_dec\<^sub>b (p i)))" + by (auto simp: \<nu>_elem \<nu>\<^sub>b.rep_eq suminf_apply_bfun) + +lemma \<nu>_eq_\\<^sub>X: "\<nu> (mk_markovian p) = (\<Sum>i. l^i *\<^sub>R \\<^sub>X p i (r_dec\<^sub>b (p i)))" + by (metis \<nu>\<^sub>b.rep_eq \<nu>\<^sub>b_eq_\\<^sub>X) + +text \<open> +@{term "\\<^sub>1 d v"} defines for each state the expected value of @{term v} +after taking a single step in the MDP according to the decision rule @{term d}. +\<close> + +context + fixes d :: "('s, 'a) dec" +begin +lift_definition \\<^sub>1 :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('s \<Rightarrow>\<^sub>b real)" is "push_exp (K_st d)" + using push_exp_bounded_linear . + +lemma \\<^sub>1_pow: "blinfun_apply (\\<^sub>1 ^^ n) = blinfun_apply \\<^sub>1 ^^ n" + by (induction n) auto + +lemma \\<^sub>X_const: "\\<^sub>X (\<lambda>_. d) n = \\<^sub>1 ^^ n" + by (simp add: \\<^sub>1.rep_eq \\<^sub>1_pow \\<^sub>X_sconst) + +lemma norm_\\<^sub>1 [simp]: "norm \\<^sub>1 = 1" + by (simp add: norm_blinfun.rep_eq \\<^sub>1.rep_eq) + +lemma norm_\\<^sub>1_pow [simp]: "norm (\\<^sub>1 ^^ t) = 1" + by (simp add: \\<^sub>1_pow norm_blinfun.rep_eq \\<^sub>1.rep_eq) + +lemma norm_\\<^sub>1_l_less: "norm (l *\<^sub>R \\<^sub>1) < 1" + by auto + +lemma \\<^sub>1_pos: "0 \<le> u \<Longrightarrow> 0 \<le> \\<^sub>1 u" + by (auto simp: \\<^sub>1.rep_eq less_eq_bfun_def) + +lemma \\<^sub>1_n_pos: "0 \<le> u \<Longrightarrow> 0 \<le> (\\<^sub>1 ^^ n) u" + by (induction n) (auto simp: \\<^sub>1.rep_eq less_eq_bfun_def) + +lemma \\<^sub>1_n_disc_pos: "0 \<le> u \<Longrightarrow> 0 \<le> (l^n *\<^sub>R \\<^sub>1 ^^n) u" + by (auto simp: \\<^sub>1_n_pos scaleR_nonneg_nonneg blinfun.scaleR_left) + +lemma \\<^sub>1_sum_pos: "0 \<le> u \<Longrightarrow> 0 \<le> (\<Sum>t\<le>n. l^t *\<^sub>R (\\<^sub>1 ^^ t)) u" + using \\<^sub>1_n_pos \\<^sub>1_pos + by (induction n) (auto simp: blinfun.add_left blinfun.scaleR_left scaleR_nonneg_nonneg) + +lemma \\<^sub>1_sum_ge: + assumes "0 \<le> u" + shows "u \<le> (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^t) u" + using \\<^sub>1_n_disc_pos[OF assms, of "Suc _"] + by (induction n) (auto intro: add_increasing2 simp add: blinfun.add_left) + +lemma disc_\\<^sub>1_tendsto: "(\<lambda>n. (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^t)) \<longlonglongrightarrow> (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t)" + by (fastforce simp: bounded_iff intro: summable_LIMSEQ') + +lemma disc_\\<^sub>1_lim: "lim (\<lambda>n. (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^ t)) = (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t)" + using limI disc_\\<^sub>1_tendsto + by blast + +lemma convergent_disc_\\<^sub>1: "convergent (\<lambda>n. (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^t))" + using convergentI disc_\\<^sub>1_tendsto + by blast + +lemma \\<^sub>1_suminf_ge: + assumes "0 \<le> u" shows "u \<le> (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t) u" +proof - + have aux: "\<And>x. (\<lambda>n. (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^t) u x) \<longlonglongrightarrow> (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t) u x" + using bfun_tendsto_apply_bfun disc_\\<^sub>1_lim lim_blinfun_apply[OF convergent_disc_\\<^sub>1] + by fastforce + have "\<And>n. u \<le> (\<Sum>t\<le>n. l^t *\<^sub>R \\<^sub>1 ^^t) u" + using \\<^sub>1_sum_ge[OF assms] + by auto + thus ?thesis + by (auto intro!: LIMSEQ_le_const[OF aux]) +qed + +lemma \\<^sub>1_suminf_pos: + assumes "0 \<le> u" + shows "0 \<le> (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t) u" + using \\<^sub>1_suminf_ge[of u] assms + by auto + +lemma lemma_6_1_2_b: + assumes "v \<le> u" + shows "(\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t) v \<le> (\<Sum>t. l^t *\<^sub>R \\<^sub>1 ^^t) u" +proof - + have "0 \<le> (\<Sum>n. l ^ n *\<^sub>R \\<^sub>1 ^^ n) (u - v)" + using \\<^sub>1_suminf_pos assms + by simp + thus ?thesis + by (simp add: blinfun.diff_right) +qed + +subsection \<open>The Bellman Operator @{term L}\<close> +definition "L v \<equiv> r_dec\<^sub>b d + l *\<^sub>R \\<^sub>1 v" + +lemma norm_L_le: "norm (L v) \<le> r\<^sub>M + l * norm v" + using norm_blinfun[of "\\<^sub>1"] norm_\\<^sub>1 norm_r_dec_le + by (auto intro!: norm_add_rule_thm mult_left_mono simp: L_def) + +lemma abs_L_le: "\<bar>L v s\<bar> \<le> r\<^sub>M + l * norm v" + using order.trans[OF norm_le_norm_bfun norm_L_le] + by auto + + + +lemma \<nu>_stationary: "\<nu>\<^sub>b (mk_stationary d) = (\<Sum>t. l^t *\<^sub>R (\\<^sub>1 ^^ t)) (r_dec\<^sub>b d)" +proof - + have "\<nu>\<^sub>b (mk_stationary d) = (\<Sum>t. (l ^ t *\<^sub>R (\\<^sub>1 ^^ t)) (r_dec\<^sub>b d))" + by (simp add: \<nu>\<^sub>b_eq_\\<^sub>X \\<^sub>1_pow \\<^sub>1.rep_eq scaleR_blinfun.rep_eq \\<^sub>X_sconst) + also have "... = (\<Sum>t. (l ^ t *\<^sub>R (\\<^sub>1 ^^ t))) (r_dec\<^sub>b d)" + by (subst bounded_linear.suminf[where f = "\<lambda>x. blinfun_apply x (r_dec\<^sub>b d)"]) + (auto intro!: bounded_linear.suminf boundedI) + finally show ?thesis . +qed +end + +lemma \\<^sub>1_eq_\\<^sub>X_one: "blinfun_apply (\\<^sub>1 (p 0)) = \\<^sub>X p 1" + by (auto simp: \\<^sub>X_Suc' \\<^sub>1.rep_eq) + +text \<open>The value of a markovian policy can be expressed in terms of @{const L}.\<close> + +lemma \<nu>_step: "\<nu>\<^sub>b (mk_markovian p) = L (p 0) (\<nu>\<^sub>b (mk_markovian (\<lambda>n. p (Suc n))))" +proof - + have s: "summable (\<lambda>t. l^t *\<^sub>R (\\<^sub>X p (Suc t) (r_dec\<^sub>b (p (Suc t)))))" + using \\<^sub>X_bound_r + by (auto intro!: boundedI[of _ r\<^sub>M]) + have + "\<nu>\<^sub>b (mk_markovian p) = r_dec\<^sub>b (p 0) + (\<Sum>t. l^(Suc t) *\<^sub>R \\<^sub>X p (Suc t) (r_dec\<^sub>b (p (Suc t))))" + by (subst suminf_split_head) (auto simp: \<nu>\<^sub>b_eq_\\<^sub>X) + also have + "\<dots> = r_dec\<^sub>b (p 0) + l *\<^sub>R (\<Sum>t. \\<^sub>1 (p 0) (l^t *\<^sub>R \\<^sub>X (\<lambda>n. p (Suc n)) t (r_dec\<^sub>b (p (Suc t)))))" + using suminf_scaleR_right[OF s] + by (auto simp: \\<^sub>X_Suc \\<^sub>1.rep_eq linear_simps) + also have + "\<dots> = L (p 0) (\<nu>\<^sub>b (mk_markovian (\<lambda>n. p (Suc n))))" + by (simp add: \<nu>\<^sub>b_eq_\\<^sub>X L_def \\<^sub>1.rep_eq bounded_linear.suminf) + finally show ?thesis . +qed + + +lemma L_\<nu>_fix: "\<nu>\<^sub>b (mk_stationary d) = L d (\<nu>\<^sub>b (mk_stationary d))" + using \<nu>_step . + +lemma L_fix_\<nu>: + assumes "L p v = v" + shows "v = \<nu>\<^sub>b (mk_stationary p)" +proof - + have "r_dec\<^sub>b p = (id_blinfun - l *\<^sub>R \\<^sub>1 p) v" + using assms + by (auto simp: eq_diff_eq L_def blinfun.diff_left blinfun.scaleR_left) + hence "v = (\<Sum>t. (l *\<^sub>R \\<^sub>1 p)^^t) (r_dec\<^sub>b p)" + using inv_norm_le'(2)[OF norm_\\<^sub>1_l_less] + by auto + thus "v = \<nu>\<^sub>b (mk_stationary p)" + by (auto simp: \<nu>_stationary blincomp_scaleR_right) +qed + +lemma L_\<nu>_fix_iff: "L d v = v \<longleftrightarrow> v = \<nu>\<^sub>b (mk_stationary d)" + using L_fix_\<nu> L_\<nu>_fix + by auto + + +lemma apply_bfun_bounded_above [simp, intro]: + fixes f :: "'c \<Rightarrow>\<^sub>b real" + shows "bounded (f ` X)" + using norm_le_norm_bfun + by (fastforce intro: boundedI) + +lemma apply_bfun_bdd_above[simp, intro]: + fixes f :: "'c \<Rightarrow>\<^sub>b real" + shows "bdd_above (f ` X)" + by (auto intro: bounded_imp_bdd_above) + +lemma L_bounded[simp, intro]: "bounded (range (\<lambda>p. L p v s))" + using abs_L_le + by (auto intro!: boundedI) + +lemma L_bounded'[simp, intro]: "bounded ((\<lambda>p. L p v s) ` X)" + by (auto intro: bounded_subset[OF L_bounded]) + +lemma L_bdd_above[simp, intro]: "bdd_above ((\<lambda>p. L p v s) ` X)" + by (auto intro: bounded_imp_bdd_above) + + +subsection \<open>Optimality Equations\<close> + +definition "\<L> (v :: 's \<Rightarrow>\<^sub>b real) s = (\<Squnion>d \<in> D\<^sub>R. L d v s)" + + +lemma \<L>_bfun: "\<L> v \<in> bfun" + unfolding \<L>_def + using abs_L_le ex_dec + by (fastforce intro!: cSup_abs_le bfun_normI) + +lift_definition \<L>\<^sub>b :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> 's \<Rightarrow>\<^sub>b real" is \<L> + using \<L>_bfun . + +lemma L_le_\<L>\<^sub>b: "is_dec d \<Longrightarrow> L d v \<le> \<L>\<^sub>b v" + by (fastforce simp: \<L>\<^sub>b.rep_eq \<L>_def intro!: cSUP_upper) + +subsection \<open>Monotonicity\<close> + +lemma \\<^sub>1_mono[intro]: "a \<le> b \<Longrightarrow> \\<^sub>1 p a \<le> \\<^sub>1 p b" + using \\<^sub>1_pos[of "b - a"] + by (auto simp: blinfun.diff_right) + +lemma \\<^sub>X_mono[intro]: "a \<le> b \<Longrightarrow> \\<^sub>X p n a \<le> \\<^sub>X p n b" + by (fastforce simp: \\<^sub>X_def intro: integral_mono) + +lemma L_mono: "u \<le> v \<Longrightarrow> L d u \<le> L d v" + unfolding L_def + by (auto intro: scaleR_left_mono) + +lemma \<L>\<^sub>b_mono: + assumes "u \<le> v" shows "\<L>\<^sub>b u \<le> \<L>\<^sub>b v" + using L_mono[OF assms] ex_dec + by (fastforce intro!: cSUP_mono simp: \<L>\<^sub>b.rep_eq \<L>_def) + +lemma step_mono: + assumes "\<L>\<^sub>b v \<le> v" "d \<in> D\<^sub>R" + shows "L d v \<le> v" + using assms L_le_\<L>\<^sub>b order.trans + by blast + +lemma step_mono_elem: + assumes "v \<le> \<L>\<^sub>b v" "e > 0" + shows "\<exists>d\<in>D\<^sub>R. v \<le> L d v + e *\<^sub>R 1" +proof - + have "v s \<le> (\<Squnion>p\<in>D\<^sub>R. L p v s)" for s + using assms + by (auto simp: \<L>\<^sub>b.rep_eq \<L>_def) + hence "\<exists>d \<in> D\<^sub>R. v s - e < L d v s" for s + by (subst less_cSUP_iff[symmetric], auto simp: assms add_strict_increasing algebra_simps) + hence aux: "\<exists>d. d \<in> D\<^sub>R \<and> v s < L d v s + e" for s + by (simp add: diff_less_eq) + have "\<exists>d\<in>D\<^sub>R. \<forall>s. v s < L d v s + e" + proof - + let ?d = "\<lambda>s. (SOME d. d \<in> D\<^sub>R \<and> v s < L d v s + e) s" + have "?d s \<subseteq> A s" "v s < L ?d v s + e" for s + using someI_ex[OF aux] + by (auto simp: is_dec_def L_def \\<^sub>1.rep_eq K_st_def) + thus "\<exists>d\<in>D\<^sub>R. \<forall>s. v s < L d v s + e" + using is_dec_def + by blast + qed + thus ?thesis + by (fastforce intro: less_imp_le) +qed + + +lemma p_n_\<pi>_MD[intro]: "p \<in> \<Pi>\<^sub>M\<^sub>D \<Longrightarrow> p n \<in> D\<^sub>D" + by auto + +lemma p_n_\<pi>_MR[intro]: "p \<in> \<Pi>\<^sub>M\<^sub>R \<Longrightarrow> p n \<in> D\<^sub>R" + by auto + +lemma \\<^sub>X_Suc_n_elem: "\\<^sub>X p n (\\<^sub>1 (p n) v) = \\<^sub>X p (Suc n) v" + using \\<^sub>X_Suc' \\<^sub>1.rep_eq + by auto + +lift_definition \<nu>\<^sub>b_fin :: "('s, 'a) pol \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow>\<^sub>b real" is \<nu>_fin + using \<nu>_fin_bfun . + +lemma \<nu>_fin_elem: "\<nu>_fin (mk_markovian p) n s = (\<Sum>i<n. l^i * \\<^sub>X p i (r_dec\<^sub>b (p i)) s)" + unfolding \\<^sub>X_def \<nu>_fin_eq_Pn Pn'_markovian_eq_Xn'_bind measure_pmf_bind + using measure_pmf_in_subprob_algebra abs_r_le_r\<^sub>M + by (subst integral_bind) (auto simp: r_dec_eq_r_K0) + +lemma \<nu>\<^sub>b_fin_eq_\\<^sub>X: "\<nu>\<^sub>b_fin (mk_markovian p) n = (\<Sum>i<n. l^i *\<^sub>R \\<^sub>X p i (r_dec\<^sub>b (p i)))" + by (auto simp: \<nu>_fin_elem sum_apply_bfun \<nu>\<^sub>b_fin.rep_eq) + +lemma \<nu>_fin_eq_\\<^sub>X: "\<nu>_fin (mk_markovian p) n = (\<Sum>i<n. l^i *\<^sub>R \\<^sub>X p i (r_dec\<^sub>b (p i)))" + by (metis \<nu>\<^sub>b_fin.rep_eq \<nu>\<^sub>b_fin_eq_\\<^sub>X) + +abbreviation "\\<^sub>d p n v \<equiv> l^n *\<^sub>R \\<^sub>X p n v" + +lemma \\<^sub>X_L_le: + assumes "\<L>\<^sub>b v \<le> v" "p \<in> \<Pi>\<^sub>M\<^sub>R" + shows "\\<^sub>X p n (L (p n) v) \<le> \\<^sub>X p n v" + using assms step_mono + by auto + +lemma \<nu>\<^sub>b_fin_tendsto_\<nu>\<^sub>b: "(\<nu>\<^sub>b_fin (mk_markovian p)) \<longlonglongrightarrow> \<nu>\<^sub>b (mk_markovian p)" + using disc_reward_tendsto \<nu>\<^sub>b_eq_\\<^sub>X \<nu>\<^sub>b_fin_eq_\\<^sub>X + by presburger + +lemma \\<^sub>d_lim: "(\<lambda>n. (\\<^sub>d p n v)) \<longlonglongrightarrow> 0" +proof - + have "(\<lambda>n. l^n * norm v) \<longlonglongrightarrow> 0" + by (auto intro!: tendsto_eq_intros) + moreover have "norm (\\<^sub>d p n v) \<le> l^n * norm v" for p n + by (simp add: mult_mono') + ultimately have "(\<lambda>n. norm (\\<^sub>d p n v)) \<longlonglongrightarrow> 0" for p + by (auto simp: Lim_transform_bound[where g = "\<lambda>n. (l^n * norm v)"]) + thus "(\<lambda>n. (\\<^sub>d p n v)) \<longlonglongrightarrow> 0" for p + using tendsto_norm_zero_cancel + by fast +qed + +lemma \\<^sub>1_bfun_one [simp]:"\\<^sub>1 p 1 = 1" + by (auto simp: \\<^sub>1.rep_eq) + +lemma \\<^sub>1_pow_bfun_one [simp]: "((\\<^sub>1 p)^^t) 1 = 1" + by (induction t) auto + +subsection \<open>Properties of Solutions of the Optimality Equations\<close> + +(* 6.2.2 a) in Puterman *) +lemma \<L>_dec_ge_opt: + assumes "\<L>\<^sub>b v \<le> v" + shows "\<nu>\<^sub>b_opt \<le> v" +proof - + have "\<nu>\<^sub>b (mk_markovian p) \<le> v" if "p \<in> \<Pi>\<^sub>M\<^sub>R" for p + proof - + let ?p = "mk_markovian p" + have aux: "\<nu>\<^sub>b_fin ?p n + l^n *\<^sub>R \\<^sub>X p n v \<le> v" for n + proof (induction n) + case 0 + thus ?case + by (auto simp: \<nu>\<^sub>b_fin_eq_\\<^sub>X) + next + case (Suc n) + have "\\<^sub>X p n (r_dec\<^sub>b (p n)) + l *\<^sub>R (\\<^sub>X p (Suc n) v) \<le> \\<^sub>X p n v" + using \\<^sub>X_L_le assms that + by (simp add: \\<^sub>X_Suc_n_elem L_def linear_simps) + hence "\<nu>\<^sub>b_fin ?p (n + 1) + l^(n + 1) *\<^sub>R (\\<^sub>X p (n + 1) v) \<le> \<nu>\<^sub>b_fin ?p n + l^n *\<^sub>R (\\<^sub>X p n v)" + by (auto simp del: scaleR_scaleR intro: scaleR_left_mono simp: \<nu>\<^sub>b_fin_eq_\\<^sub>X + mult.commute[of l] scaleR_add_right[symmetric] scaleR_scaleR[symmetric]) + also have "\<dots> \<le> v" + using Suc.IH + by (auto simp: \<nu>\<^sub>b_fin_eq_\\<^sub>X) + finally show ?case + by auto + qed + have 1: "(\<lambda>n. (\<nu>\<^sub>b_fin ?p n + \\<^sub>d p n v) s) \<longlonglongrightarrow> \<nu>\<^sub>b ?p s" for s + using bfun_tendsto_apply_bfun Limits.tendsto_add[OF \<nu>\<^sub>b_fin_tendsto_\<nu>\<^sub>b \\<^sub>d_lim] + by fastforce + have "\<nu>\<^sub>b ?p s \<le> v s" for s + using that aux assms + by (fastforce intro!: lim_mono[OF _ 1, of _ _ "\<lambda>n. v s"]) + thus ?thesis + using that by blast + qed + thus ?thesis + using policies_ne + by (fastforce simp: is_policy_def \<nu>\<^sub>b_opt_eq_MR intro!: cSUP_least) +qed + +lemma \<L>_inc_le_opt: + assumes "v \<le> \<L>\<^sub>b v" + shows "v \<le> \<nu>\<^sub>b_opt" +proof - + have aux: "v s \<le> \<nu>\<^sub>b_opt s + (e/(1-l))" if "e > 0" for s e + proof - + obtain d where "d \<in> D\<^sub>R" and hd: "v \<le> L d v + e *\<^sub>R 1" + using assms step_mono_elem \<open>e > 0\<close> + by blast + + let ?Pinf = "(\<Sum>i. l^i *\<^sub>R \\<^sub>1 d^^i)" + have "v \<le> r_dec\<^sub>b d + l *\<^sub>R (\\<^sub>1 d) v + e *\<^sub>R 1" + using hd L_def + by fastforce + hence "(id_blinfun - l *\<^sub>R \\<^sub>1 d) v \<le> r_dec\<^sub>b d + e *\<^sub>R 1" + by (auto simp: blinfun.diff_left blinfun.scaleR_left algebra_simps) + hence "?Pinf ((id_blinfun - l *\<^sub>R \\<^sub>1 d) v) \<le> ?Pinf (r_dec\<^sub>b d + e *\<^sub>R 1)" + using lemma_6_1_2_b \\<^sub>1_def hd by auto + hence "v \<le> ?Pinf (r_dec\<^sub>b d + e *\<^sub>R 1)" + using inv_norm_le'(2)[of "l *\<^sub>R \\<^sub>1 d"] + by (auto simp: blincomp_scaleR_right) + also have "\<dots> = \<nu>\<^sub>b (mk_stationary d) + e *\<^sub>R ?Pinf 1" + by (simp add: \<nu>_stationary blinfun.add_right blinfun.scaleR_right) + also have "\<dots> = \<nu>\<^sub>b (mk_stationary d) + e *\<^sub>R (\<Sum>i. (l^i *\<^sub>R ((\\<^sub>1 d^^i))) 1)" + using convergent_disc_\\<^sub>1 + by (auto simp: summable_iff_convergent' + bounded_linear.suminf[where f = "\<lambda>x. blinfun_apply x 1"]) + also have "\<dots> = \<nu>\<^sub>b (mk_stationary d) + e *\<^sub>R (\<Sum>i. (l^i *\<^sub>R 1))" + by (auto simp: scaleR_blinfun.rep_eq) + also have "\<dots> \<le> (\<nu>\<^sub>b (mk_stationary d) + (e / (1-l)) *\<^sub>R 1)" + by (auto simp: bounded_linear.suminf[symmetric, where f = "\<lambda>x. x *\<^sub>R 1"] + suminf_geometric bounded_linear_scaleR_left summable_geometric) + finally have "v s \<le> (\<nu>\<^sub>b (mk_stationary d) + (e/(1-l)) *\<^sub>R 1) s" + by auto + thus "v s \<le> \<nu>\<^sub>b_opt s + (e/(1-l))" + using \<open>d \<in> D\<^sub>R\<close> \<nu>\<^sub>b_le_opt + by (auto simp: is_policy_def mk_markovian_def less_eq_bfun_def intro: order_trans) + qed + hence "v s \<le> \<nu>\<^sub>b_opt s + e" if "e > 0" for s e + proof - + have "e * (1 - l) > 0" + by (simp add: \<open>0 < e\<close>) + thus "v s \<le> \<nu>\<^sub>b_opt s + e" + using disc_lt_one that aux + by (fastforce split: if_splits) + qed + thus ?thesis + by (fastforce intro: field_le_epsilon) +qed + +lemma \<L>_fix_imp_opt: + assumes "v = \<L>\<^sub>b v" + shows "v = \<nu>\<^sub>b_opt" + using assms dual_order.antisym[OF \<L>_dec_ge_opt \<L>_inc_le_opt] + by auto + +lemma bounded_P: "bounded (\\<^sub>1 ` X)" + by (auto simp: bounded_iff) + +subsection \<open>Solutions to the Optimality Equation\<close> +subsubsection \<open>@{const \<L>\<^sub>b} and @{const L} are Contraction Mappings\<close> +declare bounded_apply_blinfun[intro] bounded_apply_bfun'[intro] + +lemma contraction_\<L>: "dist (\<L>\<^sub>b v) (\<L>\<^sub>b u) \<le> l * dist v u" +proof - + have "dist (\<L>\<^sub>b v s) (\<L>\<^sub>b u s) \<le> l * dist v u" if "\<L>\<^sub>b u s \<le> \<L>\<^sub>b v s" for s v u + proof - + have "dist (\<L>\<^sub>b v s) (\<L>\<^sub>b u s) \<le> (\<Squnion>d \<in> D\<^sub>R. L d v s - L d u s)" + using ex_dec that by (fastforce intro!: le_SUP_diff' simp: dist_real_def \<L>\<^sub>b.rep_eq \<L>_def) + also have "\<dots> = (\<Squnion>d \<in> D\<^sub>R. l * (\\<^sub>1 d (v - u) s))" + by (auto simp: L_def right_diff_distrib blinfun.diff_right) + also have "\<dots> = l * (\<Squnion>d \<in> D\<^sub>R. \\<^sub>1 d (v - u) s)" + using D\<^sub>R_ne bounded_P + by (fastforce intro: bounded_SUP_mul) + also have "\<dots> \<le> l * norm (\<Squnion>d \<in> D\<^sub>R. \\<^sub>1 d (v - u) s)" + by (simp add: mult_left_mono) + also have "\<dots> \<le> l * (\<Squnion>d \<in> D\<^sub>R. norm ((\\<^sub>1 d (v - u)) s))" + proof - + have "bounded ((\<lambda>x. norm ((\\<^sub>1 x (v - u)) s)) ` D\<^sub>R)" + using bounded_apply_bfun' bounded_P bounded_apply_blinfun bounded_norm_comp + by metis + thus ?thesis + using D\<^sub>R_ne ex_dec bounded_norm_comp + by (fastforce intro!: mult_left_mono) + qed + also have "\<dots> \<le> l * (\<Squnion>p \<in> D\<^sub>R. norm (\\<^sub>1 p ((v - u))))" + using D\<^sub>R_ne abs_le_norm_bfun bounded_P + by (fastforce simp: bounded_norm_comp intro!: bounded_imp_bdd_above mult_left_mono cSUP_mono) + also have "\<dots> \<le> l * (\<Squnion>p \<in> D\<^sub>R. norm ((v - u)))" + using norm_push_exp_le_norm D\<^sub>R_ne + by (fastforce simp: \\<^sub>1.rep_eq intro!: mult_left_mono cSUP_mono) + also have "\<dots> = l * dist v u" + by (auto simp: dist_norm) + finally show ?thesis . + qed + hence "\<L>\<^sub>b u s \<le> \<L>\<^sub>b v s \<Longrightarrow> dist (\<L>\<^sub>b v s) (\<L>\<^sub>b u s) \<le> l * dist v u" + "\<L>\<^sub>b v s \<le> \<L>\<^sub>b u s \<Longrightarrow> dist (\<L>\<^sub>b v s) (\<L>\<^sub>b u s) \<le> l * dist v u" for u v s + by (fastforce simp: dist_commute)+ + thus ?thesis + using linear[of "\<L>\<^sub>b u _"] + by (fastforce intro: dist_bound) +qed + + + +lemma is_contraction_\<L>: "is_contraction \<L>\<^sub>b" + using contraction_\<L> zero_le_disc disc_lt_one + unfolding is_contraction_def + by blast + +lemma contraction_L: "dist (L p v) (L p u) \<le> l * dist v u" +proof - + have aux: "L p v s - L p u s \<le> l * dist v u" if lea: "(L p v s) \<ge> (L p u s)" for v s u + proof - + have "L p v s - L p u s = (l *\<^sub>R (\\<^sub>1 p v - \\<^sub>1 p u)) s" + by (simp add: L_def scale_right_diff_distrib) + also have "\<dots> \<le> l * norm (\\<^sub>1 p (v - u) s)" + by (auto simp: blinfun.diff_right intro!: mult_left_mono) + also have "\<dots> \<le> l * norm (\\<^sub>1 p (v - u))" + using abs_le_norm_bfun + by (auto intro!: mult_left_mono) + also have "\<dots> \<le> l * dist v u" + by (simp add: \\<^sub>1.rep_eq mult_left_mono norm_push_exp_le_norm dist_norm) + finally show ?thesis + by auto + qed + have "dist (L p v s) (L p u s) \<le> l * dist v u" for v s u + proof (cases "L p v s \<ge> L p u s") + case True + thus ?thesis + using aux + by (auto simp: dist_real_def dist_commute[of u]) + next + case False + thus ?thesis + using aux[of v _ u] + by (auto simp: dist_commute dist_norm) + qed + thus "dist (L p v) (L p u) \<le> l * dist v u" + by (simp add: dist_bound) +qed + +lemma is_contraction_L: "is_contraction (L p)" + unfolding is_contraction_def + using contraction_L disc_lt_one zero_le_disc + by blast + +subsubsection \<open>Existence of a Fixpoint of @{const \<L>\<^sub>b}\<close> +lemma \<L>\<^sub>b_conv: + "\<exists>!v. \<L>\<^sub>b v = v" + "(\<lambda>n. (\<L>\<^sub>b ^^ n) v) \<longlonglongrightarrow> (THE v. \<L>\<^sub>b v = v)" + using banach'[OF is_contraction_\<L>] + by auto + +lemma \<L>\<^sub>b_fix_iff_opt [simp]: "\<L>\<^sub>b v = v \<longleftrightarrow> v = \<nu>\<^sub>b_opt" + using banach'(1) is_contraction_\<L> \<L>_fix_imp_opt + by metis + +lemma \<nu>\<^sub>b_opt_fix: "\<nu>\<^sub>b_opt = (THE v. \<L>\<^sub>b v = v)" + by auto + +lemma \<L>\<^sub>b_opt [simp]: "\<L>\<^sub>b \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + by auto + +lemma \<L>\<^sub>b_lim: "(\<lambda>n. (\<L>\<^sub>b ^^ n) v) \<longlonglongrightarrow> \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_conv(2) \<nu>\<^sub>b_opt_fix + by presburger + +lemma thm_6_2_6: "\<nu>\<^sub>b p = \<nu>\<^sub>b_opt \<longleftrightarrow> \<L>\<^sub>b (\<nu>\<^sub>b p) = \<nu>\<^sub>b p" + by force + +lemma thm_6_2_6': "\<nu> p = \<nu>_opt \<longleftrightarrow> \<L>\<^sub>b (\<nu>\<^sub>b p) = \<nu>\<^sub>b p" + using thm_6_2_6 \<nu>\<^sub>b.rep_eq \<nu>\<^sub>b_opt.rep_eq + by fastforce + +subsection \<open>Existence of Optimal Policies\<close> + +definition "\<nu>_improving v d \<longleftrightarrow> (\<forall>s. is_arg_max (\<lambda>d. (L d v) s) (\<lambda>d. d \<in> D\<^sub>R) d)" + +lemma \<nu>_improving_iff: "\<nu>_improving v d \<longleftrightarrow> d \<in> D\<^sub>R \<and> (\<forall>d' \<in> D\<^sub>R. \<forall>s. L d' v s \<le> L d v s)" + by (auto simp: \<nu>_improving_def is_arg_max_linorder) + +lemma \<nu>_improving_D_MR[dest]: "\<nu>_improving v d \<Longrightarrow> d \<in> D\<^sub>R" + by (auto simp add: \<nu>_improving_iff) + +lemma \<nu>_improving_ge: "\<nu>_improving v d \<Longrightarrow> d' \<in> D\<^sub>R \<Longrightarrow> L d' v s \<le> L d v s" + by (auto simp: \<nu>_improving_iff) + +lemma \<nu>_improving_imp_\<L>\<^sub>b: "\<nu>_improving v d \<Longrightarrow> \<L>\<^sub>b v = L d v" + by (fastforce intro!: cSup_eq_maximum simp: \<nu>_improving_iff \<L>\<^sub>b.rep_eq \<L>_def) + +lemma \<L>\<^sub>b_imp_\<nu>_improving: + assumes "d \<in> D\<^sub>R" "\<L>\<^sub>b v = L d v" + shows "\<nu>_improving v d" + using assms L_le_\<L>\<^sub>b + by (auto simp: \<nu>_improving_iff assms(2)[symmetric]) + +lemma \<nu>_improving_alt: + assumes "d \<in> D\<^sub>R" + shows "\<nu>_improving v d \<longleftrightarrow> \<L>\<^sub>b v = L d v" + using \<L>\<^sub>b_imp_\<nu>_improving \<nu>_improving_imp_\<L>\<^sub>b assms + by blast + +definition "\<nu>_conserving d = \<nu>_improving (\<nu>\<^sub>b_opt) d" + +lemma \<nu>_conserving_iff: "\<nu>_conserving d \<longleftrightarrow> d \<in> D\<^sub>R \<and> (\<forall>d' \<in> D\<^sub>R. \<forall>s. L d' \<nu>\<^sub>b_opt s \<le> L d \<nu>\<^sub>b_opt s)" + by (auto simp: \<nu>_conserving_def \<nu>_improving_iff) + +lemma \<nu>_conserving_ge: "\<nu>_conserving d \<Longrightarrow> d' \<in> D\<^sub>R \<Longrightarrow> L d' \<nu>\<^sub>b_opt s \<le> L d \<nu>\<^sub>b_opt s" + by (auto simp: \<nu>_conserving_iff intro: \<nu>_improving_ge) + +lemma \<nu>_conserving_imp_\<L>\<^sub>b [simp]: "\<nu>_conserving d \<Longrightarrow> L d \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using \<nu>_improving_imp_\<L>\<^sub>b + by (fastforce simp: \<nu>_conserving_def) + +lemma \<L>\<^sub>b_imp_\<nu>_conserving: + assumes "d \<in> D\<^sub>R" "\<L>\<^sub>b \<nu>\<^sub>b_opt = L d \<nu>\<^sub>b_opt" + shows "\<nu>_conserving d" + using \<L>\<^sub>b_imp_\<nu>_improving assms + by (auto simp: \<nu>_conserving_def) + +lemma \<nu>_conserving_alt: + assumes "d \<in> D\<^sub>R" + shows "\<nu>_conserving d \<longleftrightarrow> \<L>\<^sub>b \<nu>\<^sub>b_opt = L d \<nu>\<^sub>b_opt" + unfolding \<nu>_conserving_def + using \<nu>_improving_alt assms + by auto + +lemma \<nu>_conserving_alt': + assumes "d \<in> D\<^sub>R" + shows "\<nu>_conserving d \<longleftrightarrow> L d \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using assms \<nu>_conserving_alt + by auto + + +subsubsection \<open>Conserving Decision Rules are Optimal\<close> + +theorem ex_improving_imp_conserving: + assumes "\<And>v. \<exists>d. \<nu>_improving v (mk_dec_det d)" + shows "\<exists>d. \<nu>_conserving (mk_dec_det d)" + by (simp add: assms \<nu>_conserving_def) + +theorem conserving_imp_opt[simp]: + assumes "\<nu>_conserving (mk_dec_det d)" + shows "\<nu>\<^sub>b (mk_stationary_det d) = \<nu>\<^sub>b_opt" + using L_\<nu>_fix_iff \<nu>_conserving_imp_\<L>\<^sub>b[OF assms] + by simp + +lemma conserving_imp_opt': + assumes "\<exists>d. \<nu>_conserving (mk_dec_det d)" + shows "\<exists>d \<in> D\<^sub>D. (\<nu>\<^sub>b (mk_stationary_det d)) = \<nu>\<^sub>b_opt" + using assms + by (fastforce simp: \<nu>_conserving_def) + +theorem improving_att_imp_det_opt: + assumes "\<And>v. \<exists>d. \<nu>_improving v (mk_dec_det d)" + shows "\<nu>\<^sub>b_opt s = (\<Squnion>d \<in> D\<^sub>D. \<nu>\<^sub>b (mk_stationary_det d) s)" +proof - + obtain d where d: "\<nu>_conserving (mk_dec_det d)" + using assms ex_improving_imp_conserving + by auto + hence "d \<in> D\<^sub>D" + using \<nu>_conserving_iff is_dec_mk_dec_det_iff + by blast + thus ?thesis + using \<Pi>\<^sub>M\<^sub>R_imp_policies \<nu>\<^sub>b_le_opt + by (fastforce intro!: less_eq_bfunD cSup_eq_maximum[where z = "\<nu>\<^sub>b_opt s", symmetric] + simp: conserving_imp_opt[OF d] image_iff simp del: \<nu>\<^sub>b.rep_eq \<nu>\<^sub>b_opt.rep_eq) +qed + +subsubsection \<open>Bellman Operator for Single Actions\<close> +abbreviation "L\<^sub>a a v s \<equiv> r (s, a) + l * measure_pmf.expectation (K (s,a)) v" + +lemma L\<^sub>a_le: + fixes v :: "'s \<Rightarrow>\<^sub>b real" + shows "\<bar>L\<^sub>a a v s\<bar> \<le> r\<^sub>M + l * norm v" + using abs_r_le_r\<^sub>M + by (fastforce intro: order_trans[OF abs_triangle_ineq] order_trans[OF integral_abs_bound] + add_mono mult_mono measure_pmf.integral_le_const abs_le_norm_bfun + simp: abs_mult) + +lemma L\<^sub>a_bounded: + "bounded (range (\<lambda>a. L\<^sub>a a (apply_bfun v) s))" + using L\<^sub>a_le + by (auto intro!: boundedI) + +lemma L\<^sub>a_int: + fixes d :: "'a pmf" and v :: "'s \<Rightarrow>\<^sub>b real" + shows "(\<integral>a. L\<^sub>a a v s \<partial>d) = (\<integral>a. r (s, a) \<partial>d) + l * \<integral>a. \<integral>s'. v s' \<partial>K (s, a) \<partial>d" +proof (subst Bochner_Integration.integral_add) + show "integrable d (\<lambda>a. r (s, a))" + using abs_r_le_r\<^sub>M + by (fastforce intro!: bounded_integrable simp: bounded_iff) + show "integrable d (\<lambda>a. l * \<integral>s'. v s' \<partial>K (s, a))" + by (intro bounded_integrable) + (auto intro!: mult_mono order_trans[OF integral_abs_bound] boundedI[of _ "l * norm v"] + measure_pmf.integral_le_const simp: abs_le_norm_bfun abs_mult) +qed auto + +lemma L_eq_L\<^sub>a: "L d v s = measure_pmf.expectation (d s) (\<lambda>a. L\<^sub>a a v s)" + unfolding L\<^sub>a_int L_def K_st_def \\<^sub>1.rep_eq + by (auto simp: measure_pmf_bind integral_measure_pmf_bind[where B = "norm v"] abs_le_norm_bfun) + +lemma L_eq_L\<^sub>a_det: "L (mk_dec_det d) v s = L\<^sub>a (d s) v s" + by (auto simp: L_eq_L\<^sub>a mk_dec_det_def) + +subsubsection \<open>Equivalences involving @{const \<L>\<^sub>b}\<close> + +lemma SUP_step_MR_eq: + "(\<Squnion>d \<in> D\<^sub>R. L d v s) = (\<Squnion>pa \<in> {pa. set_pmf pa \<subseteq> A s}. (\<integral>a. L\<^sub>a a v s \<partial>measure_pmf pa))" +proof (intro antisym) + show "(\<Squnion>d\<in>D\<^sub>R. L d v s) \<le> (\<Squnion>pa \<in> {pa. set_pmf pa \<subseteq> A s}. \<integral>a. L\<^sub>a a v s \<partial>measure_pmf pa)" + proof (rule cSUP_mono) + show "D\<^sub>R \<noteq> {}" + using D\<^sub>R_ne . + next show "bdd_above ((\<lambda>pa. \<integral>a. L\<^sub>a a v s \<partial>measure_pmf pa) ` {pa. set_pmf pa \<subseteq> A s})" + using L\<^sub>a_bounded L\<^sub>a_le + by (auto intro!: order_trans[OF integral_abs_bound] + bounded_imp_bdd_above boundedI[where B = "r\<^sub>M + l * norm v"] + measure_pmf.integral_le_const bounded_integrable) + next show "\<exists>m\<in>{pa. set_pmf pa \<subseteq> A s}. L n v s \<le> \<integral>a. L\<^sub>a a v s \<partial>measure_pmf m" if "n \<in> D\<^sub>R" for n + using that + by (fastforce simp: L_eq_L\<^sub>a L\<^sub>a_int is_dec_def) + qed +next + have aux: "{pa. set_pmf pa \<subseteq> A s} \<noteq> {}" + using D\<^sub>R_ne is_dec_def + by auto + show "(\<Squnion>pa\<in>{pa. set_pmf pa \<subseteq> A s}. \<integral>a. L\<^sub>a a v s \<partial>measure_pmf pa) \<le> (\<Squnion>d\<in>D\<^sub>R. L d v s)" + proof (intro cSUP_least[OF aux] cSUP_upper2) + fix n + assume h: "n \<in> {pa. set_pmf pa \<subseteq> A s}" + let ?p = "(\<lambda>s'. if s = s' then n else SOME a. set_pmf a \<subseteq> A s')" + have aux: "\<exists>a. set_pmf a \<subseteq> A sa" for sa + using ex_dec is_dec_def by blast + show "?p \<in> D\<^sub>R" + unfolding is_dec_def + using h someI_ex[OF aux] + by auto + thus "(\<integral>a. L\<^sub>a a v s \<partial>n) \<le> L ?p v s" + by (auto simp: L_eq_L\<^sub>a) + show "bdd_above ((\<lambda>d. L d v s) ` D\<^sub>R)" + by (fastforce intro!: bounded_imp_bdd_above simp: bounded_def) + next + qed +qed + +lemma \<L>\<^sub>b_sup_att_dec: + assumes "d \<in> D\<^sub>R" "\<L>\<^sub>b v = L d v" + shows "\<exists>d' \<in> D\<^sub>D. \<L>\<^sub>b v = L (mk_dec_det d') v" +proof - + have "\<exists>a\<in> A s. L d v s = L\<^sub>a a v s" for s + unfolding L_eq_L\<^sub>a + using assms is_dec_def L\<^sub>a_bounded A_ne \<L>\<^sub>b.rep_eq \<L>_def + by (intro lemma_4_3_1') + (auto intro: bounded_range_subset simp: assms(2)[symmetric] L_eq_L\<^sub>a[symmetric] SUP_step_MR_eq[symmetric]) + then obtain d' where d: "d' s \<in> A s" "L d v s = L\<^sub>a (d' s) v s" for s + by metis + thus ?thesis + using assms d + by (fastforce simp: is_dec_det_def mk_dec_det_def L_eq_L\<^sub>a) +qed + +lemma SUP_step_det_eq: "(\<Squnion>d \<in> D\<^sub>D. L (mk_dec_det d) v s) = (\<Squnion>a \<in> A s. L\<^sub>a a v s)" +proof (intro antisym cSUP_mono) + show "bdd_above ((\<lambda>a. L\<^sub>a a v s) ` A s)" + using L\<^sub>a_bounded + by (fastforce intro!: bounded_imp_bdd_above simp: bounded_def) + show "bdd_above ((\<lambda>d. L (mk_dec_det d) v s) ` D\<^sub>D)" + by (auto intro!: bounded_imp_bdd_above boundedI abs_L_le) + show "\<exists>m\<in>A s. L (mk_dec_det n) v s \<le> L\<^sub>a m v s" if "n \<in> D\<^sub>D" for n + using that is_dec_det_def + by (auto simp: L_eq_L\<^sub>a_det intro: bexI[of _ "n s"]) + show "\<exists>m\<in>D\<^sub>D. L\<^sub>a n v s \<le> L (mk_dec_det m) v s" if "n \<in> A s" for n + using that A_ne + by (fastforce simp: L_eq_L\<^sub>a_det is_dec_det_def some_in_eq + intro!: bexI[of _ "\<lambda>s'. if s = s' then _ else SOME a. a \<in> A s'"]) +qed (auto simp: A_ne) + +lemma integrable_L\<^sub>a: "integrable (measure_pmf x) (\<lambda>a. L\<^sub>a a (apply_bfun v) s)" +proof (intro Bochner_Integration.integrable_add integrable_mult_right) + show "integrable (measure_pmf x) (\<lambda>x. r (s, x))" + using abs_r_le_r\<^sub>M + by (auto intro: measure_pmf.integrable_const_bound[of _ "r\<^sub>M"]) +next + show "integrable (measure_pmf x) (\<lambda>x. measure_pmf.expectation (K (s, x)) v)" + by (auto intro!: bounded_integrable boundedI order.trans[OF integral_abs_bound] + measure_pmf.integral_le_const abs_le_norm_bfun) +qed + +lemma SUP_L\<^sub>a_eq_det: + fixes v :: "'s \<Rightarrow>\<^sub>b real" + shows "(\<Squnion>p\<in>{p. set_pmf p \<subseteq> A s}. \<integral>a. L\<^sub>a a v s \<partial>measure_pmf p) = (\<Squnion>a\<in>A s. L\<^sub>a a v s)" +proof (intro antisym) + show "(\<Squnion>pa\<in>{pa. set_pmf pa \<subseteq> A s}. measure_pmf.expectation pa (\<lambda>a. L\<^sub>a a v s)) + \<le> (\<Squnion>a\<in>A s. L\<^sub>a a v s)" + using ex_dec is_dec_def integrable_L\<^sub>a A_ne L\<^sub>a_bounded + by (fastforce intro: bounded_range_subset intro!: cSUP_least lemma_4_3_1) + show "(\<Squnion>a\<in>A s. L\<^sub>a a v s) \<le> (\<Squnion>p\<in>{p. set_pmf p \<subseteq> A s}. \<integral>a. L\<^sub>a a v s \<partial>measure_pmf p)" + unfolding SUP_step_MR_eq[symmetric] SUP_step_det_eq[symmetric] + using ex_dec_det + by (auto intro!: cSUP_mono)+ +qed + +lemma \<L>_eq_SUP_det: "\<L> v s = (\<Squnion>d \<in> D\<^sub>D. L (mk_dec_det d) v s)" + unfolding \<L>_def + using SUP_step_MR_eq SUP_step_det_eq SUP_L\<^sub>a_eq_det + by auto + +lemma \<L>\<^sub>b_eq_SUP_det: "\<L>\<^sub>b v s = (\<Squnion>d \<in> D\<^sub>D. L (mk_dec_det d) v s)" + using \<L>_eq_SUP_det + unfolding \<L>\<^sub>b.rep_eq + by auto + +subsubsection \<open>Deterministic Decision Rules are Optimal\<close> + +lemma opt_imp_opt_dec_det: + assumes "p \<in> \<Pi>\<^sub>H\<^sub>R" "\<nu>\<^sub>b p = \<nu>\<^sub>b_opt" + shows "\<exists>d \<in> D\<^sub>D. \<nu>\<^sub>b (mk_stationary (mk_dec_det d)) = \<nu>\<^sub>b_opt" +proof - + have aux: "L (as_markovian p (return_pmf s) 0) \<nu>\<^sub>b_opt s = \<nu>\<^sub>b_opt s" for s + proof - + let ?ps = "as_markovian p (return_pmf s)" + have markovian_suc_le: "\<nu>\<^sub>b (mk_markovian (\<lambda>n. as_markovian p (return_pmf s) (Suc n))) \<le> \<nu>\<^sub>b_opt" + using is_\<Pi>\<^sub>M\<^sub>R_as_markovian assms + by (auto simp: is_policy_def mk_markovian_def) + have aux_le: "\<And>x f g. f \<le> g \<Longrightarrow> apply_bfun f x \<le> apply_bfun g x" + unfolding less_eq_bfun_def + by auto + have "\<nu>\<^sub>b_opt s = \<nu>\<^sub>b (mk_markovian ?ps) s" + using assms \<nu>\<^sub>b_as_markovian + by metis + also have "\<dots> = L (?ps 0) (\<nu>\<^sub>b (mk_markovian (\<lambda>n. ?ps (Suc n)))) s" + using \<nu>_step + by blast + also have "\<dots> \<le> L (?ps 0) (\<nu>\<^sub>b_opt) s" + unfolding L_def + using markovian_suc_le \\<^sub>1_mono + by (auto intro!: mult_left_mono) + finally have "\<nu>\<^sub>b_opt s \<le> L (?ps 0) (\<nu>\<^sub>b_opt) s" . + have "as_markovian p (return_pmf s) 0 \<in> D\<^sub>R" + using is_\<Pi>\<^sub>M\<^sub>R_as_markovian assms + by fast + have "L (?ps 0) \<nu>\<^sub>b_opt \<le> \<nu>\<^sub>b_opt" + using \<open>?ps 0 \<in> D\<^sub>R\<close> L_le_\<L>\<^sub>b[of "?ps 0" "\<nu>\<^sub>b_opt"] + by simp + thus "L (?ps 0) \<nu>\<^sub>b_opt s = \<nu>\<^sub>b_opt s" + using \<open>\<nu>\<^sub>b_opt s \<le> (L (?ps 0) \<nu>\<^sub>b_opt) s\<close> + by (auto intro!: antisym) + qed + have "L (p []) v s = L (as_markovian p (return_pmf s) 0) v s" for v s + by (auto simp: L_def \\<^sub>1.rep_eq K_st_def) + hence "L (p []) \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using aux + by auto + hence "\<exists>d \<in> D\<^sub>D. L (mk_dec_det d) \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt" + using \<L>\<^sub>b_sup_att_dec assms(1) \<L>\<^sub>b_opt is_policy_def mem_Collect_eq + by metis + thus ?thesis + using conserving_imp_opt' \<nu>_conserving_alt' + by blast +qed + +subsubsection \<open>Optimal Decision Rules for Finite Action Spaces\<close> + +(* 6.2.10 *) +lemma thm_6_2_10: + assumes "\<And>s. finite (A s)" + shows "\<exists>d \<in> D\<^sub>D. \<nu>\<^sub>b_opt = \<nu>\<^sub>b (mk_stationary_det d)" +proof - + have "\<exists>d \<in> D\<^sub>D. L (mk_dec_det d) v = \<L>\<^sub>b v" for v + proof - + have "\<exists>a \<in> A s. L\<^sub>a a v s = \<L>\<^sub>b v s" for s + unfolding \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det SUP_step_det_eq + using arg_max_on_in[OF assms A_ne] + by (auto simp: cSup_eq_Sup_fin Sup_fin_Max assms A_ne finite_arg_max_eq_Max[symmetric]) + hence "\<exists>d. \<forall>s. d s \<in> A s \<and> L\<^sub>a (d s) v s = \<L>\<^sub>b v s" + by metis + hence "\<exists>d \<in> D\<^sub>D. \<forall>s. L (mk_dec_det d) v s = \<L>\<^sub>b v s" + unfolding L_def is_dec_det_def mk_dec_det_def + by (auto simp: K_st_def \\<^sub>1.rep_eq bind_return_pmf) + thus ?thesis + using bfun_eqI by blast + qed + thus ?thesis + using assms conserving_imp_opt' \<L>\<^sub>b_opt L_\<nu>_fix_iff + by metis +qed + +subsubsection \<open>Existence of Epsilon-Optimal Policies\<close> + +lemma ex_det_eps: + assumes "0 < e" + shows "\<exists>d \<in> D\<^sub>D. \<L>\<^sub>b v \<le> L (mk_dec_det d) v + e *\<^sub>R 1" +proof - + have "\<exists>a \<in> A s. \<L>\<^sub>b v s \<le> L\<^sub>a a v s + e" for s + proof - + have "bdd_above ((\<lambda>a. L\<^sub>a a v s) ` A s)" + using L\<^sub>a_le + by (auto intro!: boundedI bounded_imp_bdd_above) + hence "\<exists>a \<in> A s. \<L>\<^sub>b v s - e < L\<^sub>a a v s" + unfolding \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det SUP_step_det_eq + by (auto simp: less_cSUP_iff[OF A_ne, symmetric] \<open>0 < e\<close>) + thus "\<exists>a \<in> A s. \<L>\<^sub>b v s \<le> L\<^sub>a a v s + e" + by force + qed + thus ?thesis + unfolding mk_dec_det_def is_dec_det_def + by (auto simp: L_def \\<^sub>1.rep_eq bind_return_pmf K_st_def less_eq_bfun_def) metis +qed + +(* unused *) +lemma thm_6_2_11: + assumes "eps > 0" + shows "\<exists>d \<in> D\<^sub>D. \<nu>\<^sub>b_opt \<le> \<nu>\<^sub>b (mk_stationary_det d) + eps *\<^sub>R 1" +proof - + have "(1-l) * eps > 0" + by (simp add: assms) + then obtain d where "d \<in> D\<^sub>D" and d: "\<L>\<^sub>b \<nu>\<^sub>b_opt \<le> L (mk_dec_det d) \<nu>\<^sub>b_opt + ((1-l)*eps) *\<^sub>R 1" + using ex_det_eps[of _ \<nu>\<^sub>b_opt] + by auto + let ?d = "mk_dec_det d" + let ?lK = "l *\<^sub>R \\<^sub>1 ?d" + let ?lK_opt = "l *\<^sub>R \\<^sub>1 ?d \<nu>\<^sub>b_opt" + have "\<nu>\<^sub>b_opt \<le> r_dec\<^sub>b ?d + ?lK_opt + ((1-l)*eps) *\<^sub>R 1" + using L_def \<L>_fix_imp_opt d + by simp + hence "\<nu>\<^sub>b_opt - ?lK_opt - ((1-l)*eps) *\<^sub>R 1 \<le> r_dec\<^sub>b ?d" + by (simp add: cancel_ab_semigroup_add_class.diff_right_commute diff_le_eq) + hence "(\<Sum>i. ?lK ^^ i) (\<nu>\<^sub>b_opt - ?lK_opt - ((1-l)*eps) *\<^sub>R 1) \<le> \<nu>\<^sub>b (mk_stationary ?d)" + using lemma_6_1_2_b suminf_cong + by (simp add: blincomp_scaleR_right \<nu>_stationary) + hence "((\<Sum>i. ?lK ^^ i) o\<^sub>L (id_blinfun - ?lK)) \<nu>\<^sub>b_opt - (\<Sum>i. ?lK ^^ i) (((1-l)*eps) *\<^sub>R 1) + \<le> (\<nu>\<^sub>b (mk_stationary ?d))" + by (simp add: blinfun.diff_right blinfun.diff_left blinfun.scaleR_left) + hence le: "\<nu>\<^sub>b_opt - (\<Sum>i. ?lK ^^ i) (((1-l)*eps) *\<^sub>R 1) \<le> \<nu>\<^sub>b (mk_stationary ?d)" + by (auto simp: inv_norm_le') + have s: "summable (\<lambda>i. (l *\<^sub>R \\<^sub>1 ?d)^^i)" + using convergent_disc_\\<^sub>1 summable_iff_convergent' + by (simp add: blincomp_scaleR_right summable_iff_convergent') + have "(\<Sum>i. ?lK ^^ i) (((1-l)*eps) *\<^sub>R 1) = eps *\<^sub>R 1" + proof - + have "(\<Sum>i. ?lK ^^ i) (((1-l)*eps) *\<^sub>R 1) = ((1-l)*eps) *\<^sub>R (\<Sum>i. ?lK^^i) 1" + using blinfun.scaleR_right + by blast + also have "\<dots> = ((1-l)*eps) *\<^sub>R (\<Sum>i. (?lK^^i) 1) " + using s + by (auto simp: bounded_linear.suminf[of "\<lambda>x. blinfun_apply x 1"]) + also have "\<dots> = ((1-l)*eps) *\<^sub>R (\<Sum>i. (l ^ i)) *\<^sub>R 1" + by (auto simp: blinfun.scaleR_left blincomp_scaleR_right bounded_linear_scaleR_left + bounded_linear.suminf[of "\<lambda>x. x *\<^sub>R 1"]) + also have "\<dots> = ((1-l)*eps) *\<^sub>R (1 / (1-l)) *\<^sub>R 1" + by (simp add: suminf_geometric) + also have "\<dots> = eps *\<^sub>R 1" + using disc_lt_one + by (auto; fastforce) + finally show ?thesis . + qed + thus ?thesis + using \<open>d \<in> D\<^sub>D\<close> diff_le_eq le + by auto +qed + +lemma ex_det_dist_eps: + assumes "0 < (e :: real)" + shows "\<exists>d \<in> D\<^sub>D. dist (\<L>\<^sub>b v) (L (mk_dec_det d) v) \<le> e" +proof - + obtain d where "d \<in> D\<^sub>D" "L (mk_dec_det d) v \<le> (\<L>\<^sub>b v)" + and h2: "\<L>\<^sub>b v \<le> L (mk_dec_det d) v + e *\<^sub>R 1" + using assms ex_det_eps L_le_\<L>\<^sub>b + by blast + hence "0 \<le> \<L>\<^sub>b v - L (mk_dec_det d) v" + by simp + moreover have "\<L>\<^sub>b v - L (mk_dec_det d) v \<le> e *\<^sub>R 1" + using h2 + by (meson diff_diff_add diff_eq_diff_less_eq) + ultimately have "\<forall>s. \<bar>(\<L>\<^sub>b v) s - L (mk_dec_det d) v s\<bar> \<le> e" + unfolding less_eq_bfun_def by auto + hence "dist (\<L>\<^sub>b v) (L (mk_dec_det d) v) \<le> e" + unfolding dist_bfun.rep_eq + by (auto intro!: cSUP_least simp: dist_real_def) + thus ?thesis + using \<open>d \<in> D\<^sub>D\<close> + by auto +qed + +lemma \<nu>\<^sub>b_opt_le_det: "\<nu>\<^sub>b_opt s \<le> (\<Squnion>d \<in> D\<^sub>D. \<nu>\<^sub>b (mk_stationary_det d) s)" +proof (subst le_cSUP_iff, safe) + fix y + assume "y < apply_bfun \<nu>\<^sub>b_opt s" + then obtain eps where 1: " y \<le> apply_bfun \<nu>\<^sub>b_opt s - eps" and "eps > 0" + by (smt (verit, ccfv_threshold) \<open>y < apply_bfun \<nu>\<^sub>b_opt s\<close>) + hence "eps / 2 > 0" by auto + obtain d where "d \<in> D\<^sub>D" and 2: "\<nu>\<^sub>b_opt s \<le> \<nu>\<^sub>b (mk_stationary_det d) s + eps / 2" + using thm_6_2_11[OF \<open>eps / 2 > 0\<close>] + by (auto simp: less_eq_bfun_def) + hence "y < \<nu>\<^sub>b (mk_stationary_det d) s" + using \<open>eps > 0\<close> + by (auto simp: diff_less_eq intro: le_less_trans[OF 1] le_less_trans[OF 2]) + thus "\<exists>i\<in>D\<^sub>D. y < apply_bfun (\<nu>\<^sub>b (mk_stationary_det i)) s" + using \<open>d \<in> D\<^sub>D\<close> by blast +next + show "D\<^sub>D = {} \<Longrightarrow> False" + using D_det_ne by blast + show "bdd_above ((\<lambda>d. apply_bfun (\<nu>\<^sub>b (mk_stationary_det d)) s) ` D\<^sub>D)" + by (auto intro!: bounded_imp_bdd_above boundedI abs_\<nu>_le simp: \<nu>\<^sub>b.rep_eq is_policy_def) +qed + +lemma \<nu>\<^sub>b_opt_eq_det: "\<nu>\<^sub>b_opt s = (\<Squnion>d \<in> D\<^sub>D. \<nu>\<^sub>b (mk_stationary_det d) s)" + using \<nu>\<^sub>b_le_opt_DD D_det_ne + by (auto intro!: antisym[OF \<nu>\<^sub>b_opt_le_det] cSUP_least simp add: less_eq_bfun_def)+ + +(* unused, delete? *) +lemma lemma_6_3_1_a: + assumes "v0 \<in> bfun" + shows "uniform_limit UNIV (\<lambda>n. ((\<lambda>v. \<L> (Bfun v)) ^^ n) v0) \<nu>_opt sequentially" +proof - + have \<L>_Bfun_eq: "v0 \<in> bfun \<Longrightarrow> ((\<lambda>v. \<L> (Bfun v))^^n) v0 = (\<L>\<^sub>b ^^n) (Bfun v0)" for n + by (induction n) (auto simp: \<L>\<^sub>b.rep_eq apply_bfun_inverse) + have "uniform_limit UNIV (\<lambda>n. (\<L>\<^sub>b ^^ n) (Bfun v0)) \<nu>\<^sub>b_opt sequentially" + by (intro tendsto_bfun_uniform_limit[OF \<L>\<^sub>b_lim]) + hence "uniform_limit UNIV (\<lambda>n. (\<L>\<^sub>b ^^ n) (Bfun v0)) \<nu>_opt sequentially" + by (simp add: \<nu>_opt_bfun \<nu>\<^sub>b_opt.rep_eq) + thus ?thesis + by (auto simp: assms \<L>_Bfun_eq) +qed + +(* should be a general statement for convergent series? *) +lemma thm_6_3_1_b_aux: "(\<lambda>n. dist ((\<L>\<^sub>b^^n) v) ((\<L>\<^sub>b^^(Suc n)) v)) \<longlonglongrightarrow> 0" + using \<L>\<^sub>b_lim tendsto_diff tendsto_norm LIMSEQ_Suc + by (fastforce simp: dist_norm) + +definition "max_L_ex s v \<equiv> has_arg_max (\<lambda>a. L\<^sub>a a v s) (A s)" + +end + +subsection \<open>More Restrictive MDP Locales\<close> + +locale MDP_att_\<L> = MDP_reward A K r l + for + A and + K :: "'s ::countable \<times> 'a ::countable \<Rightarrow> 's pmf" and + r and l + + assumes Sup_att: "max_L_ex (s :: 's) v" +begin + +theorem thm_6_2_10_a_aux': + fixes v :: "'s \<Rightarrow>\<^sub>b real" + assumes "is_arg_max (\<lambda>a. L\<^sub>a a v s) (\<lambda>a. a \<in> A s) a" + shows "\<L>\<^sub>b v s = L\<^sub>a a v s" + using L\<^sub>a_le assms A_ne \<L>\<^sub>b.rep_eq \<L>_eq_SUP_det SUP_step_det_eq + by (auto intro!: cSUP_upper2 antisym cSUP_least simp: is_arg_max_linorder) + +end + +locale MDP_act = MDP_att_\<L> A K r l + for A :: "'s :: countable \<Rightarrow> ('a :: countable) set" and K r l + + fixes arb_act :: "'a set \<Rightarrow> 'a" + assumes arb_act_in[simp]: "X \<noteq> {} \<Longrightarrow> arb_act X \<in> X" +begin + +definition "is_opt_act v s = is_arg_max (\<lambda>a. L\<^sub>a a v s) (\<lambda>a. a \<in> A s)" +abbreviation "opt_acts v s \<equiv> {a. is_opt_act v s a}" + +lemma is_opt_act_some: "is_opt_act v s (arb_act (opt_acts v s))" + using arb_act_in[of "{a. is_arg_max (\<lambda>a. L\<^sub>a a v s) (\<lambda>a. a \<in> A s) a}"] Sup_att has_arg_max_def + unfolding max_L_ex_def is_opt_act_def + by auto + +lemma some_opt_acts_in_A: "arb_act (opt_acts v s) \<in> A s" + using is_opt_act_some unfolding is_opt_act_def is_arg_max_def + by auto + +lemma \<nu>_improving_opt_acts: "\<nu>_improving v0 (mk_dec_det (\<lambda>s. arb_act (opt_acts (apply_bfun v0) s)))" + using is_opt_act_def is_opt_act_some some_opt_acts_in_A + by (subst \<nu>_improving_alt) (fastforce simp: L_eq_L\<^sub>a_det thm_6_2_10_a_aux' is_dec_det_def)+ + +end + +locale MDP_finite_type = MDP_reward A K r l + for A and K :: "'s :: finite \<times> 'a :: finite \<Rightarrow> 's pmf" and r l + + +context MDP_reward +begin + +lemma \<nu>\<^sub>b_fin_zero[simp]: "\<nu>\<^sub>b_fin p 0 = 0" + by (auto simp: \<nu>\<^sub>b_fin.rep_eq) + +lemma \<nu>\<^sub>b_fin_Suc[simp]: "\<nu>\<^sub>b_fin (mk_stationary d) (Suc n) = \<nu>\<^sub>b_fin (mk_stationary d) n + ((l *\<^sub>R \\<^sub>1 d)^^ n) (r_dec\<^sub>b d)" + by (auto simp: \\<^sub>X_sconst \<nu>\<^sub>b_fin.rep_eq \<nu>_fin_eq_\\<^sub>X \\<^sub>1.rep_eq \\<^sub>1_pow blincomp_scaleR_right blinfun.scaleR_left) + +lemma \<nu>\<^sub>b_fin_eq: "\<nu>\<^sub>b_fin (mk_stationary d) n = (\<Sum>i < n. ((l *\<^sub>R \\<^sub>1 d)^^ i)) (r_dec\<^sub>b d)" + by (induction n) (auto simp add: plus_blinfun.rep_eq) + +lemma L_iter: "(L d ^^ m) v = \<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d)^^ m) v" +proof (induction m arbitrary: v) + case (Suc m) + have "(L d ^^ Suc m) v = (L d ^^ m) (L d v)" + by (simp add: funpow_Suc_right del: funpow.simps) + also have "\<dots> = \<nu>\<^sub>b_fin (mk_stationary d) m + ((l *\<^sub>R \\<^sub>1 d) ^^ m) (L d v)" + using Suc by simp + also have "\<dots> = \<nu>\<^sub>b_fin (mk_stationary d) (Suc m) + ((l *\<^sub>R \\<^sub>1 d) ^^ m) ((l *\<^sub>R \\<^sub>1 d) v)" + unfolding L_def by (auto simp: blinfun.bilinear_simps) + also have "\<dots> = \<nu>\<^sub>b_fin (mk_stationary d) (Suc m) + ((l *\<^sub>R \\<^sub>1 d) ^^ Suc m) v" + by (auto simp del: blinfunpow.simps simp add: blinfunpow_assoc) + finally show ?case . +qed simp + + +lemma bounded_stationary_\<nu>\<^sub>b_fin: "bounded ((\<lambda>x. (\<nu>\<^sub>b_fin (mk_stationary x) N) s) ` X)" + using \<nu>\<^sub>b_fin.rep_eq abs_\<nu>_fin_le by (auto intro!: boundedI) + +lemma bounded_disc_\\<^sub>1: "bounded ((\<lambda>x. (((l *\<^sub>R \\<^sub>1 x) ^^ m) v) s) ` X)" + by (auto simp: \\<^sub>X_const[symmetric] blinfun.bilinear_simps blincomp_scaleR_right simp del: \\<^sub>X_sconst + intro!: boundedI[of _ "l ^ m * norm v"] mult_left_mono order.trans[OF abs_le_norm_bfun]) + + +lemma bounded_disc_\\<^sub>1': "bounded ((\<lambda>x. ((\\<^sub>1 x ^^ m) v) s) ` X)" + by (auto simp: \\<^sub>X_const[symmetric] simp del: \\<^sub>X_sconst + intro!: boundedI[of _ "norm v"] order.trans[OF abs_le_norm_bfun]) + +lemma L_iter_le_\<L>\<^sub>b: "is_dec d \<Longrightarrow> (L d ^^ n) v \<le> (\<L>\<^sub>b ^^ n) v" + using order_trans[OF L_mono L_le_\<L>\<^sub>b] + by (induction n) auto +end + +context MDP_att_\<L> +begin +lemma L\<^sub>a_le_arg_max: "a \<in> A s \<Longrightarrow> L\<^sub>a a v s \<le> L\<^sub>a (arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s)) v s" + using Sup_att app_arg_max_ge[OF Sup_att[unfolded max_L_ex_def]] + by (simp add: arg_max_on_def) + +lemma arg_max_on_in: "has_arg_max f Q \<Longrightarrow> arg_max_on f Q \<in> Q" + using has_arg_max_arg_max + by (auto simp: arg_max_on_def) + +lemma \<L>\<^sub>b_eq_L\<^sub>a_max: "\<L>\<^sub>b v s = L\<^sub>a (arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s)) v s" + using app_arg_max_eq_SUP[symmetric] Sup_att max_L_ex_def + by (auto simp: \<L>\<^sub>b_eq_SUP_det SUP_step_det_eq) + +lemma ex_opt_det: "\<exists>d \<in> D\<^sub>D. \<L>\<^sub>b v = L (mk_dec_det d) v" +proof - + define d where "d = (\<lambda>s. arg_max_on (\<lambda>a. L\<^sub>a a v s) (A s))" + have "\<L>\<^sub>b v s = L (mk_dec_det d) v s" for s + by (auto simp: d_def \<L>\<^sub>b_eq_L\<^sub>a_max L_eq_L\<^sub>a_det) + moreover have "d \<in> D\<^sub>D" + using Sup_att arg_max_on_in + by (auto simp: d_def is_dec_det_def max_L_ex_def) + ultimately show ?thesis + by auto +qed + +lemma ex_improving_det: "\<exists>d \<in> D\<^sub>D. \<nu>_improving v (mk_dec_det d)" + using \<nu>_improving_alt ex_opt_det + by auto +end + +end diff --git a/thys/MDP-Rewards/MDP_reward_Util.thy b/thys/MDP-Rewards/MDP_reward_Util.thy new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/MDP_reward_Util.thy @@ -0,0 +1,530 @@ +theory MDP_reward_Util + imports Blinfun_Util +begin +section \<open>Auxiliary Lemmas\<close> + +subsection \<open>Summability\<close> + +lemma summable_powser_const: + fixes c :: real + assumes "\<bar>c\<bar> < 1" + shows "summable (\<lambda>n. c^n * x)" + using assms + by (auto simp: mult.commute) + +subsection \<open>Infinite sums\<close> + +lemma suminf_split_head': + "summable (f :: nat \<Rightarrow> 'x :: real_normed_vector) \<Longrightarrow> suminf f = f 0 + (\<Sum>n. f (Suc n))" + by (auto simp: suminf_split_head) + +lemma sum_disc_lim: + assumes "\<bar>c :: real\<bar> < 1" + shows "(\<Sum>x. c^x * B) = B /(1-c)" + by (simp add: assms suminf_geometric summable_geometric suminf_mult2[symmetric]) + +subsection \<open>Bounded Functions\<close> + +lemma suminf_apply_bfun: + fixes f :: "nat \<Rightarrow> 'c \<Rightarrow>\<^sub>b real" + assumes "summable f" + shows "(\<Sum>i. f i) x = (\<Sum>i. f i x)" + by (auto intro!: bounded_linear.suminf assms bounded_linear_intro[where K = 1] abs_le_norm_bfun) + +lemma sum_apply_bfun: + fixes f :: "nat \<Rightarrow> 'c \<Rightarrow>\<^sub>b real" + shows "(\<Sum>i<n. f i) x = (\<Sum>i<n. apply_bfun (f i) x)" + by (induction n) auto + +subsection \<open>Push-Forward of a Bounded Function\<close> + +lemma integrable_bfun_prob_space [simp]: + "integrable (measure_pmf P) (\<lambda>t. apply_bfun f (F t) :: real)" +proof - + obtain b where "\<forall>t. \<bar>f (F t)\<bar> \<le> b" + by (metis norm_le_norm_bfun real_norm_def) + hence "(\<integral>\<^sup>+ x. ennreal \<bar>f (F x)\<bar> \<partial>P) \<le> b" + using nn_integral_mono ennreal_leI + by (auto intro: measure_pmf.nn_integral_le_const) + then show ?thesis + using ennreal_less_top le_less_trans + by (fastforce simp: integrable_iff_bounded) +qed + +lift_definition push_exp :: "('b \<Rightarrow> 'c pmf) \<Rightarrow> ('c \<Rightarrow>\<^sub>b real) \<Rightarrow> ('b \<Rightarrow>\<^sub>b real)" is + "\<lambda>c f s. measure_pmf.expectation (c s) f" + using bfun_integral_bound' . + +declare push_exp.rep_eq[simp] + +lemma norm_push_exp_le_norm: "norm (push_exp d x) \<le> norm x" +proof - + have "\<And>s. (\<integral>s'. norm (x s') \<partial>d s) \<le> norm x" + using measure_pmf.prob_space_axioms norm_le_norm_bfun[of x] + by (auto intro!: prob_space.integral_le_const) + hence aux: "\<And>s. norm (\<integral>s'. x s' \<partial>d s) \<le> norm x" + using integral_norm_bound order_trans by blast + have "norm (push_exp d x) = (\<Squnion>s. norm (\<integral>s'. x s' \<partial>d s))" + unfolding norm_bfun_def' + by auto + also have "\<dots> \<le> norm x" + using aux by (fastforce intro!: cSUP_least) + finally show ?thesis . +qed + +lemma push_exp_bounded_linear [simp]: "bounded_linear (push_exp d)" + using norm_push_exp_le_norm + by (auto intro!: bounded_linear_intro[where K = 1]) + +lemma onorm_push_exp [simp]: "onorm (push_exp d) = 1" +proof (intro antisym) + show "onorm (push_exp d) \<le> 1" + using norm_push_exp_le_norm + by (auto intro!: onorm_bound) +next + show "1 \<le> onorm (push_exp d)" + using onorm[of _ 1, OF push_exp_bounded_linear] + by (auto simp: norm_bfun_def') +qed + +lemma push_exp_return[simp]: "push_exp return_pmf = id" + by (auto simp: eq_id_iff[symmetric]) + +subsection \<open>Boundedness\<close> + +lemma bounded_abs[intro]: + "bounded (X' :: real set) \<Longrightarrow> bounded (abs ` X')" + by (auto simp: bounded_iff) + +lemma bounded_abs_range[intro]: + "bounded (range f :: real set) \<Longrightarrow> bounded (range (\<lambda>x. abs (f x)))" + by (auto simp: bounded_iff) + +subsection \<open>Probability Theory\<close> + +lemma integral_measure_pmf_bind: + assumes "(\<And>x. \<bar>(f :: 'b \<Rightarrow> real) x\<bar> \<le> B)" + shows "(\<integral>x. f x \<partial>((measure_pmf M) \<bind> (\<lambda>x. measure_pmf (N x)))) = (\<integral>x. \<integral>y. f y \<partial>N x \<partial>M)" + using assms + by (subst integral_bind[of _ "count_space UNIV" B]) (auto simp: measure_pmf_in_subprob_space) + +lemma lemma_4_3_1': + assumes "set_pmf p \<subseteq> W" + and "bounded ((w :: 'c \<Rightarrow> real) ` W)" + and "W \<noteq> {}" + and "measure_pmf.expectation p w = (\<Squnion>p \<in> {p. set_pmf p \<subseteq> W}. measure_pmf.expectation p w)" + shows "\<exists>x \<in> W. measure_pmf.expectation p w = w x" +proof - + have abs_w_le_sup: "y \<in> W \<Longrightarrow> \<bar>w y\<bar> \<le> (\<Squnion>x \<in> W. \<bar>w x\<bar>)" for y + using assms bounded_abs[OF assms(2)] + by (auto intro!: cSUP_upper bounded_imp_bdd_above simp: image_image) + have "False" if "x \<in> set_pmf p" "w x < \<Squnion>(w ` W)" for x + proof - + have ex_gr: "\<exists>x'. x' \<in> W \<and> w x < w x'" + using cSUP_least[of W w "w x"] that assms + by fastforce + let ?s = "\<lambda>s. (if x = s then SOME x'. x' \<in> W \<and> w x < w x' else s)" + have "measure_pmf.expectation p w < measure_pmf.expectation p (\<lambda>xa. w (?s xa))" + proof (intro measure_pmf.integral_less_AE[where A = "{x}"]) + show "integrable (measure_pmf p) w" + using assms abs_w_le_sup + by (fastforce simp: AE_measure_pmf_iff + intro!: measure_pmf.integrable_const_bound) + show "integrable (measure_pmf p) (\<lambda>xa. w (?s xa))" + using assms(1) ex_gr someI[where P = "\<lambda>x'. (x' \<in> W) \<and> (w x < w x')"] + by (fastforce simp: AE_measure_pmf_iff + intro!: abs_w_le_sup measure_pmf.integrable_const_bound) + show "emeasure (measure_pmf p) {x} \<noteq> 0" + by (simp add: emeasure_pmf_single_eq_zero_iff \<open>x \<in> p\<close>) + show "{x} \<in> measure_pmf.events p" + by auto + show "AE xa\<in>{x} in p. w xa \<noteq> w (?s xa)" "AE xa in p. w xa \<le> w (?s xa)" + using someI[where P = "\<lambda>x'. (x' \<in> W) \<and> (w x < w x')"] ex_gr + by (fastforce intro!: AE_pmfI)+ + qed + hence "measure_pmf.expectation p w < \<Squnion>((\<lambda>p. measure_pmf.expectation p w) ` {p. set_pmf p \<subseteq> W})" + proof (subst less_cSUP_iff, goal_cases) + case 1 + then show ?case + using assms(1) + by blast + next + case 2 + then show ?case + using abs_w_le_sup + by (fastforce + simp: AE_measure_pmf_iff + intro: cSUP_upper2 bdd_aboveI[where M = "(\<Squnion>x\<in>W. \<bar>w x\<bar>)"] + intro!: measure_pmf.integral_le_const measure_pmf.integrable_const_bound) + next + case 3 + then show ?case + using ex_gr someI[where P = "\<lambda>x'. (x' \<in> W) \<and> (w x < w x')"] assms(1) + by (auto intro!: exI[of _ "map_pmf ?s p"]) + qed + thus False + using assms by auto + qed + hence 1: "x \<in> set_pmf p \<Longrightarrow> w x = \<Squnion> (w ` W)" for x + using assms + by (fastforce intro: antisym simp: bounded_imp_bdd_above cSUP_upper) + hence "w (SOME x. x \<in> set_pmf p) = \<Squnion> (w ` W)" + by (simp add: set_pmf_not_empty some_in_eq) + thus ?thesis + using 1 assms(1) set_pmf_not_empty some_in_eq + by (fastforce intro!: bexI[of _ "SOME x. x \<in> set_pmf p"] + simp: AE_measure_pmf_iff Bochner_Integration.integral_cong_AE[where ?g = "\<lambda>_. \<Squnion> (w ` W)"]) +qed + +lemma lemma_4_3_1: + assumes "set_pmf p \<subseteq> W" "integrable (measure_pmf p) w" "bounded ((w :: 'c \<Rightarrow> real) ` W)" + shows "measure_pmf.expectation p w \<le> \<Squnion>(w ` W)" + using assms bounded_has_Sup(1) prob_space_measure_pmf + by (fastforce simp: AE_measure_pmf_iff intro!: prob_space.integral_le_const) + +lemma bounded_integrable: + assumes "bounded (range v)" "v \<in> borel_measurable (measure_pmf p)" + shows "integrable (measure_pmf p) (v :: 'c \<Rightarrow> real)" + using assms + by (auto simp: bounded_iff AE_measure_pmf_iff intro!: measure_pmf.integrable_const_bound) + +subsection \<open>Argmax\<close> +lemma finite_is_arg_max: "finite X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>x. is_arg_max (f :: 'c \<Rightarrow> real) (\<lambda>x. x \<in> X) x" + unfolding is_arg_max_def +proof (induction rule: finite_induct) + case (insert x F) + then show ?case + proof (cases "\<forall>y \<in> F. f y \<le> f x") + case True + then show ?thesis + by (auto intro!: exI[of _ x]) + next + case False + then show ?thesis + using insert by force + qed +qed simp + +lemma finite_arg_max_le: + assumes "finite (X :: 'c set)" "X \<noteq> {}" + shows "s \<in> X \<Longrightarrow> (f :: 'c \<Rightarrow> real) s \<le> f (arg_max_on (f :: 'c \<Rightarrow> real) X)" + unfolding arg_max_def arg_max_on_def + by (metis assms(1) assms(2) finite_is_arg_max is_arg_max_linorder someI_ex) + +lemma arg_max_on_in: + assumes "finite (X :: 'c set)" "X \<noteq> {}" + shows "(arg_max_on (f :: 'c \<Rightarrow> real) X) \<in> X" + unfolding arg_max_on_def arg_max_def + by (metis assms(1) assms(2) finite_is_arg_max is_arg_max_def someI) + +lemma finite_arg_max_eq_Max: + assumes "finite (X :: 'c set)" "X \<noteq> {}" + shows "(f :: 'c \<Rightarrow> real) (arg_max_on f X) = Max (f ` X)" + using assms + by (auto intro!: Max_eqI[symmetric] finite_arg_max_le arg_max_on_in) + + +lemma arg_max_SUP: "is_arg_max (f :: 'b \<Rightarrow> real) (\<lambda>x. x \<in> X) m \<Longrightarrow> f m = (\<Squnion>(f ` X))" + unfolding is_arg_max_def + by (auto intro!: antisym cSUP_upper bdd_aboveI[of _ "f m"] cSUP_least) + +definition "has_max X \<equiv> \<exists>x \<in> X. \<forall>x' \<in> X. x' \<le> x" +definition "has_arg_max f X \<equiv> \<exists>x. is_arg_max f (\<lambda>x. x \<in> X) x" + +lemma "has_max ((f :: 'b \<Rightarrow> real) ` X) \<longleftrightarrow> has_arg_max f X" + unfolding has_max_def has_arg_max_def is_arg_max_def + using not_less by (auto dest!: leD simp: not_less) + +lemma has_arg_max_is_arg_max: "has_arg_max f X \<Longrightarrow> is_arg_max f (\<lambda>x. x \<in> X) (arg_max f (\<lambda>x. x \<in> X))" + unfolding has_arg_max_def arg_max_def + by (auto intro: someI) + +lemma has_arg_max_arg_max: "has_arg_max f X \<Longrightarrow> (arg_max f (\<lambda>x. x \<in> X)) \<in> X" + unfolding has_arg_max_def arg_max_def + by (auto; metis is_arg_max_def someI_ex) + +lemma app_arg_max_ge: "has_arg_max (f :: 'b \<Rightarrow> real) X \<Longrightarrow> x \<in> X \<Longrightarrow> f x \<le> f (arg_max_on f X)" + unfolding has_arg_max_def arg_max_on_def arg_max_def is_arg_max_def + using someI[where ?P = "\<lambda>x. x \<in> X \<and> (\<nexists>y. y \<in> X \<and> f x < f y)"] le_less_linear + by auto + +lemma app_arg_max_eq_SUP: "has_arg_max (f :: 'b \<Rightarrow> real) X \<Longrightarrow> f (arg_max_on f X) = \<Squnion>(f ` X)" + by (simp add: arg_max_SUP arg_max_on_def has_arg_max_is_arg_max) + +lemma SUP_is_arg_max: + assumes "x \<in> X" "bdd_above (f ` X)" "(f :: 'c \<Rightarrow> real) x = \<Squnion>(f ` X)" + shows "is_arg_max f (\<lambda>x. x \<in> X) x" + unfolding is_arg_max_def + using not_less assms cSUP_upper[of _ X f] + by auto + + +lemma is_arg_max_linorderI[intro]: fixes f :: "'c \<Rightarrow> 'b :: linorder" + assumes "P x" "\<And>y. (P y \<Longrightarrow> f x \<ge> f y)" + shows "is_arg_max f P x" + using assms + by (auto simp: is_arg_max_linorder) + +lemma is_arg_max_linorderD[dest]: fixes f :: "'c \<Rightarrow> 'b :: linorder" + assumes "is_arg_max f P x" + shows "P x" "(P y \<Longrightarrow> f x \<ge> f y)" + using assms + by (auto simp: is_arg_max_linorder) + +lemma is_arg_max_cong: + assumes "\<And>x. P x \<Longrightarrow> f x = g x" + shows "is_arg_max f P x \<longleftrightarrow> is_arg_max g P x" + unfolding is_arg_max_def + using assms + by auto + +lemma is_arg_max_congI: + assumes "is_arg_max f P x" "\<And>x. P x \<Longrightarrow> f x = g x" + shows "is_arg_max g P x" + using is_arg_max_cong assms + by force + +subsection \<open>Contraction Mappings\<close> + +definition "is_contraction C \<equiv> \<exists>l. 0 \<le> l \<and> l < 1 \<and> (\<forall>v u. dist (C v) (C u) \<le> l * dist v u)" + +lemma banach': + fixes C :: "'b :: complete_space \<Rightarrow> 'b" + assumes "is_contraction C" + shows "\<exists>!v. C v = v" "\<And>v. (\<lambda>n. (C ^^ n) v) \<longlonglongrightarrow> (THE v. C v = v)" +proof - + obtain v where C: "C v = v" "\<forall>v'. C v' = v' \<longrightarrow> v' = v" + by (metis assms is_contraction_def banach_fix_type) + obtain l where cont: "dist (C v) (C u) \<le> l * dist v u" "0 \<le> l" "l < 1" for v u + using assms is_contraction_def by blast + have *: "\<And>n v0. dist ((C ^^ n) v0) v \<le> l ^ n * dist v0 v" + proof - + fix n v0 + show "dist ((C ^^ n) v0) v \<le> l ^ n * dist v0 v" + proof (induction n) + case (Suc n) + thus "dist ((C ^^ Suc n) v0) v \<le> l ^ Suc n * dist v0 v" + using \<open>0 \<le> l\<close> + by (subst C(1)[symmetric]) + (auto simp: algebra_simps intro!: order_trans[OF cont(1)] mult_left_mono) + qed simp + qed + have "(\<lambda>n. l ^ n) \<longlonglongrightarrow> 0" + by (simp add: LIMSEQ_realpow_zero \<open>0 \<le> l\<close> \<open>l < 1\<close>) + hence "\<And>v0. (\<lambda>n. l ^ n * dist v0 v) \<longlonglongrightarrow> 0" + by (simp add: tendsto_mult_left_zero) + hence "(\<lambda>n. dist ((C ^^ n) v0) v) \<longlonglongrightarrow> 0" for v0 + using * order_trans abs_ge_self + by (subst Limits.tendsto_0_le[of "(\<lambda>n. l ^ n * dist v0 v)" _ _ 1]) + (fastforce intro!: eventuallyI)+ + hence "\<And>v0. (\<lambda>n. (C ^^ n) v0) \<longlonglongrightarrow> v" + using tendsto_dist_iff by blast + thus "\<And>v0. (\<lambda>n. (C ^^ n) v0) \<longlonglongrightarrow> (THE v. C v = v)" + by (metis (mono_tags, lifting) C theI') +next + show "\<exists>!v. C v = v" + using assms + unfolding is_contraction_def + using banach_fix_type + by blast +qed + +lemma contraction_dist: + fixes C :: "'b :: complete_space \<Rightarrow> 'b" + assumes "\<And>v u. dist (C v) (C u) \<le> c * dist v u" + assumes "0 \<le> c" "c < 1" + shows "(1 - c) * dist v (THE v. C v = v) \<le> dist v (C v)" +proof - + have "is_contraction C" + unfolding is_contraction_def using assms by auto + then obtain v_fix where v_fix: "v_fix = (THE v. C v = v)" + using the1_equality + by blast + hence "(\<lambda>n. (C ^^ n) v) \<longlonglongrightarrow> v_fix" + using banach'[OF \<open>is_contraction C\<close>] + by simp + have dist_contr_le_pow: "\<And>n. dist ((C ^^ n) v) ((C ^^ Suc n) v) \<le> c ^ n * dist v (C v)" + proof - + fix n + show "dist ((C ^^ n) v) ((C ^^ Suc n) v) \<le> c ^ n * dist v (C v)" + using assms + by (induction n) (auto simp: algebra_simps intro!: order.trans[OF assms(1)] mult_left_mono) + qed + have summable_C: "summable (\<lambda>i. dist ((C ^^ i) v) ((C ^^ Suc i) v))" + using dist_contr_le_pow assms summable_powser_const + by (intro summable_comparison_test[of "(\<lambda>i. dist ((C ^^ i) v) ((C ^^ Suc i) v))" "\<lambda>i. c^i * dist v (C v)"]) + auto + have "\<forall>e > 0. dist v v_fix \<le> (\<Sum>i. dist ((C ^^ i) v) ((C ^^ (Suc i)) v)) + e" + proof safe + fix e ::real assume "0 < e" + have "\<forall>\<^sub>F n in sequentially. dist ((C^^n) v) v_fix < e" + using \<open>(\<lambda>n. (C ^^ n) v) \<longlonglongrightarrow> v_fix\<close> \<open>0 < e\<close> tendsto_iff by force + then obtain N where "dist ((C^^N) v) v_fix < e" + by fastforce + hence *: "dist v v_fix \<le> dist v ((C^^N) v) + e" + by (metis add_le_cancel_left dist_commute dist_triangle_le less_eq_real_def) + have "dist v ((C^^N) v) \<le> (\<Sum>i\<le>N. dist ((C ^^ i) v) ((C ^^ (Suc i)) v))" + proof (induction N arbitrary: v) + case 0 + then show ?case by simp + next + case (Suc N) + have "dist v ((C ^^ Suc N) v) \<le> dist v (C v) + dist (C v) ((C^^(Suc N)) v)" + by metric + also have "\<dots> = dist v (C v) + dist (C v) ((C^^N) (C v))" + by (metis funpow_simps_right(2) o_def) + also have "\<dots> \<le> dist v (C v) + (\<Sum>i\<le>N. dist ((C ^^ i) (C v)) ((C ^^ Suc i) (C v)))" + using Suc.IH add_le_cancel_left by blast + also have "\<dots> \<le> dist v (C v) + (\<Sum>i\<le>N. dist ((C ^^Suc i) v) ((C ^^ (Suc (Suc i))) v))" + by (simp only: funpow_simps_right(2) o_def) + also have "\<dots> \<le> (\<Sum>i\<le>Suc N. dist ((C ^^ i) v) ((C ^^ (Suc i)) v))" + by (subst sum.atMost_Suc_shift) simp + finally show "dist v ((C ^^ Suc N) v) \<le> (\<Sum>i\<le>Suc N. dist ((C ^^ i) v) ((C ^^ Suc i) v))" . + qed + moreover have + "(\<Sum>i\<le>N. dist ((C ^^ i) v) ((C ^^ Suc i) v)) \<le> (\<Sum>i. dist ((C ^^ i) v) ((C ^^ (Suc i)) v))" + using summable_C + by (auto intro: sum_le_suminf) + ultimately have "dist v ((C^^N) v) \<le> (\<Sum>i. dist ((C ^^ i) v) ((C ^^ (Suc i)) v))" + by linarith + thus "dist v v_fix \<le> (\<Sum>i. dist ((C ^^ i) v) ((C ^^ Suc i) v)) + e" + using * by fastforce + qed + hence le_suminf: "dist v v_fix \<le> (\<Sum>i. dist ((C ^^ i) v) ((C ^^ Suc i) v))" + using field_le_epsilon by blast + have "dist v v_fix \<le> (\<Sum>i. c ^ i * dist v (C v))" + using dist_contr_le_pow summable_C assms summable_powser_const + by (auto intro!: order_trans[OF le_suminf] suminf_le) + hence "dist v v_fix \<le> dist v (C v) / (1 - c)" + using sum_disc_lim + by (metis sum_disc_lim abs_of_nonneg assms(2) assms(3)) + hence "(1 - c) * dist v v_fix \<le> dist v (C v)" + using assms(3) mult.commute pos_le_divide_eq + by (metis diff_gt_0_iff_gt) + thus ?thesis + using v_fix by blast +qed + +subsection \<open>Limits\<close> +lemma tendsto_bfun_sandwich: + assumes + "(f :: nat \<Rightarrow> 'b \<Rightarrow>\<^sub>b real) \<longlonglongrightarrow> x" "(g :: nat \<Rightarrow> 'b \<Rightarrow>\<^sub>b real) \<longlonglongrightarrow> x" + "eventually (\<lambda>n. f n \<le> h n) sequentially" "eventually (\<lambda>n. h n \<le> g n) sequentially" + shows "(h :: nat \<Rightarrow> 'b \<Rightarrow>\<^sub>b real) \<longlonglongrightarrow> x" +proof - + have 1: "(\<lambda>n. dist (f n) (g n) + dist (g n) x) \<longlonglongrightarrow> 0" + using tendsto_dist[OF assms(1) assms(2)] tendsto_dist_iff assms + by (auto intro!: tendsto_add_zero) + have "eventually (\<lambda>n. dist (h n) (g n) \<le> dist (f n) (g n)) sequentially" + using assms(3) assms(4) + proof eventually_elim + case (elim n) + hence "dist (h n a) (g n a) \<le> dist (f n a) (g n a)" for a + proof - + have "f n a \<le> h n a" "h n a \<le> g n a" + using elim unfolding less_eq_bfun_def by auto + thus ?thesis + using dist_real_def by fastforce + qed + thus ?case + unfolding dist_bfun.rep_eq + by (auto intro!: cSUP_mono bounded_imp_bdd_above simp: dist_real_def bounded_minus_comp bounded_abs_range) + qed + moreover have "eventually (\<lambda>n. dist (h n) x \<le> dist (h n) (g n) + dist (g n) x) sequentially" + by (simp add: dist_triangle) + ultimately have 2: "eventually (\<lambda>n. dist (h n) x \<le> dist (f n) (g n) + dist (g n) x) sequentially" + using eventually_elim2 by fastforce + have "(\<lambda>n. dist (h n) x) \<longlonglongrightarrow> 0" + proof (subst tendsto_iff, safe) + fix e ::real + assume "e > 0" + hence 3: "\<forall>\<^sub>F xa in sequentially. dist (f xa) (g xa) + dist (g xa) x < e" + using 1 + by (auto simp: tendsto_iff) + show "\<forall>\<^sub>F xa in sequentially. dist (dist (h xa) x) 0 < e" + by (rule eventually_mp[OF _ 3]) (fastforce intro: 2 eventually_mono) + qed + thus ?thesis + using tendsto_dist_iff + by auto +qed + +subsection \<open>Supremum\<close> + +lemma SUP_add_le: + assumes "X \<noteq> {}" "bounded (B ` X)" "bounded (A' ` X)" + shows "(\<Squnion>c \<in> X. (B :: 'a \<Rightarrow> real) c + A' c) \<le> (\<Squnion>b \<in> X. B b) + (\<Squnion>a \<in> X. A' a)" + using assms + by (auto simp: add_mono bounded_has_Sup(1) intro!: cSUP_least)+ + +lemma le_SUP_diff': + assumes ne: "X \<noteq> {}" + and bdd: "bounded (B ` X)" "bounded (A' ` X)" + and sup_le: "(\<Squnion>a \<in> X. (A' :: 'a \<Rightarrow> real) a) \<le> (\<Squnion>b \<in> X. B b)" + shows "(\<Squnion>b \<in> X. B b) - (\<Squnion>a \<in> X. (A' :: 'a \<Rightarrow> real) a) \<le> (\<Squnion>c \<in> X. B c - A' c)" +proof - + have "bounded ((\<lambda>x. (B x - A' x)) ` X)" + using bdd bounded_minus_comp by blast + have "(\<Squnion>b \<in> X. B b) - (\<Squnion>a \<in> X. A' a) - e \<le> (\<Squnion>c \<in> X. B c - A' c)" if e: "e > 0" for e + proof - + obtain z where z: "(\<Squnion>b \<in> X. B b) - e\<le> B z" "z \<in> X" + using e ne + by (subst less_cSupE[where ?y = "\<Squnion> (B ` X) - e", where ?X = "B`X"]) fastforce+ + hence " ((\<Squnion>a \<in> X. A' a) \<le> B z + e)" + using sup_le + by force + hence "A' z \<le> B z + e" + using \<open>z \<in> X\<close> bdd bounded_has_Sup(1) by fastforce + thus "(\<Squnion>b \<in> X. B b) - (\<Squnion>a \<in> X. A' a) -e \<le> (\<Squnion>c \<in> X. B c - A' c)" + using \<open>bounded ((\<lambda>x. B x - A' x) ` X)\<close> z bounded_has_Sup(1)[OF bdd(2)] + by (subst cSUP_upper2[where x = z]) (fastforce intro!: bounded_imp_bdd_above)+ + qed + thus ?thesis + by (subst field_le_epsilon) fastforce+ +qed + +lemma le_SUP_diff: + fixes A' :: "'a \<Rightarrow> real" + assumes "X \<noteq> {}" "bounded (B ` X)" "bounded (A' ` X)" "(\<Squnion>a \<in> X. A' a) \<le> (\<Squnion>b \<in> X. B b)" + shows "0 \<le> (\<Squnion>c \<in> X. B c - A' c)" + using assms + by (auto intro!: order.trans[OF _ le_SUP_diff']) + +lemma bounded_SUP_mul[simp]: + "X \<noteq> {} \<Longrightarrow> 0 \<le> l \<Longrightarrow> bounded (f ` X) \<Longrightarrow> (\<Squnion>x \<in> X. (l :: real) * f x) = (l * (\<Squnion>x \<in> X. f x))" +proof - + assume "X \<noteq> {} "" bounded (f ` X)" "0 \<le> l" + have "(\<Squnion>x \<in> X. ereal l * ereal (f x)) = (l * (\<Squnion>x \<in> X. ereal (f x)))" + by (simp add: Sup_ereal_mult_left' \<open>0 \<le> l\<close> \<open>X \<noteq> {}\<close>) + obtain b where "\<forall>a \<in>X. \<bar>f a\<bar> \<le> b" + using \<open>bounded (f ` X)\<close> bounded_real by auto + have "\<forall>a \<in>X. \<bar>ereal (f a)\<bar> \<le> b" + by (simp add: \<open>\<forall>a\<in>X. \<bar>f a\<bar> \<le> b\<close>) + hence sup_leb: "(\<Squnion>a\<in>X. \<bar>ereal (f a)\<bar>)\<le> b" + by (simp add: SUP_least) + have "(\<Squnion>a\<in>X. ereal (f a)) \<le> (\<Squnion>a\<in>X. \<bar>ereal (f a)\<bar>)" + by (auto intro: Complete_Lattices.SUP_mono') + moreover have "-(\<Squnion>a\<in>X. ereal (f a)) \<le> (\<Squnion>a\<in>X. \<bar>ereal (f a)\<bar>)" + using \<open>X \<noteq> {}\<close> + by (auto intro!: Inf_less_eq cSUP_upper2 simp add: ereal_INF_uminus_eq[symmetric]) + ultimately have "\<bar>(\<Squnion>a\<in>X. ereal (f a))\<bar> \<le> (\<Squnion>a\<in>X. \<bar>ereal (f a)\<bar>)" + by (auto intro: ereal_abs_leI) + hence "\<bar>\<Squnion>a\<in>X. ereal (f a)\<bar> \<le> b" + using sup_leb by auto + hence "\<bar>\<Squnion>a\<in>X. ereal (f a)\<bar> \<noteq> \<infinity>" + by auto + hence "(\<Squnion>x \<in> X. ereal (f x)) = ereal (\<Squnion>x \<in> X. (f x))" + using ereal_SUP by metis + hence "(\<Squnion>x \<in> X. ereal (l * f x)) = ereal (l * (\<Squnion>x \<in> X. f x))" + using \<open>(\<Squnion>x\<in>X. ereal l * ereal (f x)) = ereal l * (\<Squnion>x\<in>X. ereal (f x))\<close> by auto + hence "ereal (\<Squnion>x \<in> X. l * f x) = ereal (l * (\<Squnion>x \<in> X. f x))" + by (simp add: ereal_SUP) + thus ?thesis + by auto +qed + +lemma abs_cSUP_le[intro]: + "X \<noteq> {} \<Longrightarrow> bounded (F ` X) \<Longrightarrow> \<bar>\<Squnion>x \<in> X. (F x) :: real\<bar> \<le> (\<Squnion>x \<in> X. \<bar>F x\<bar>)" + by (auto intro!: cSup_abs_le cSUP_upper2 bounded_imp_bdd_above simp: image_image[symmetric]) + +end diff --git a/thys/MDP-Rewards/ROOT b/thys/MDP-Rewards/ROOT new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/ROOT @@ -0,0 +1,8 @@ +chapter AFP +session "MDP-Rewards" (AFP) = "HOL-Probability" + + options [timeout = 600] + theories + MDP_reward + document_files + "root.bib" + "root.tex" diff --git a/thys/MDP-Rewards/document/root.bib b/thys/MDP-Rewards/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/document/root.bib @@ -0,0 +1,24 @@ +@book{Puterman, + author = {Martin L. Puterman}, + title = {Markov Decision Processes: Discrete Stochastic Dynamic Programming}, + series = {Wiley Series in Probability and Statistics}, + publisher = {Wiley}, + year = {1994}, + url = {https://doi.org/10.1002/9780470316887}, + doi = {10.1002/9780470316887}, + isbn = {978-0-47161977-2}, + timestamp = {Mon, 22 Jul 2019 15:00:49 +0200}, + biburl = {https://dblp.org/rec/books/wi/Puterman94.bib}, + bibsource = {dblp computer science bibliography, https://dblp.org} +} + +@article{Markov_Models-AFP, + author = {Johannes Hölzl and Tobias Nipkow}, + title = {Markov Models}, + journal = {Archive of Formal Proofs}, + month = jan, + year = 2012, + note = {\url{https://isa-afp.org/entries/Markov_Models.html}, + Formal proof development}, + ISSN = {2150-914x}, +} diff --git a/thys/MDP-Rewards/document/root.tex b/thys/MDP-Rewards/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/MDP-Rewards/document/root.tex @@ -0,0 +1,69 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +\usepackage{amssymb, amsmath, amsfonts} + %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>, + %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>, + %\<triangleq>, \<yen>, \<lozenge> + +%\usepackage{eurosym} + %for \<euro> + +\usepackage[only,bigsqcap]{stmaryrd} + %for \<Sqinter> + +%\usepackage{eufrak} + %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb) + +%\usepackage{textcomp} + %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>, + %\<currency> + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Markov Decision Processes with Rewards} +\author{Maximilian Schäffeler and Mohammad Abdulaziz} +\maketitle + +\abstract{ +We present a formalization of Markov Decision Processes with rewards. +In particular we first build on Hölzl's formalization \cite{Markov_Models-AFP} of MDPs and extend them with rewards. +We proceed with an analysis of the expected total discounted reward criterion for infinite horizon MDPs. +The central result is the construction of the iteration rule for the Bellman operator. +We prove the optimality equations for this operator and show the existence of an optimal stationary deterministic solution. +The analysis can be used to obtain dynamic programming algorithms such as value iteration and policy iteration to solve Markov Decision Processes with formal guarantees. +Our formalization is based upon chapters 5 and 6 in Puterman's book \cite{Puterman}. +} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,645 +1,652 @@ ADS_Functor AI_Planning_Languages_Semantics AODV AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Adaptive_State_Counting Affine_Arithmetic Aggregation_Algebras Akra_Bazzi Algebraic_Numbers Algebraic_VCs Allen_Calculus Amicable_Numbers Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic Arith_Prog_Rel_Primes ArrowImpossibilityGS Attack_Trees Auto2_HOL Auto2_Imperative_HOL AutoFocus-Stream Automated_Stateful_Protocol_Verification Automatic_Refinement AxiomaticCategoryTheory BDD BD_Security_Compositional BNF_CC BNF_Operations BTree Banach_Steinhaus Belief_Revision Bell_Numbers_Spivey BenOr_Kozen_Reif Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BirdKMP Blue_Eyes Bondy Boolean_Expression_Checkers Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CISC-Kernel CRDT CSP_RefTK CYK CZH_Elementary_Categories CZH_Foundations CZH_Universal_Constructions CakeML CakeML_Codegen Call_Arity Card_Equiv_Relations Card_Multisets Card_Number_Partitions Card_Partitions Cartan_FP Case_Labeling Catalan_Numbers Category Category2 Category3 Cauchy Cayley_Hamilton Certification_Monads Chandy_Lamport Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CoCon +CoSMeDis +CoSMed CofGroups Coinductive Coinductive_Languages Collections Combinatorics_Words Combinatorics_Words_Graph_Lemma Combinatorics_Words_Lyndon Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Complete_Non_Orders Completeness Complex_Bounded_Operators Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Conditional_Simplification Conditional_Transfer_Rule Consensus_Refined Constructive_Cryptography Constructive_Cryptography_CM Constructor_Funs Containers CoreC++ Core_DOM Core_SC_DOM Correctness_Algebras -CoSMed -CoSMeDis Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties Cubic_Quartic_Equations DFS_Framework DOM_Components DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Delta_System_Lemma Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Design_Theory Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos Dominance_CHK DynamicArchitectures Dynamic_Tables E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Example-Submission Extended_Finite_State_Machine_Inference Extended_Finite_State_Machines FFT FLP FOL-Fitting FOL_Axiomatic FOL_Harrison FOL_Seq_Calc1 Factor_Algebraic_Polynomial Factored_Transition_System_Bounding Falling_Factorial_Sum Farkas FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite-Map-Extras Finite_Automata_HF Finitely_Generated_Abelian_Groups First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_Puiseux_Series Formal_SSA Formula_Derivatives Foundation_of_geometry Fourier Free-Boolean-Algebra Free-Groups Fresh_Identifiers FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC GaleStewart_Games +Gale_Shapley Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums Gaussian_Integers GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod Goedel_HFSet_Semantic Goedel_HFSet_Semanticless Goedel_Incompleteness Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Grothendieck_Schemes Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Hahn_Jordan_Decomposition Heard_Of Hello_World HereditarilyFinite Hermite Hermite_Lindemann Hidden_Markov_Models Higher_Order_Terms Hoare_Time Hood_Melville_Queue HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL +Hyperdual IEEE_Floating_Point IFC_Tracking IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IMP_Compiler IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interpreter_Optimizations Interval_Arithmetic_Word32 Intro_Dest_Elim Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl IsaGeoCoq Isabelle_C Isabelle_Marries_Dirac Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaDCI JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra +Knights_Tour Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_Master_Theorem LTL_Normal_Form LTL_to_DRA LTL_to_GBA Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_EPO Lambda_Free_KBOs Lambda_Free_RPOs Lambert_W Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Launchbury Laws_of_Large_Numbers Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option Lifting_the_Exponent LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Logging_Independent_Anonymity Lowe_Ontological_Argument Lower_Semicontinuous Lp Lucas_Theorem +MDP-Algorithms +MDP-Rewards MFMC_Countable MFODL_Monitor_Optimized MFOTL_Monitor MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrices_for_ODEs Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Of_Medians_Selection Menger Mereology Mersenne_Primes Metalogic_ProofChecker MiniML MiniSail Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security Modular_arithmetic_LLL_and_HNF_algorithms Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multi_Party_Computation Multirelations Myhill-Nerode Name_Carrying_Type_Inference Nash_Williams Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Octonions OpSets Open_Induction Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinal_Partitions Ordinals_and_Cardinals Ordinary_Differential_Equations PAC_Checker PAL PCF PLM POPLmark-deBruijn PSemigroupsConvolution Padic_Ints Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Pell Perfect-Number-Thm Perron_Frobenius Physical_Quantities Pi_Calculus Pi_Transcendental Planarity_Certificates Poincare_Bendixson Poincare_Disc Polynomial_Factorization Polynomial_Interpolation Polynomials Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Presburger-Automata Prim_Dijkstra_Simple Prime_Distribution_Elementary Prime_Harmonic_Series Prime_Number_Theorem Priority_Queue_Braun Priority_Search_Trees Probabilistic_Noninterference Probabilistic_Prime_Tests Probabilistic_System_Zoo Probabilistic_Timed_Automata Probabilistic_While Program-Conflict-Analysis Progress_Tracking Projective_Geometry Projective_Measurements Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem Public_Announcement_Logic QHLProver QR_Decomposition Quantales Quaternions Quick_Sort_Cost RIPEMD-160-SPARK ROBDD RSAPSS Ramsey-Infinite Random_BSTs Random_Graph_Subgraph_Threshold Randomised_BSTs Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Real_Power Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Registers Regression_Test_Selection Regular-Sets Regular_Algebras +Regular_Tree_Relations Relation_Algebra Relational-Incorrectness-Logic Relational_Disjoint_Set_Forests Relational_Forests Relational_Method Relational_Minimum_Spanning_Trees Relational_Paths Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Robinson_Arithmetic Root_Balanced_Tree +Roth_Arithmetic_Progressions Routing Roy_Floyd_Warshall SATSolverVerification SC_DOM_Components SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_Distance Safe_OCL Saturation_Framework Saturation_Framework_Extensions Schutz_Spacetime Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shadow_DOM Shadow_SC_DOM Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Simplicial_complexes_and_boolean_functions SimplifiedOntologicalArgument Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Sort_Encodings Source_Coding_Theorem SpecCheck Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts Stateful_Protocol_Composition_and_Typing Stellar_Quorums Stern_Brocot Stewart_Apollonius Stirling_Formula Stochastic_Matrices Stone_Algebras Stone_Kleene_Relation_Algebras Stone_Relation_Algebras Store_Buffer_Reduction Stream-Fusion Stream_Fusion_Code Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares Sunflowers SuperCalc Surprise_Paradox Symmetric_Polynomials Syntax_Independent_Logic +Szemeredi_Regularity Szpilrajn -Szemeredi_Regularity TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Three_Circles Timed_Automata Topological_Semantics Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God Types_To_Sets_Extension UPF UPF_Firewall UTP Universal_Turing_Machine UpDown_Scheme Valuation Van_Emde_Boas_Trees Van_der_Waerden VectorSpace VeriComp Verified-Prover Verified_SAT_Based_AI_Planning VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves Virtual_Substitution VolpanoSmith WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly +Weight_Balanced_Trees Weighted_Path_Order -Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval Word_Lib WorkerWrapper X86_Semantics XML ZFC_in_HOL Zeta_3_Irrational Zeta_Function pGCL diff --git a/thys/Regular_Tree_Relations/AGTT.thy b/thys/Regular_Tree_Relations/AGTT.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/AGTT.thy @@ -0,0 +1,190 @@ +theory AGTT + imports GTT GTT_Transitive_Closure Pair_Automaton +begin + + +definition AGTT_union where + "AGTT_union \<G>\<^sub>1 \<G>\<^sub>2 \<equiv> (ta_union (fst \<G>\<^sub>1) (fst \<G>\<^sub>2), + ta_union (snd \<G>\<^sub>1) (snd \<G>\<^sub>2))" + +abbreviation AGTT_union' where + "AGTT_union' \<G>\<^sub>1 \<G>\<^sub>2 \<equiv> AGTT_union (fmap_states_gtt Inl \<G>\<^sub>1) (fmap_states_gtt Inr \<G>\<^sub>2)" + +lemma disj_gtt_states_disj_fst_ta_states: + assumes dist_st: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "\<Q> (fst \<G>\<^sub>1) |\<inter>| \<Q> (fst \<G>\<^sub>2) = {||}" + using assms unfolding gtt_states_def by auto + +lemma disj_gtt_states_disj_snd_ta_states: + assumes dist_st: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "\<Q> (snd \<G>\<^sub>1) |\<inter>| \<Q> (snd \<G>\<^sub>2) = {||}" + using assms unfolding gtt_states_def by auto + +lemma ta_der_not_contains_undefined_state: + assumes "q |\<notin>| \<Q> T" and "ground t" + shows "q |\<notin>| ta_der T t" + using ground_ta_der_states[OF assms(2)] assms(1) + by blast + +lemma AGTT_union_sound1: + assumes dist_st: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "agtt_lang (AGTT_union \<G>\<^sub>1 \<G>\<^sub>2) \<subseteq> agtt_lang \<G>\<^sub>1 \<union> agtt_lang \<G>\<^sub>2" +proof - + let ?TA_A = "ta_union (fst \<G>\<^sub>1) (fst \<G>\<^sub>2)" + let ?TA_B = "ta_union (snd \<G>\<^sub>1) (snd \<G>\<^sub>2)" + {fix s t assume ass: "(s, t) \<in> agtt_lang (AGTT_union \<G>\<^sub>1 \<G>\<^sub>2)" + then obtain q where ls: "q |\<in>| ta_der ?TA_A (term_of_gterm s)" and + rs: "q |\<in>| ta_der ?TA_B (term_of_gterm t)" + by (auto simp add: AGTT_union_def agtt_lang_def gta_der_def) + then have "(s, t) \<in> agtt_lang \<G>\<^sub>1 \<or> (s, t) \<in> agtt_lang \<G>\<^sub>2" + proof (cases "q |\<in>| gtt_states \<G>\<^sub>1") + case True + then have "q |\<notin>| gtt_states \<G>\<^sub>2" using dist_st + by blast + then have nt_fst_st: "q |\<notin>| \<Q> (fst \<G>\<^sub>2)" and + nt_snd_state: "q |\<notin>| \<Q> (snd \<G>\<^sub>2)" by (auto simp add: gtt_states_def) + from True show ?thesis + using ls rs + using ta_der_not_contains_undefined_state[OF nt_fst_st] + using ta_der_not_contains_undefined_state[OF nt_snd_state] + unfolding gtt_states_def agtt_lang_def gta_der_def + using ta_union_der_disj_states[OF disj_gtt_states_disj_fst_ta_states[OF dist_st]] + using ta_union_der_disj_states[OF disj_gtt_states_disj_snd_ta_states[OF dist_st]] + using ground_term_of_gterm by blast + next + case False + then have "q |\<notin>| gtt_states \<G>\<^sub>1" by (metis IntI dist_st emptyE) + then have nt_fst_st: "q |\<notin>| \<Q> (fst \<G>\<^sub>1)" and + nt_snd_state: "q |\<notin>| \<Q> (snd \<G>\<^sub>1)" by (auto simp add: gtt_states_def) + from False show ?thesis + using ls rs + using ta_der_not_contains_undefined_state[OF nt_fst_st] + using ta_der_not_contains_undefined_state[OF nt_snd_state] + unfolding gtt_states_def agtt_lang_def gta_der_def + using ta_union_der_disj_states[OF disj_gtt_states_disj_fst_ta_states[OF dist_st]] + using ta_union_der_disj_states[OF disj_gtt_states_disj_snd_ta_states[OF dist_st]] + using ground_term_of_gterm by blast + qed} + then show ?thesis by auto +qed + +lemma AGTT_union_sound2: + shows "agtt_lang \<G>\<^sub>1 \<subseteq> agtt_lang (AGTT_union \<G>\<^sub>1 \<G>\<^sub>2)" + "agtt_lang \<G>\<^sub>2 \<subseteq> agtt_lang (AGTT_union \<G>\<^sub>1 \<G>\<^sub>2)" + unfolding agtt_lang_def gta_der_def AGTT_union_def + by auto (meson fin_mono ta_der_mono' ta_union_ta_subset)+ + +lemma AGTT_union_sound: + assumes dist_st: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "agtt_lang (AGTT_union \<G>\<^sub>1 \<G>\<^sub>2) = agtt_lang \<G>\<^sub>1 \<union> agtt_lang \<G>\<^sub>2" + using AGTT_union_sound1[OF assms] AGTT_union_sound2 by blast + +lemma AGTT_union'_sound: + fixes \<G>\<^sub>1 :: "('q, 'f) gtt" and \<G>\<^sub>2 :: "('q, 'f) gtt" + shows "agtt_lang (AGTT_union' \<G>\<^sub>1 \<G>\<^sub>2) = agtt_lang \<G>\<^sub>1 \<union> agtt_lang \<G>\<^sub>2" +proof - + have map: "agtt_lang (AGTT_union' \<G>\<^sub>1 \<G>\<^sub>2) = + agtt_lang (fmap_states_gtt CInl \<G>\<^sub>1) \<union> agtt_lang (fmap_states_gtt CInr \<G>\<^sub>2)" + by (intro AGTT_union_sound) (auto simp add: agtt_lang_fmap_states_gtt) + then show ?thesis by (simp add: agtt_lang_fmap_states_gtt finj_CInl_CInr) +qed + +subsection \<open>Anchord gtt compositon\<close> + +definition AGTT_comp :: "('q, 'f) gtt \<Rightarrow> ('q, 'f) gtt \<Rightarrow> ('q, 'f) gtt" where + "AGTT_comp \<G>\<^sub>1 \<G>\<^sub>2 = (let (\<A>, \) = (fst \<G>\<^sub>1, snd \<G>\<^sub>2) in + (TA (rules \<A>) (eps \<A> |\<union>| (\<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2) |\<inter>| (gtt_interface \<G>\<^sub>1 |\<times>| gtt_interface \<G>\<^sub>2))), + TA (rules \) (eps \)))" + +abbreviation AGTT_comp' where + "AGTT_comp' \<G>\<^sub>1 \<G>\<^sub>2 \<equiv> AGTT_comp (fmap_states_gtt Inl \<G>\<^sub>1) (fmap_states_gtt Inr \<G>\<^sub>2)" + +lemma AGTT_comp_sound: + assumes "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "agtt_lang (AGTT_comp \<G>\<^sub>1 \<G>\<^sub>2) = agtt_lang \<G>\<^sub>1 O agtt_lang \<G>\<^sub>2" +proof - + let ?Q\<^sub>1 = "fId_on (gtt_interface \<G>\<^sub>1)" let ?Q\<^sub>2 = "fId_on (gtt_interface \<G>\<^sub>2)" + have lan: "agtt_lang \<G>\<^sub>1 = pair_at_lang \<G>\<^sub>1 ?Q\<^sub>1" "agtt_lang \<G>\<^sub>2 = pair_at_lang \<G>\<^sub>2 ?Q\<^sub>2" + using pair_at_agtt[of \<G>\<^sub>1] pair_at_agtt[of \<G>\<^sub>2] + by auto + have "agtt_lang \<G>\<^sub>1 O agtt_lang \<G>\<^sub>2 = pair_at_lang (fst \<G>\<^sub>1, snd \<G>\<^sub>2) (\<Delta>_eps_pair \<G>\<^sub>1 ?Q\<^sub>1 \<G>\<^sub>2 ?Q\<^sub>2)" + using pair_comp_sound1 pair_comp_sound2 + by (auto simp add: lan pair_comp_sound1 pair_comp_sound2 relcomp.simps) + moreover have "AGTT_comp \<G>\<^sub>1 \<G>\<^sub>2 = pair_at_to_agtt (fst \<G>\<^sub>1, snd \<G>\<^sub>2) (\<Delta>_eps_pair \<G>\<^sub>1 ?Q\<^sub>1 \<G>\<^sub>2 ?Q\<^sub>2)" + by (auto simp: AGTT_comp_def pair_at_to_agtt_def gtt_interface_def \<Delta>\<^sub>\<epsilon>_def' \<Delta>_eps_pair_def) + ultimately show ?thesis using pair_at_agtt_conv[of "\<Delta>_eps_pair \<G>\<^sub>1 ?Q\<^sub>1 \<G>\<^sub>2 ?Q\<^sub>2" "(fst \<G>\<^sub>1, snd \<G>\<^sub>2)"] + using assms + by (auto simp: \<Delta>_eps_pair_def gtt_states_def gtt_interface_def) +qed + +lemma AGTT_comp'_sound: + "agtt_lang (AGTT_comp' \<G>\<^sub>1 \<G>\<^sub>2) = agtt_lang \<G>\<^sub>1 O agtt_lang \<G>\<^sub>2" + using AGTT_comp_sound[of "fmap_states_gtt (Inl :: 'b \<Rightarrow> 'b + 'c) \<G>\<^sub>1" + "fmap_states_gtt (Inr :: 'c \<Rightarrow> 'b + 'c) \<G>\<^sub>2"] + by (auto simp add: agtt_lang_fmap_states_gtt disjoint_iff_not_equal agtt_lang_Inl_Inr_states_agtt) + +subsection \<open>Anchord gtt transitivity\<close> + +definition AGTT_trancl :: "('q, 'f) gtt \<Rightarrow> ('q + 'q, 'f) gtt" where + "AGTT_trancl \<G> = (let \<A> = fmap_states_ta Inl (fst \<G>) in + (TA (rules \<A>) (eps \<A> |\<union>| map_prod CInl CInr |`| (\<Delta>_Atrans_gtt \<G> (fId_on (gtt_interface \<G>)))), + TA (map_ta_rule CInr id |`| (rules (snd \<G>))) (map_both CInr |`| (eps (snd \<G>)))))" + +lemma AGTT_trancl_sound: + shows "agtt_lang (AGTT_trancl \<G>) = (agtt_lang \<G>)\<^sup>+" +proof - + let ?P = "map_prod (fmap_states_ta CInl) (fmap_states_ta CInr) \<G>" + let ?Q = "fId_on (gtt_interface \<G>)" let ?Q' = "map_prod CInl CInr |`| ?Q" + have inv: "finj_on CInl (\<Q> (fst \<G>))" "finj_on CInr (\<Q> (snd \<G>))" + "?Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" + by (auto simp: gtt_interface_def finj_CInl_CInr) + have *: "fst |`| map_prod CInl CInr |`| \<Delta>_Atrans_gtt \<G> (fId_on (gtt_interface \<G>)) |\<subseteq>| CInl |`| \<Q> (fst \<G>)" + using fsubsetD[OF \<Delta>_Atrans_states_stable[OF inv(3)]] + by (auto simp add: gtt_interface_def) + from pair_at_lang_fun_states[OF inv] + have "agtt_lang \<G> = pair_at_lang ?P ?Q'" using pair_at_agtt[of \<G>] by auto + moreover then have "(agtt_lang \<G>)\<^sup>+ = pair_at_lang ?P (\<Delta>_Atrans_gtt ?P ?Q')" + by (simp add: pair_trancl_sound) + moreover have "AGTT_trancl \<G> = pair_at_to_agtt ?P (\<Delta>_Atrans_gtt ?P ?Q')" + using \<Delta>_Atrans_states_stable[OF inv(3)] \<Delta>_Atrans_map_prod[OF inv, symmetric] + using fId_on_frelcomp_id[OF *] + by (auto simp: AGTT_trancl_def pair_at_to_agtt_def gtt_interface_def Let_def fmap_states_ta_def) + (metis fmap_prod_fimageI fmap_states fmap_states_ta_def) + moreover have "gtt_interface (map_prod (fmap_states_ta CInl) (fmap_states_ta CInr) \<G>) = {||}" + by (auto simp: gtt_interface_def) + ultimately show ?thesis using pair_at_agtt_conv[of "\<Delta>_Atrans_gtt ?P ?Q'" ?P] \<Delta>_Atrans_states_stable[OF inv(3)] + unfolding \<Delta>_Atrans_map_prod[OF inv, symmetric] + by (simp add: fimage_mono gtt_interface_def map_prod_ftimes) +qed + +subsection \<open>Anchord gtt triming\<close> + +abbreviation "trim_agtt \<equiv> trim_gtt" + +lemma agtt_only_prod_lang: + "agtt_lang (gtt_only_prod \<G>) = agtt_lang \<G>" (is "?Ls = ?Rs") +proof - + let ?A = "fst \<G>" let ?B = "snd \<G>" + have "?Ls \<subseteq> ?Rs" unfolding agtt_lang_def gtt_only_prod_def + by (auto simp: Let_def gta_der_def dest: ta_der_ta_only_prod_ta_der) + moreover + {fix s t assume "(s, t) \<in> ?Rs" + then obtain q where r: "q |\<in>| ta_der (fst \<G>) (term_of_gterm s)" "q |\<in>| ta_der (snd \<G>) (term_of_gterm t)" + by (auto simp: agtt_lang_def gta_der_def) + then have " q |\<in>| gtt_interface \<G>" by (auto simp: gtt_interface_def) + then have "(s, t) \<in> ?Ls" using r + by (auto simp: agtt_lang_def gta_der_def gtt_only_prod_def Let_def intro!: exI[of _ q] ta_der_only_prod ta_productive_setI)} + ultimately show ?thesis by auto +qed + +lemma agtt_only_reach_lang: + "agtt_lang (gtt_only_reach \<G>) = agtt_lang \<G>" + unfolding agtt_lang_def gtt_only_reach_def + by (auto simp: gta_der_def simp flip: ta_der_gterm_only_reach) + +lemma trim_agtt_lang [simp]: + "agtt_lang (trim_agtt G) = agtt_lang G" + unfolding trim_gtt_def comp_def agtt_only_prod_lang agtt_only_reach_lang .. + + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/GTT.thy b/thys/Regular_Tree_Relations/GTT.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/GTT.thy @@ -0,0 +1,265 @@ +theory GTT + imports Tree_Automata Ground_Closure +begin + +section \<open>Ground Tree Transducers (GTT)\<close> + +(* A GTT \<G> consists of a set of interface states and + a set of rules for automaton \<A> and one for \. *) +type_synonym ('q, 'f) gtt = "('q, 'f) ta \<times> ('q, 'f) ta" + +abbreviation gtt_rules where + "gtt_rules \<G> \<equiv> rules (fst \<G>) |\<union>| rules (snd \<G>)" +abbreviation gtt_eps where + "gtt_eps \<G> \<equiv> eps (fst \<G>) |\<union>| eps (snd \<G>)" +definition gtt_states where + "gtt_states \<G> = \<Q> (fst \<G>) |\<union>| \<Q> (snd \<G>)" +abbreviation gtt_syms where + "gtt_syms \<G> \<equiv> ta_sig (fst \<G>) |\<union>| ta_sig (snd \<G>)" +definition gtt_interface where + "gtt_interface \<G> = \<Q> (fst \<G>) |\<inter>| \<Q> (snd \<G>)" +definition gtt_eps_free where + "gtt_eps_free \<G> = (eps_free (fst \<G>), eps_free (snd \<G>))" + +definition is_gtt_eps_free :: "('q, 'f) ta \<times> ('p, 'g) ta \<Rightarrow> bool" where + "is_gtt_eps_free \<G> \<longleftrightarrow> eps (fst \<G>) = {||} \<and> eps (snd \<G>) = {||}" + +text \<open>*anchored* language accepted by a GTT\<close> + +definition agtt_lang :: "('q, 'f) gtt \<Rightarrow> 'f gterm rel" where + "agtt_lang \<G> = {(t, u) |t u q. q |\<in>| gta_der (fst \<G>) t \<and> q |\<in>| gta_der (snd \<G>) u}" + +lemma agtt_langI: + "q |\<in>| gta_der (fst \<G>) s \<Longrightarrow> q |\<in>| gta_der (snd \<G>) t \<Longrightarrow> (s, t) \<in> agtt_lang \<G>" + by (auto simp: agtt_lang_def) + +lemma agtt_langE: + assumes "(s, t) \<in> agtt_lang \<G>" + obtains q where "q |\<in>| gta_der (fst \<G>) s" "q |\<in>| gta_der (snd \<G>) t" + using assms by (auto simp: agtt_lang_def) + +lemma converse_agtt_lang: + "(agtt_lang \<G>)\<inverse> = agtt_lang (prod.swap \<G>)" + by (auto simp: agtt_lang_def) + +lemma agtt_lang_swap: + "agtt_lang (prod.swap \<G>) = prod.swap ` agtt_lang \<G>" + by (auto simp: agtt_lang_def) + +text \<open>language accepted by a GTT\<close> + +abbreviation gtt_lang :: "('q, 'f) gtt \<Rightarrow> 'f gterm rel" where + "gtt_lang \<G> \<equiv> gmctxt_cl UNIV (agtt_lang \<G>)" + +lemma gtt_lang_join: + "q |\<in>| gta_der (fst \<G>) s \<Longrightarrow> q |\<in>| gta_der (snd \<G>) t \<Longrightarrow> (s, t) \<in> gmctxt_cl UNIV (agtt_lang \<G>)" + by (auto simp: agtt_lang_def) + +definition gtt_accept where + "gtt_accept \<G> s t \<equiv> (s, t) \<in> gmctxt_cl UNIV (agtt_lang \<G>)" + +lemma gtt_accept_intros: + "(s, t) \<in> agtt_lang \<G> \<Longrightarrow> gtt_accept \<G> s t" + "length ss = length ts \<Longrightarrow> \<forall> i < length ts. gtt_accept \<G> (ss ! i) (ts ! i) \<Longrightarrow> + (f, length ss) \<in> \<F> \<Longrightarrow> gtt_accept \<G> (GFun f ss) (GFun f ts)" + by (auto simp: gtt_accept_def) + +abbreviation gtt_lang_terms :: "('q, 'f) gtt \<Rightarrow> ('f, 'q) term rel" where + "gtt_lang_terms \<G> \<equiv> (\<lambda> s. map_both term_of_gterm s) ` (gmctxt_cl UNIV (agtt_lang \<G>))" + +lemma term_of_gterm_gtt_lang_gtt_lang_terms_conv: + "map_both term_of_gterm ` gtt_lang \<G> = gtt_lang_terms \<G>" + by auto + +lemma gtt_accept_swap [simp]: + "gtt_accept (prod.swap \<G>) s t \<longleftrightarrow> gtt_accept \<G> t s" + by (auto simp: gmctxt_cl_swap agtt_lang_swap gtt_accept_def) + +lemma gtt_lang_swap: + "(gtt_lang (A, B))\<inverse> = gtt_lang (B, A)" + using gtt_accept_swap[of "(A, B)"] + by (auto simp: gtt_accept_def) + +(* The following Lemmas are about ta_res' *) + +lemma gtt_accept_exI: + assumes "gtt_accept \<G> s t" + shows "\<exists> u. u |\<in>| ta_der' (fst \<G>) (term_of_gterm s) \<and> u |\<in>| ta_der' (snd \<G>) (term_of_gterm t)" + using assms unfolding gtt_accept_def +proof (induction) + case (base s t) + then show ?case unfolding agtt_lang_def + by (auto simp: gta_der_def ta_der_to_ta_der') +next + case (step ss ts f) + then have inner: "\<exists> us. length us = length ss \<and> + (\<forall>i < length ss. (us ! i) |\<in>| ta_der' (fst \<G>) (term_of_gterm (ss ! i)) \<and> + (us ! i) |\<in>| ta_der' (snd \<G>) (term_of_gterm (ts ! i)))" + using Ex_list_of_length_P[of "length ss" "\<lambda> u i. u |\<in>| ta_der' (fst \<G>) (term_of_gterm (ss ! i)) \<and> + u |\<in>| ta_der' (snd \<G>) (term_of_gterm (ts ! i))"] + by auto + then obtain us where "length us = length ss \<and> (\<forall>i < length ss. + (us ! i) |\<in>| ta_der' (fst \<G>) (term_of_gterm (ss ! i)) \<and> (us ! i) |\<in>| ta_der' (snd \<G>) (term_of_gterm (ts ! i)))" + by blast + then have "Fun f us |\<in>| ta_der' (fst \<G>) (Fun f (map term_of_gterm ss)) \<and> + Fun f us |\<in>| ta_der' (snd \<G>) (Fun f (map term_of_gterm ts))" using step(1) by fastforce + then show ?case by (metis term_of_gterm.simps) +qed + + +lemma agtt_lang_mono: + assumes "rules (fst \<G>) |\<subseteq>| rules (fst \<G>')" "eps (fst \<G>) |\<subseteq>| eps (fst \<G>')" + "rules (snd \<G>) |\<subseteq>| rules (snd \<G>')" "eps (snd \<G>) |\<subseteq>| eps (snd \<G>')" + shows "agtt_lang \<G> \<subseteq> agtt_lang \<G>'" + using fsubsetD[OF ta_der_mono[OF assms(1, 2)]] ta_der_mono[OF assms(3, 4)] + by (auto simp: agtt_lang_def gta_der_def dest!: fsubsetD[OF ta_der_mono[OF assms(1, 2)]] fsubsetD[OF ta_der_mono[OF assms(3, 4)]]) + +lemma gtt_lang_mono: + assumes "rules (fst \<G>) |\<subseteq>| rules (fst \<G>')" "eps (fst \<G>) |\<subseteq>| eps (fst \<G>')" + "rules (snd \<G>) |\<subseteq>| rules (snd \<G>')" "eps (snd \<G>) |\<subseteq>| eps (snd \<G>')" + shows "gtt_lang \<G> \<subseteq> gtt_lang \<G>'" + using agtt_lang_mono[OF assms] + by (intro gmctxt_cl_mono_rel) auto + +definition fmap_states_gtt where + "fmap_states_gtt f \<equiv> map_both (fmap_states_ta f)" + +lemma ground_map_vars_term_simp: + "ground t \<Longrightarrow> map_term f g t = map_term f (\<lambda>_. undefined) t" + by (induct t) auto + +lemma states_fmap_states_gtt [simp]: + "gtt_states (fmap_states_gtt f \<G>) = f |`| gtt_states \<G>" + by (simp add: fimage_funion gtt_states_def fmap_states_gtt_def) + +lemma agtt_lang_fmap_states_gtt: + assumes "finj_on f (gtt_states \<G>)" + shows "agtt_lang (fmap_states_gtt f \<G>) = agtt_lang \<G>" (is "?Ls = ?Rs") +proof - + from assms have inj: "finj_on f (\<Q> (fst \<G>) |\<union>| \<Q> (snd \<G>))" "finj_on f (\<Q> (fst \<G>))" "finj_on f (\<Q> (snd \<G>))" + by (auto simp: gtt_states_def finj_on_fUn) + then have "?Ls \<subseteq> ?Rs" using ta_der_fmap_states_inv_superset[OF _ inj(1)] + by (auto simp: agtt_lang_def gta_der_def fmap_states_gtt_def) + moreover have "?Rs \<subseteq> ?Ls" + by (auto simp: agtt_lang_def gta_der_def fmap_states_gtt_def elim!: ta_der_to_fmap_states_der) + ultimately show ?thesis by blast +qed + +lemma agtt_lang_Inl_Inr_states_agtt: + "agtt_lang (fmap_states_gtt Inl \<G>) = agtt_lang \<G>" + "agtt_lang (fmap_states_gtt Inr \<G>) = agtt_lang \<G>" + by (auto simp: finj_Inl_Inr intro!: agtt_lang_fmap_states_gtt) + +lemma gtt_lang_fmap_states_gtt: + assumes "finj_on f (gtt_states \<G>)" + shows "gtt_lang (fmap_states_gtt f \<G>) = gtt_lang \<G>" (is "?Ls = ?Rs") + unfolding fmap_states_gtt_def + using agtt_lang_fmap_states_gtt[OF assms] + by (simp add: fmap_states_gtt_def) + +definition gtt_only_reach where + "gtt_only_reach = map_both ta_only_reach" + +subsection \<open>(A)GTT reachable states\<close> + +lemma agtt_only_reach_lang: + "agtt_lang (gtt_only_reach \<G>) = agtt_lang \<G>" + unfolding agtt_lang_def gtt_only_reach_def + by (auto simp: gta_der_def simp flip: ta_der_gterm_only_reach) + +lemma gtt_only_reach_lang: + "gtt_lang (gtt_only_reach \<G>) = gtt_lang \<G>" + by (auto simp: agtt_only_reach_lang) + +lemma gtt_only_reach_syms: + "gtt_syms (gtt_only_reach \<G>) |\<subseteq>| gtt_syms \<G>" + by (auto simp: gtt_only_reach_def ta_restrict_def ta_sig_def) + +subsection \<open>(A)GTT productive states\<close> + +definition gtt_only_prod where + "gtt_only_prod \<G> = (let iface = gtt_interface \<G> in + map_both (ta_only_prod iface) \<G>)" + +lemma agtt_only_prod_lang: + "agtt_lang (gtt_only_prod \<G>) = agtt_lang \<G>" (is "?Ls = ?Rs") +proof - + let ?A = "fst \<G>" let ?B = "snd \<G>" + have "?Ls \<subseteq> ?Rs" unfolding agtt_lang_def gtt_only_prod_def + by (auto simp: Let_def gta_der_def dest: ta_der_ta_only_prod_ta_der) + moreover + {fix s t assume "(s, t) \<in> ?Rs" + then obtain q where r: "q |\<in>| ta_der (fst \<G>) (term_of_gterm s)" "q |\<in>| ta_der (snd \<G>) (term_of_gterm t)" + by (auto simp: agtt_lang_def gta_der_def) + then have " q |\<in>| gtt_interface \<G>" by (auto simp: gtt_interface_def) + then have "(s, t) \<in> ?Ls" using r + by (auto simp: agtt_lang_def gta_der_def gtt_only_prod_def Let_def intro!: exI[of _ q] ta_der_only_prod ta_productive_setI)} + ultimately show ?thesis by auto +qed + +lemma gtt_only_prod_lang: + "gtt_lang (gtt_only_prod \<G>) = gtt_lang \<G>" + by (auto simp: agtt_only_prod_lang) + +lemma gtt_only_prod_syms: + "gtt_syms (gtt_only_prod \<G>) |\<subseteq>| gtt_syms \<G>" + by (auto simp: gtt_only_prod_def ta_restrict_def ta_sig_def Let_def) + +subsection \<open>(A)GTT trimming\<close> + +definition trim_gtt where + "trim_gtt = gtt_only_prod \<circ> gtt_only_reach" + +lemma trim_agtt_lang: + "agtt_lang (trim_gtt G) = agtt_lang G" + unfolding trim_gtt_def comp_def agtt_only_prod_lang agtt_only_reach_lang .. + +lemma trim_gtt_lang: + "gtt_lang (trim_gtt G) = gtt_lang G" + unfolding trim_gtt_def comp_def gtt_only_prod_lang gtt_only_reach_lang .. + +lemma trim_gtt_prod_syms: + "gtt_syms (trim_gtt G) |\<subseteq>| gtt_syms G" + unfolding trim_gtt_def using fsubset_trans[OF gtt_only_prod_syms gtt_only_reach_syms] by simp + +subsection \<open>root-cleanliness\<close> + +text \<open>A GTT is root-clean if none of its interface states can occur in a non-root positions + in the accepting derivations corresponding to its anchored GTT relation.\<close> + +definition ta_nr_states :: "('q, 'f) ta \<Rightarrow> 'q fset" where + "ta_nr_states A = |\<Union>| ((fset_of_list \<circ> r_lhs_states) |`| (rules A))" + +definition gtt_nr_states where + "gtt_nr_states G = ta_nr_states (fst G) |\<union>| ta_nr_states (snd G)" + +definition gtt_root_clean where + "gtt_root_clean G \<longleftrightarrow> gtt_nr_states G |\<inter>| gtt_interface G = {||}" + + +subsection \<open>Relabeling\<close> + +definition relabel_gtt :: "('q :: linorder, 'f) gtt \<Rightarrow> (nat, 'f) gtt" where + "relabel_gtt G = fmap_states_gtt (map_fset_to_nat (gtt_states G)) G" + +lemma relabel_agtt_lang [simp]: + "agtt_lang (relabel_gtt G) = agtt_lang G" + by (simp add: agtt_lang_fmap_states_gtt map_fset_to_nat_inj relabel_gtt_def) + +lemma agtt_lang_sig: + "fset (gtt_syms G) \<subseteq> \<F> \<Longrightarrow> agtt_lang G \<subseteq> \<T>\<^sub>G \<F> \<times> \<T>\<^sub>G \<F>" + by (auto simp: agtt_lang_def gta_der_def \<T>\<^sub>G_equivalent_def) + (metis ffunas_gterm.rep_eq less_eq_fset.rep_eq subset_iff ta_der_gterm_sig)+ + +subsection \<open>epsilon free GTTs\<close> + + +lemma agtt_lang_gtt_eps_free [simp]: + "agtt_lang (gtt_eps_free \<G>) = agtt_lang \<G>" + by (auto simp: agtt_lang_def gta_der_def gtt_eps_free_def ta_res_eps_free) + +lemma gtt_lang_gtt_eps_free [simp]: + "gtt_lang (gtt_eps_free \<G>) = gtt_lang \<G>" + by auto + +end diff --git a/thys/Regular_Tree_Relations/GTT_Compose.thy b/thys/Regular_Tree_Relations/GTT_Compose.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/GTT_Compose.thy @@ -0,0 +1,403 @@ +theory GTT_Compose + imports GTT +begin + +subsection \<open>GTT closure under composition\<close> + +inductive_set \<Delta>\<^sub>\<epsilon>_set :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) set" for \<A> \ where + \<Delta>\<^sub>\<epsilon>_set_cong: "TA_rule f ps p |\<in>| rules \<A> \<Longrightarrow> TA_rule f qs q |\<in>| rules \ \<Longrightarrow> length ps = length qs \<Longrightarrow> + (\<And>i. i < length qs \<Longrightarrow> (ps ! i, qs ! i) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \) \<Longrightarrow> (p, q) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \" +| \<Delta>\<^sub>\<epsilon>_set_eps1: "(p, p') |\<in>| eps \<A> \<Longrightarrow> (p, q) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \ \<Longrightarrow> (p', q) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \" +| \<Delta>\<^sub>\<epsilon>_set_eps2: "(q, q') |\<in>| eps \ \<Longrightarrow> (p, q) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \ \<Longrightarrow> (p, q') \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \" + +lemma \<Delta>\<^sub>\<epsilon>_states: "\<Delta>\<^sub>\<epsilon>_set \<A> \ \<subseteq> fset (\<Q> \<A> |\<times>| \<Q> \)" +proof - + {fix p q assume "(p, q) \<in> \<Delta>\<^sub>\<epsilon>_set \<A> \" then have "(p, q) \<in> fset (\<Q> \<A> |\<times>| \<Q> \)" + by (induct) (auto dest: rule_statesD eps_statesD simp flip: fmember.rep_eq)} + then show ?thesis by auto +qed + +lemma finite_\<Delta>\<^sub>\<epsilon> [simp]: "finite (\<Delta>\<^sub>\<epsilon>_set \<A> \)" + using finite_subset[OF \<Delta>\<^sub>\<epsilon>_states] + by simp + +context +includes fset.lifting +begin +lift_definition \<Delta>\<^sub>\<epsilon> :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) fset" is \<Delta>\<^sub>\<epsilon>_set by simp +lemmas \<Delta>\<^sub>\<epsilon>_cong = \<Delta>\<^sub>\<epsilon>_set_cong [Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_eps1 = \<Delta>\<^sub>\<epsilon>_set_eps1 [Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_eps2 = \<Delta>\<^sub>\<epsilon>_set_eps2 [Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_cases = \<Delta>\<^sub>\<epsilon>_set.cases[Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_induct [consumes 1, case_names \<Delta>\<^sub>\<epsilon>_cong \<Delta>\<^sub>\<epsilon>_eps1 \<Delta>\<^sub>\<epsilon>_eps2] = \<Delta>\<^sub>\<epsilon>_set.induct[Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_intros = \<Delta>\<^sub>\<epsilon>_set.intros[Transfer.transferred] +lemmas \<Delta>\<^sub>\<epsilon>_simps = \<Delta>\<^sub>\<epsilon>_set.simps[Transfer.transferred] +end + +lemma finite_alt_def [simp]: + "finite {(\<alpha>, \<beta>). (\<exists>t. ground t \<and> \<alpha> |\<in>| ta_der \<A> t \<and> \<beta> |\<in>| ta_der \ t)}" (is "finite ?S") + by (auto dest: ground_ta_der_states[THEN fsubsetD] simp flip: fmember.rep_eq + intro!: finite_subset[of ?S "fset (\<Q> \<A> |\<times>| \<Q> \)"]) + +lemma \<Delta>\<^sub>\<epsilon>_def': + "\<Delta>\<^sub>\<epsilon> \<A> \ = {|(\<alpha>, \<beta>). (\<exists>t. ground t \<and> \<alpha> |\<in>| ta_der \<A> t \<and> \<beta> |\<in>| ta_der \ t)|}" +proof (intro fset_eqI iffI, goal_cases lr rl) + case (lr x) obtain p q where x [simp]: "x = (p, q)" by (cases x) + have "\<exists>t. ground t \<and> p |\<in>| ta_der \<A> t \<and> q |\<in>| ta_der \ t" using lr unfolding x + proof (induct rule: \<Delta>\<^sub>\<epsilon>_induct) + case (\<Delta>\<^sub>\<epsilon>_cong f ps p qs q) + obtain ts where ts: "ground (ts i) \<and> ps ! i |\<in>| ta_der \<A> (ts i) \<and> qs ! i |\<in>| ta_der \ (ts i)" + if "i < length qs" for i using \<Delta>\<^sub>\<epsilon>_cong(5) by metis + then show ?case using \<Delta>\<^sub>\<epsilon>_cong(1-3) + by (auto intro!: exI[of _ "Fun f (map ts [0..<length qs])"]) blast+ + qed (meson ta_der_eps)+ + then show ?case by auto +next + case (rl x) obtain p q where x [simp]: "x = (p, q)" by (cases x) + obtain t where "ground t" "p |\<in>| ta_der \<A> t" "q |\<in>| ta_der \ t" using rl by auto + then show ?case unfolding x + proof (induct t arbitrary: p q) + case (Fun f ts) + obtain p' ps where p': "TA_rule f ps p' |\<in>| rules \<A>" "p' = p \<or> (p', p) |\<in>| (eps \<A>)|\<^sup>+|" "length ps = length ts" + "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (ts ! i)" using Fun(3) by auto + obtain q' qs where q': "f qs \<rightarrow> q' |\<in>| rules \" "q' = q \<or> (q', q) |\<in>| (eps \)|\<^sup>+|" "length qs = length ts" + "\<And>i. i < length ts \<Longrightarrow> qs ! i |\<in>| ta_der \ (ts ! i)" using Fun(4) by auto + have st: "(p', q') |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \" + using Fun(1)[OF nth_mem _ p'(4) q'(4)] Fun(2) p'(3) q'(3) + by (intro \<Delta>\<^sub>\<epsilon>_cong[OF p'(1) q'(1)]) auto + {assume "(p', p) |\<in>| (eps \<A>)|\<^sup>+|" then have "(p, q') |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \" using st + by (induct rule: ftrancl_induct) (auto intro: \<Delta>\<^sub>\<epsilon>_eps1)} + from st this p'(2) have st: "(p, q') |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \" by auto + {assume "(q', q) |\<in>| (eps \)|\<^sup>+|" then have "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \" using st + by (induct rule: ftrancl_induct) (auto intro: \<Delta>\<^sub>\<epsilon>_eps2)} + from st this q'(2) show "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \" by auto + qed auto +qed + +lemma \<Delta>\<^sub>\<epsilon>_fmember: + "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \ \<longleftrightarrow> (\<exists>t. ground t \<and> p |\<in>| ta_der \<A> t \<and> q |\<in>| ta_der \ t)" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def') + +definition GTT_comp :: "('q, 'f) gtt \<Rightarrow> ('q, 'f) gtt \<Rightarrow> ('q, 'f) gtt" where + "GTT_comp \<G>\<^sub>1 \<G>\<^sub>2 = + (let \<Delta> = \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2) in + (TA (gtt_rules (fst \<G>\<^sub>1, fst \<G>\<^sub>2)) (eps (fst \<G>\<^sub>1) |\<union>| eps (fst \<G>\<^sub>2) |\<union>| \<Delta>), + TA (gtt_rules (snd \<G>\<^sub>1, snd \<G>\<^sub>2)) (eps (snd \<G>\<^sub>1) |\<union>| eps (snd \<G>\<^sub>2) |\<union>| (\<Delta>|\<inverse>|))))" + +lemma gtt_syms_GTT_comp: + "gtt_syms (GTT_comp A B) = gtt_syms A |\<union>| gtt_syms B" + by (auto simp: GTT_comp_def ta_sig_def Let_def) + +lemma \<Delta>\<^sub>\<epsilon>_statesD: + "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \ \<Longrightarrow> p |\<in>| \<Q> \<A>" + "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \ \<Longrightarrow> q |\<in>| \<Q> \" + using subsetD[OF \<Delta>\<^sub>\<epsilon>_states, of "(p, q)" \<A> \] + by (auto simp flip: \<Delta>\<^sub>\<epsilon>.rep_eq fmember.rep_eq) + +lemma \<Delta>\<^sub>\<epsilon>_statesD': + "q |\<in>| eps_states (\<Delta>\<^sub>\<epsilon> \<A> \) \<Longrightarrow> q |\<in>| \<Q> \<A> |\<union>| \<Q> \" + by (auto simp: eps_states_def fmember.abs_eq dest: \<Delta>\<^sub>\<epsilon>_statesD) + +lemma \<Delta>\<^sub>\<epsilon>_swap: + "prod.swap p |\<in>| \<Delta>\<^sub>\<epsilon> \<A> \ \<longleftrightarrow> p |\<in>| \<Delta>\<^sub>\<epsilon> \ \<A>" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def') + +lemma \<Delta>\<^sub>\<epsilon>_inverse [simp]: + "(\<Delta>\<^sub>\<epsilon> \<A> \)|\<inverse>| = \<Delta>\<^sub>\<epsilon> \ \<A>" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def') + + +lemma gtt_states_comp_union: + "gtt_states (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2) |\<subseteq>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" +proof (intro fsubsetI, goal_cases lr) + case (lr q) then show ?case + by (auto simp: GTT_comp_def gtt_states_def \<Q>_def dest: \<Delta>\<^sub>\<epsilon>_statesD') +qed + +lemma GTT_comp_swap [simp]: + "GTT_comp (prod.swap \<G>\<^sub>2) (prod.swap \<G>\<^sub>1) = prod.swap (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)" + by (simp add: GTT_comp_def ac_simps) + +lemma gtt_comp_complete_semi: + assumes s: "q |\<in>| gta_der (fst \<G>\<^sub>1) s" and u: "q |\<in>| gta_der (snd \<G>\<^sub>1) u" and ut: "gtt_accept \<G>\<^sub>2 u t" + shows "q |\<in>| gta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) s" "q |\<in>| gta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) t" +proof (goal_cases L R) + let ?\<G> = "GTT_comp \<G>\<^sub>1 \<G>\<^sub>2" + have sub1l: "rules (fst \<G>\<^sub>1) |\<subseteq>| rules (fst ?\<G>)" "eps (fst \<G>\<^sub>1) |\<subseteq>| eps (fst ?\<G>)" + and sub1r: "rules (snd \<G>\<^sub>1) |\<subseteq>| rules (snd ?\<G>)" "eps (snd \<G>\<^sub>1) |\<subseteq>| eps (snd ?\<G>)" + and sub2r: "rules (snd \<G>\<^sub>2) |\<subseteq>| rules (snd ?\<G>)" "eps (snd \<G>\<^sub>2) |\<subseteq>| eps (snd ?\<G>)" + by (auto simp: GTT_comp_def) + { case L then show ?case using s ta_der_mono[OF sub1l] + by (auto simp: gta_der_def) + next + case R then show ?case using ut u unfolding gtt_accept_def + proof (induct arbitrary: q s) + case (base s t) + from base(1) obtain p where p: "p |\<in>| gta_der (fst \<G>\<^sub>2) s" "p |\<in>| gta_der (snd \<G>\<^sub>2) t" + by (auto simp: agtt_lang_def) + then have "(p, q) |\<in>| eps (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2))" + using \<Delta>\<^sub>\<epsilon>_fmember[of p q "fst \<G>\<^sub>2" "snd \<G>\<^sub>1"] base(2) + by (auto simp: GTT_comp_def gta_der_def) + from ta_der_eps[OF this] show ?case using p ta_der_mono[OF sub2r] + by (auto simp add: gta_der_def) + next + case (step ss ts f) + from step(1, 4) obtain ps p where "TA_rule f ps p |\<in>| rules (snd \<G>\<^sub>1)" "p = q \<or> (p, q) |\<in>| (eps (snd \<G>\<^sub>1))|\<^sup>+|" + "length ps = length ts" "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| gta_der (snd \<G>\<^sub>1) (ss ! i)" + unfolding gta_der_def by auto + then show ?case using step(1, 2) sub1r(1) ftrancl_mono[OF _ sub1r(2)] + by (auto simp: gta_der_def intro!: exI[of _ p] exI[of _ ps]) + qed} +qed + +lemmas gtt_comp_complete_semi' = gtt_comp_complete_semi[of _ "prod.swap \<G>\<^sub>2" _ _ "prod.swap \<G>\<^sub>1" for \<G>\<^sub>1 \<G>\<^sub>2, + unfolded fst_swap snd_swap GTT_comp_swap gtt_accept_swap] + +lemma gtt_comp_acomplete: + "gcomp_rel UNIV (agtt_lang \<G>\<^sub>1) (agtt_lang \<G>\<^sub>2) \<subseteq> agtt_lang (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)" +proof (intro subrelI, goal_cases LR) + case (LR s t) + then consider + q u where "q |\<in>| gta_der (fst \<G>\<^sub>1) s" "q |\<in>| gta_der (snd \<G>\<^sub>1) u" "gtt_accept \<G>\<^sub>2 u t" + | q u where "q |\<in>| gta_der (snd \<G>\<^sub>2) t" "q |\<in>| gta_der (fst \<G>\<^sub>2) u" "gtt_accept \<G>\<^sub>1 s u" + by (auto simp: gcomp_rel_def gtt_accept_def elim!: agtt_langE) + then show ?case + proof (cases) + case 1 show ?thesis using gtt_comp_complete_semi[OF 1] + by (auto simp: agtt_lang_def gta_der_def) + next + case 2 show ?thesis using gtt_comp_complete_semi'[OF 2] + by (auto simp: agtt_lang_def gta_der_def) + qed +qed + +lemma \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>2: + assumes "(q, q') |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+|" "q |\<in>| gtt_states \<G>\<^sub>2" + "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "(q, q') |\<in>| (eps (fst \<G>\<^sub>2))|\<^sup>+| \<and> q' |\<in>| gtt_states \<G>\<^sub>2" + using assms(1-2) +proof (induct rule: converse_ftrancl_induct) + case (Base y) + then show ?case using assms(3) + by (fastforce simp: GTT_comp_def gtt_states_def fmember.abs_eq dest: eps_statesD \<Delta>\<^sub>\<epsilon>_statesD(1)) +next + case (Step q p) + have "(q, p) |\<in>| (eps (fst \<G>\<^sub>2))|\<^sup>+|" "p |\<in>| gtt_states \<G>\<^sub>2" + using Step(1, 4) assms(3) + by (auto simp: GTT_comp_def gtt_states_def fmember.abs_eq dest: eps_statesD \<Delta>\<^sub>\<epsilon>_statesD(1)) + then show ?case using Step(3) + by (auto intro: ftrancl_trans) +qed + +lemma \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1: + assumes "(p, r) |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+|" "p |\<in>| gtt_states \<G>\<^sub>1" + "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + obtains "r |\<in>| gtt_states \<G>\<^sub>1" "(p, r) |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" + | q p' where "r |\<in>| gtt_states \<G>\<^sub>2" "p = p' \<or> (p, p') |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" "(p', q) |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2)" + "q = r \<or> (q, r) |\<in>| (eps (fst \<G>\<^sub>2))|\<^sup>+|" + using assms(1,2) +proof (induct arbitrary: thesis rule: converse_ftrancl_induct) + case (Base p) + from Base(1) consider (a) "(p, r) |\<in>| eps (fst \<G>\<^sub>1)" | (b) "(p, r) |\<in>| eps (fst \<G>\<^sub>2)" | + (c) "(p, r) |\<in>| (\<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2))" + by (auto simp: GTT_comp_def fmember.abs_eq) + then show ?case using assms(3) Base + by cases (auto simp: GTT_comp_def gtt_states_def fmember.abs_eq dest: eps_statesD \<Delta>\<^sub>\<epsilon>_statesD) +next + case (Step q p) + consider "(q, p) |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" "p |\<in>| gtt_states \<G>\<^sub>1" + | "(q, p) |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2)" "p |\<in>| gtt_states \<G>\<^sub>2" using assms(3) Step(1, 6) + by (auto simp: GTT_comp_def gtt_states_def fmember.abs_eq dest: eps_statesD \<Delta>\<^sub>\<epsilon>_statesD) + then show ?case + proof (cases) + case 1 note a = 1 show ?thesis + proof (cases rule: Step(3)) + case (2 p' q) + then show ?thesis using assms a + by (auto intro: Step(5) ftrancl_trans) + qed (auto simp: a(2) intro: Step(4) ftrancl_trans[OF a(1)]) + next + case 2 show ?thesis using \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>2[OF Step(2) 2(2) assms(3)] Step(5)[OF _ _ 2(1)] by auto + qed +qed + +lemma \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1_\<G>\<^sub>2: + assumes "(q, q') |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+|" "q |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" + "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + obtains "q |\<in>| gtt_states \<G>\<^sub>1" "q' |\<in>| gtt_states \<G>\<^sub>1" "(q, q') |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" + | p p' where "q |\<in>| gtt_states \<G>\<^sub>1" "q' |\<in>| gtt_states \<G>\<^sub>2" "q = p \<or> (q, p) |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" + "(p, p') |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2)" "p' = q' \<or> (p', q') |\<in>| (eps (fst \<G>\<^sub>2))|\<^sup>+|" + | "q |\<in>| gtt_states \<G>\<^sub>2" "(q, q') |\<in>| (eps (fst \<G>\<^sub>2))|\<^sup>+| \<and> q' |\<in>| gtt_states \<G>\<^sub>2" + using assms \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1 \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>2 + by (metis funion_iff) + +lemma GTT_comp_eps_fst_statesD: + "(p, q) |\<in>| eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) \<Longrightarrow> p |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" + "(p, q) |\<in>| eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) \<Longrightarrow> q |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" + by (auto simp: GTT_comp_def gtt_states_def fmember.abs_eq dest: eps_statesD \<Delta>\<^sub>\<epsilon>_statesD) + +lemma GTT_comp_eps_ftrancl_fst_statesD: + "(p, q) |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+| \<Longrightarrow> p |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" + "(p, q) |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+| \<Longrightarrow> q |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" + using GTT_comp_eps_fst_statesD[of _ _ \<G>\<^sub>1 \<G>\<^sub>2] + by (meson converse_ftranclE ftranclE)+ + +lemma GTT_comp_first: + assumes "q |\<in>| ta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) t" "q |\<in>| gtt_states \<G>\<^sub>1" + "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "q |\<in>| ta_der (fst \<G>\<^sub>1) t" + using assms(1,2) +proof (induct t arbitrary: q) + case (Var q') + have "q \<noteq> q' \<Longrightarrow> q' |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" using Var + by (auto dest: GTT_comp_eps_ftrancl_fst_statesD) + then show ?case using Var assms(3) + by (auto elim: \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1_\<G>\<^sub>2) +next + case (Fun f ts) + obtain q' qs where q': "TA_rule f qs q' |\<in>| rules (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2))" + "q' = q \<or> (q', q) |\<in>| (eps (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+|" "length qs = length ts" + "\<And>i. i < length ts \<Longrightarrow> qs ! i |\<in>| ta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) (ts ! i)" + using Fun(2) by auto + have "q' |\<in>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" using q'(1) + by (auto simp: GTT_comp_def gtt_states_def dest: rule_statesD) + then have st: "q' |\<in>| gtt_states \<G>\<^sub>1" and eps:"q' = q \<or> (q', q) |\<in>| (eps (fst \<G>\<^sub>1))|\<^sup>+|" + using q'(2) Fun(3) assms(3) + by (auto elim!: \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1_\<G>\<^sub>2) + from st have rule: "TA_rule f qs q' |\<in>| rules (fst \<G>\<^sub>1)" using assms(3) q'(1) + by (auto simp: GTT_comp_def gtt_states_def dest: rule_statesD) + have "i < length ts \<Longrightarrow> qs ! i |\<in>| ta_der (fst \<G>\<^sub>1) (ts ! i)" for i + using rule q'(3, 4) + by (intro Fun(1)[OF nth_mem]) (auto simp: gtt_states_def dest!: rule_statesD(4)) + then show ?case using q'(3) rule eps + by auto +qed + +lemma GTT_comp_second: + assumes "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" "q |\<in>| gtt_states \<G>\<^sub>2" + "q |\<in>| ta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) t" + shows "q |\<in>| ta_der (snd \<G>\<^sub>2) t" + using assms GTT_comp_first[of q "prod.swap \<G>\<^sub>2" "prod.swap \<G>\<^sub>1"] + by (auto simp: gtt_states_def) + +lemma gtt_comp_sound_semi: + fixes \<G>\<^sub>1 \<G>\<^sub>2 :: "('f, 'q) gtt" + assumes as2: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + and 1: "q |\<in>| gta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) s" "q |\<in>| gta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) t" "q |\<in>| gtt_states \<G>\<^sub>1" + shows "\<exists>u. q |\<in>| gta_der (snd \<G>\<^sub>1) u \<and> gtt_accept \<G>\<^sub>2 u t" using 1(2,3) unfolding gta_der_def +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + show ?case + proof (cases "p |\<in>| gtt_states \<G>\<^sub>1") + case True + then have *: "TA_rule f ps p |\<in>| rules (snd \<G>\<^sub>1)" using GFun(1, 6) as2 + by (auto simp: GTT_comp_def gtt_states_def dest: rule_statesD) + moreover have st: "i < length ps \<Longrightarrow> ps ! i |\<in>| gtt_states \<G>\<^sub>1" for i using * + by (force simp: gtt_states_def dest: rule_statesD) + moreover have "i < length ps \<Longrightarrow> \<exists>u. ps ! i |\<in>| ta_der (snd \<G>\<^sub>1) (term_of_gterm u) \<and> gtt_accept \<G>\<^sub>2 u (ts ! i)" for i + using st GFun(2) by (intro GFun(5)) simp + then obtain us where + "\<And>i. i < length ps \<Longrightarrow> ps ! i |\<in>| ta_der (snd \<G>\<^sub>1) (term_of_gterm (us i)) \<and> gtt_accept \<G>\<^sub>2 (us i) (ts ! i)" + by metis + moreover have "p = q \<or> (p, q) |\<in>| (eps (snd \<G>\<^sub>1))|\<^sup>+|" using GFun(3, 6) True as2 + by (auto simp: gtt_states_def elim!: \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1_\<G>\<^sub>2[of p q "prod.swap \<G>\<^sub>2" "prod.swap \<G>\<^sub>1", simplified]) + ultimately show ?thesis using GFun(2) + by (intro exI[of _ "GFun f (map us [0..<length ts])"]) + (auto simp: gtt_accept_def intro!: exI[of _ ps] exI[of _ p]) + next + case False note nt_st = this + then have False: "p \<noteq> q" using GFun(6) by auto + then have eps: "(p, q) |\<in>| (eps (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)))|\<^sup>+|" using GFun(3) by simp + show ?thesis using \<Delta>\<^sub>\<epsilon>_steps_from_\<G>\<^sub>1_\<G>\<^sub>2[of p q "prod.swap \<G>\<^sub>2" "prod.swap \<G>\<^sub>1", simplified, OF eps] + proof (cases, goal_cases) + case 1 then show ?case using False GFun(3) + by (metis GTT_comp_eps_ftrancl_fst_statesD(1) GTT_comp_swap fst_swap funion_iff) + next + case 2 then show ?case using as2 by (auto simp: gtt_states_def) + next + case 3 then show ?case using as2 GFun(6) by (auto simp: gtt_states_def) + next + case (4 r p') + have meet: "r |\<in>| ta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) (Fun f (map term_of_gterm ts))" + using GFun(1 - 4) 4(3) False + by (auto simp: GTT_comp_def in_ftrancl_UnI intro!: exI[ of _ ps] exI[ of _ p]) + then obtain u where wit: "ground u" "p' |\<in>| ta_der (snd \<G>\<^sub>1) u" "r |\<in>| ta_der (fst \<G>\<^sub>2) u" + using 4(4-) unfolding \<Delta>\<^sub>\<epsilon>_def' by blast + from wit(1, 3) have "gtt_accept \<G>\<^sub>2 (gterm_of_term u) (GFun f ts)" + using GTT_comp_second[OF as2 _ meet] unfolding gtt_accept_def + by (intro gmctxt_cl.base agtt_langI[of r]) + (auto simp add: gta_der_def gtt_states_def simp del: ta_der_Fun dest: ground_ta_der_states) + then show ?case using 4(5) wit(1, 2) + by (intro exI[of _ "gterm_of_term u"]) (auto simp add: ta_der_trancl_eps) + next + case 5 + then show ?case using nt_st as2 + by (simp add: gtt_states_def) + qed + qed +qed + +lemma gtt_comp_asound: + assumes "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "agtt_lang (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2) \<subseteq> gcomp_rel UNIV (agtt_lang \<G>\<^sub>1) (agtt_lang \<G>\<^sub>2)" +proof (intro subrelI, goal_cases LR) + case (LR s t) + obtain q where q: "q |\<in>| gta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) s" "q |\<in>| gta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) t" + using LR by (auto simp: agtt_lang_def) + { (* prepare symmetric cases: q |\<in>| gtt_states \<G>\<^sub>1 and q |\<in>| gtt_states \<G>\<^sub>2 *) + fix \<G>\<^sub>1 \<G>\<^sub>2 s t assume as2: "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + and 1: "q |\<in>| ta_der (fst (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) (term_of_gterm s)" + "q |\<in>| ta_der (snd (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)) (term_of_gterm t)" "q |\<in>| gtt_states \<G>\<^sub>1" + note st = GTT_comp_first[OF 1(1,3) as2] + obtain u where u: "q |\<in>| ta_der (snd \<G>\<^sub>1) (term_of_gterm u)" "gtt_accept \<G>\<^sub>2 u t" + using gtt_comp_sound_semi[OF as2 1[folded gta_der_def]] by (auto simp: gta_der_def) + have "(s, u) \<in> agtt_lang \<G>\<^sub>1" using st u(1) + by (auto simp: agtt_lang_def gta_der_def) + moreover have "(u, t) \<in> gtt_lang \<G>\<^sub>2" using u(2) + by (auto simp: gtt_accept_def) + ultimately have "(s, t) \<in> agtt_lang \<G>\<^sub>1 O gmctxt_cl UNIV (agtt_lang \<G>\<^sub>2)" + by auto} + note base = this + consider "q |\<in>| gtt_states \<G>\<^sub>1" | "q |\<in>| gtt_states \<G>\<^sub>2" | "q |\<notin>| gtt_states \<G>\<^sub>1 |\<union>| gtt_states \<G>\<^sub>2" by blast + then show ?case using q assms + proof (cases, goal_cases) + case 1 then show ?case using base[of \<G>\<^sub>1 \<G>\<^sub>2 s t] + by (auto simp: gcomp_rel_def gta_der_def) + next + case 2 then show ?case using base[of "prod.swap \<G>\<^sub>2" "prod.swap \<G>\<^sub>1" t s, THEN converseI] + by (auto simp: gcomp_rel_def converse_relcomp converse_agtt_lang gta_der_def gtt_states_def) + (simp add: finter_commute funion_commute gtt_lang_swap prod.swap_def)+ + next + case 3 then show ?case using fsubsetD[OF gtt_states_comp_union[of \<G>\<^sub>1 \<G>\<^sub>2], of q] + by (auto simp: gta_der_def gtt_states_def) + qed +qed + +lemma gtt_comp_lang_complete: + shows "gtt_lang \<G>\<^sub>1 O gtt_lang \<G>\<^sub>2 \<subseteq> gtt_lang (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2)" + using gmctxt_cl_mono_rel[OF gtt_comp_acomplete, of UNIV \<G>\<^sub>1 \<G>\<^sub>2] + by (simp only: gcomp_rel[symmetric]) + +lemma gtt_comp_alang: + assumes "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "agtt_lang (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2) = gcomp_rel UNIV (agtt_lang \<G>\<^sub>1) (agtt_lang \<G>\<^sub>2)" + by (intro equalityI gtt_comp_asound[OF assms] gtt_comp_acomplete) + +lemma gtt_comp_lang: + assumes "gtt_states \<G>\<^sub>1 |\<inter>| gtt_states \<G>\<^sub>2 = {||}" + shows "gtt_lang (GTT_comp \<G>\<^sub>1 \<G>\<^sub>2) = gtt_lang \<G>\<^sub>1 O gtt_lang \<G>\<^sub>2" + by (simp only: arg_cong[OF gtt_comp_alang[OF assms], of "gmctxt_cl UNIV"] gcomp_rel) + +abbreviation GTT_comp' where + "GTT_comp' \<G>\<^sub>1 \<G>\<^sub>2 \<equiv> GTT_comp (fmap_states_gtt Inl \<G>\<^sub>1) (fmap_states_gtt Inr \<G>\<^sub>2)" + +lemma gtt_comp'_alang: + shows "agtt_lang (GTT_comp' \<G>\<^sub>1 \<G>\<^sub>2) = gcomp_rel UNIV (agtt_lang \<G>\<^sub>1) (agtt_lang \<G>\<^sub>2)" +proof - + have [simp]: "finj_on Inl (gtt_states \<G>\<^sub>1)" "finj_on Inr (gtt_states \<G>\<^sub>2)" + by (auto simp add: finj_on.rep_eq) + then show ?thesis + by (subst gtt_comp_alang) (auto simp: agtt_lang_fmap_states_gtt) +qed + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/GTT_Transitive_Closure.thy b/thys/Regular_Tree_Relations/GTT_Transitive_Closure.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/GTT_Transitive_Closure.thy @@ -0,0 +1,286 @@ +theory GTT_Transitive_Closure + imports GTT_Compose +begin + +subsection \<open>GTT closure under transitivity\<close> + +inductive_set \<Delta>_trancl_set :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) set" for A B where + \<Delta>_set_cong: "TA_rule f ps p |\<in>| rules A \<Longrightarrow> TA_rule f qs q |\<in>| rules B \<Longrightarrow> length ps = length qs \<Longrightarrow> + (\<And>i. i < length qs \<Longrightarrow> (ps ! i, qs ! i) \<in> \<Delta>_trancl_set A B) \<Longrightarrow> (p, q) \<in> \<Delta>_trancl_set A B" +| \<Delta>_set_eps1: "(p, p') |\<in>| eps A \<Longrightarrow> (p, q) \<in> \<Delta>_trancl_set A B \<Longrightarrow> (p', q) \<in> \<Delta>_trancl_set A B" +| \<Delta>_set_eps2: "(q, q') |\<in>| eps B \<Longrightarrow> (p, q) \<in> \<Delta>_trancl_set A B \<Longrightarrow> (p, q') \<in> \<Delta>_trancl_set A B" +| \<Delta>_set_trans: "(p, q) \<in> \<Delta>_trancl_set A B \<Longrightarrow> (q, r) \<in> \<Delta>_trancl_set A B \<Longrightarrow> (p, r) \<in> \<Delta>_trancl_set A B" + +lemma \<Delta>_trancl_set_states: "\<Delta>_trancl_set \<A> \ \<subseteq> fset (\<Q> \<A> |\<times>| \<Q> \)" +proof - + {fix p q assume "(p, q) \<in> \<Delta>_trancl_set \<A> \" then have "(p, q) \<in> fset (\<Q> \<A> |\<times>| \<Q> \)" + by (induct) (auto dest: rule_statesD eps_statesD simp flip: fmember.rep_eq)} + then show ?thesis by auto +qed + +lemma finite_\<Delta>_trancl_set [simp]: "finite (\<Delta>_trancl_set \<A> \)" + using finite_subset[OF \<Delta>_trancl_set_states] + by simp + +context +includes fset.lifting +begin +lift_definition \<Delta>_trancl :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) fset" is \<Delta>_trancl_set by simp +lemmas \<Delta>_trancl_cong = \<Delta>_set_cong [Transfer.transferred] +lemmas \<Delta>_trancl_eps1 = \<Delta>_set_eps1 [Transfer.transferred] +lemmas \<Delta>_trancl_eps2 = \<Delta>_set_eps2 [Transfer.transferred] +lemmas \<Delta>_trancl_cases = \<Delta>_trancl_set.cases[Transfer.transferred] +lemmas \<Delta>_trancl_induct [consumes 1, case_names \<Delta>_cong \<Delta>_eps1 \<Delta>_eps2 \<Delta>_trans] = \<Delta>_trancl_set.induct[Transfer.transferred] +lemmas \<Delta>_trancl_intros = \<Delta>_trancl_set.intros[Transfer.transferred] +lemmas \<Delta>_trancl_simps = \<Delta>_trancl_set.simps[Transfer.transferred] +end + + +lemma \<Delta>_trancl_cl [simp]: + "(\<Delta>_trancl A B)|\<^sup>+| = \<Delta>_trancl A B" +proof - + {fix s t assume "(s, t) |\<in>| (\<Delta>_trancl A B)|\<^sup>+|" then have "(s, t) |\<in>| \<Delta>_trancl A B" + by (induct rule: ftrancl_induct) (auto intro: \<Delta>_trancl_intros)} + then show ?thesis by auto +qed + +lemma \<Delta>_trancl_states: "\<Delta>_trancl \<A> \ |\<subseteq>| (\<Q> \<A> |\<times>| \<Q> \)" + using \<Delta>_trancl_set_states + by (metis \<Delta>_trancl.rep_eq fSigma_cong less_eq_fset.rep_eq) + +definition GTT_trancl where + "GTT_trancl G = + (let \<Delta> = \<Delta>_trancl (snd G) (fst G) in + (TA (rules (fst G)) (eps (fst G) |\<union>| \<Delta>), + TA (rules (snd G)) (eps (snd G) |\<union>| (\<Delta>|\<inverse>|))))" + +lemma \<Delta>_trancl_inv: + "(\<Delta>_trancl A B)|\<inverse>| = \<Delta>_trancl B A" +proof - + have [dest]: "(p, q) |\<in>| \<Delta>_trancl A B \<Longrightarrow> (q, p) |\<in>| \<Delta>_trancl B A" for p q A B + by (induct rule: \<Delta>_trancl_induct) (auto intro: \<Delta>_trancl_intros) + show ?thesis by auto +qed + +lemma gtt_states_GTT_trancl: + "gtt_states (GTT_trancl G) |\<subseteq>| gtt_states G" + unfolding GTT_trancl_def + by (auto simp: gtt_states_def \<Q>_def \<Delta>_trancl_inv dest!: fsubsetD[OF \<Delta>_trancl_states] simp flip: fmember.rep_eq) + +lemma gtt_syms_GTT_trancl: + "gtt_syms (GTT_trancl G) = gtt_syms G" + by (auto simp: GTT_trancl_def ta_sig_def \<Delta>_trancl_inv) + +lemma GTT_trancl_base: + "gtt_lang G \<subseteq> gtt_lang (GTT_trancl G)" + using gtt_lang_mono[of G "GTT_trancl G"] by (auto simp: \<Delta>_trancl_inv GTT_trancl_def) + +lemma GTT_trancl_trans: + "gtt_lang (GTT_comp (GTT_trancl G) (GTT_trancl G)) \<subseteq> gtt_lang (GTT_trancl G)" +proof - + have [dest]: "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> (TA (rules A) (eps A |\<union>| (\<Delta>_trancl B A))) + (TA (rules B) (eps B |\<union>| (\<Delta>_trancl A B))) \<Longrightarrow> (p, q) |\<in>| \<Delta>_trancl A B" for p q A B + by (induct rule: \<Delta>\<^sub>\<epsilon>_induct) (auto intro: \<Delta>_trancl_intros simp: \<Delta>_trancl_inv[of B A, symmetric]) + show ?thesis + by (intro gtt_lang_mono[of "GTT_comp (GTT_trancl G) (GTT_trancl G)" "GTT_trancl G"]) + (auto simp: GTT_comp_def GTT_trancl_def fmember.abs_eq \<Delta>_trancl_inv) +qed + +lemma agtt_lang_base: + "agtt_lang G \<subseteq> agtt_lang (GTT_trancl G)" + by (rule agtt_lang_mono) (auto simp: GTT_trancl_def \<Delta>_trancl_inv) + + +lemma \<Delta>\<^sub>\<epsilon>_tr_incl: + "\<Delta>\<^sub>\<epsilon> (TA (rules A) (eps A |\<union>| \<Delta>_trancl B A)) (TA (rules B) (eps B |\<union>| \<Delta>_trancl A B)) = \<Delta>_trancl A B" + (is "?LS = ?RS") +proof - + {fix p q assume "(p, q) |\<in>| ?LS" then have "(p, q) |\<in>| ?RS" + by (induct rule: \<Delta>\<^sub>\<epsilon>_induct) + (auto simp: \<Delta>_trancl_inv[of B A, symmetric] intro: \<Delta>_trancl_intros)} + moreover + {fix p q assume "(p, q) |\<in>| ?RS" then have "(p, q) |\<in>| ?LS" + by (induct rule: \<Delta>_trancl_induct) + (auto simp: \<Delta>_trancl_inv[of B A, symmetric] intro: \<Delta>\<^sub>\<epsilon>_intros)} + ultimately show ?thesis + by auto +qed + + +lemma agtt_lang_trans: + "gcomp_rel UNIV (agtt_lang (GTT_trancl G)) (agtt_lang (GTT_trancl G)) \<subseteq> agtt_lang (GTT_trancl G)" +proof - + have [intro!, dest]: "(p, q) |\<in>| \<Delta>\<^sub>\<epsilon> (TA (rules A) (eps A |\<union>| (\<Delta>_trancl B A))) + (TA (rules B) (eps B |\<union>| (\<Delta>_trancl A B))) \<Longrightarrow> (p, q) |\<in>| \<Delta>_trancl A B" for p q A B + by (induct rule: \<Delta>\<^sub>\<epsilon>_induct) (auto intro: \<Delta>_trancl_intros simp: \<Delta>_trancl_inv[of B A, symmetric]) + show ?thesis + by (rule subset_trans[OF gtt_comp_acomplete agtt_lang_mono]) + (auto simp: GTT_comp_def GTT_trancl_def \<Delta>_trancl_inv) +qed + +lemma GTT_trancl_acomplete: + "gtrancl_rel UNIV (agtt_lang G) \<subseteq> agtt_lang (GTT_trancl G)" + unfolding gtrancl_rel_def + using agtt_lang_base[of G] gmctxt_cl_mono_rel[OF agtt_lang_base[of G], of UNIV] + using agtt_lang_trans[of G] + unfolding gcomp_rel_def + by (intro kleene_trancl_induct) blast+ + +lemma Restr_rtrancl_gtt_lang_eq_trancl_gtt_lang: + "(gtt_lang G)\<^sup>* = (gtt_lang G)\<^sup>+" + by (auto simp: rtrancl_trancl_reflcl simp del: reflcl_trancl dest: tranclD tranclD2 intro: gmctxt_cl_refl) + +lemma GTT_trancl_complete: + "(gtt_lang G)\<^sup>+ \<subseteq> gtt_lang (GTT_trancl G)" + using GTT_trancl_base subset_trans[OF gtt_comp_lang_complete GTT_trancl_trans] + by (metis trancl_id trancl_mono_set trans_O_iff) + +lemma trancl_gtt_lang_arg_closed: + assumes "length ss = length ts" "\<forall>i < length ts. (ss ! i, ts ! i) \<in> (gtt_lang \<G>)\<^sup>+" + shows "(GFun f ss, GFun f ts) \<in> (gtt_lang \<G>)\<^sup>+" (is "?e \<in> _") +proof - + have "all_ctxt_closed UNIV ((gtt_lang \<G>)\<^sup>+)" by (intro all_ctxt_closed_trancl) auto + from all_ctxt_closedD[OF this _ assms] show ?thesis + by auto +qed + +lemma \<Delta>_trancl_sound: + assumes "(p, q) |\<in>| \<Delta>_trancl A B" + obtains s t where "(s, t) \<in> (gtt_lang (B, A))\<^sup>+" "p |\<in>| gta_der A s" "q |\<in>| gta_der B t" + using assms +proof (induct arbitrary: thesis rule: \<Delta>_trancl_induct) + case (\<Delta>_cong f ps p qs q) + have "\<exists>si ti. (si, ti) \<in> (gtt_lang (B, A))\<^sup>+ \<and> ps ! i |\<in>| gta_der A (si) \<and> + qs ! i |\<in>| gta_der B (ti)" if "i < length qs" for i + using \<Delta>_cong(5)[OF that] by metis + then obtain ss ts where + "\<And>i. i < length qs \<Longrightarrow> (ss i, ts i) \<in> (gtt_lang (B, A))\<^sup>+ \<and> ps ! i |\<in>| gta_der A (ss i) \<and> qs ! i |\<in>| gta_der B (ts i)" by metis + then show ?case using \<Delta>_cong(1-5) + by (intro \<Delta>_cong(6)[of "GFun f (map ss [0..<length ps])" "GFun f (map ts [0..<length qs])"]) + (auto simp: gta_der_def intro!: trancl_gtt_lang_arg_closed) +next + case (\<Delta>_eps1 p p' q) then show ?case + by (metis gta_der_def ta_der_eps) +next + case (\<Delta>_eps2 q q' p) then show ?case + by (metis gta_der_def ta_der_eps) +next + case (\<Delta>_trans p q r) + obtain s1 t1 where "(s1, t1) \<in> (gtt_lang (B, A))\<^sup>+" "p |\<in>| gta_der A s1" "q |\<in>| gta_der B t1" + using \<Delta>_trans(2) .note 1 = this + obtain s2 t2 where "(s2, t2) \<in> (gtt_lang (B, A))\<^sup>+" "q |\<in>| gta_der A s2" "r |\<in>| gta_der B t2" + using \<Delta>_trans(4) . note 2 = this + have "(t1, s2) \<in> gtt_lang (B, A)" using 1(1,3) 2(1,2) + by (auto simp: Restr_rtrancl_gtt_lang_eq_trancl_gtt_lang[symmetric] gtt_lang_join) + then have "(s1, t2) \<in> (gtt_lang (B, A))\<^sup>+" using 1(1) 2(1) + by (meson trancl.trancl_into_trancl trancl_trans) + then show ?case using 1(2) 2(3) by (auto intro: \<Delta>_trans(5)[of s1 t2]) +qed + +lemma GTT_trancl_sound_aux: + assumes "p |\<in>| gta_der (TA (rules A) (eps A |\<union>| (\<Delta>_trancl B A))) s" + shows "\<exists>t. (s, t) \<in> (gtt_lang (A, B))\<^sup>+ \<and> p |\<in>| gta_der A t" + using assms +proof (induct s arbitrary: p) + case (GFun f ss) + let ?eps = "eps A |\<union>| \<Delta>_trancl B A" + obtain qs q where q: "TA_rule f qs q |\<in>| rules A" "q = p \<or> (q, p) |\<in>| ?eps|\<^sup>+|" "length qs = length ss" + "\<And>i. i < length ss \<Longrightarrow> qs ! i |\<in>| gta_der (TA (rules A) ?eps) (ss ! i)" + using GFun(2) by (auto simp: gta_der_def) + have "\<And>i. i < length ss \<Longrightarrow> \<exists>ti. (ss ! i, ti) \<in> (gtt_lang (A, B))\<^sup>+ \<and> qs ! i |\<in>| gta_der A (ti)" + using GFun(1)[OF nth_mem q(4)] unfolding gta_der_def by fastforce + then obtain ts where ts: "\<And>i. i < length ss \<Longrightarrow> (ss ! i, ts i) \<in> (gtt_lang (A, B))\<^sup>+ \<and> qs ! i |\<in>| gta_der A (ts i)" + by metis + then have q': "q |\<in>| gta_der A (GFun f (map ts [0..<length ss]))" + "(GFun f ss, GFun f (map ts [0..<length ss])) \<in> (gtt_lang (A, B))\<^sup>+" using q(1, 3) + by (auto simp: gta_der_def intro!: exI[of _ qs] exI[of _ q] trancl_gtt_lang_arg_closed) + {fix p q u assume ass: "(p, q) |\<in>| \<Delta>_trancl B A" "(GFun f ss, u) \<in> (gtt_lang (A, B))\<^sup>+ \<and> p |\<in>| gta_der A u" + from \<Delta>_trancl_sound[OF this(1)] obtain s t + where "(s, t) \<in> (gtt_lang (A, B))\<^sup>+" "p |\<in>| gta_der B s" "q |\<in>| gta_der A t" . note st = this + have "(u, s) \<in> gtt_lang (A, B)" using st conjunct2[OF ass(2)] + by (auto simp: Restr_rtrancl_gtt_lang_eq_trancl_gtt_lang[symmetric] gtt_lang_join) + then have "(GFun f ss, t) \<in> (gtt_lang (A, B))\<^sup>+" + using ass st(1) by (meson trancl_into_trancl2 trancl_trans) + then have "\<exists> s t. (GFun f ss, t) \<in> (gtt_lang (A, B))\<^sup>+ \<and> q |\<in>| gta_der A t" using st by blast} + note trancl_step = this + show ?case + proof (cases "q = p") + case True + then show ?thesis using ts q(1, 3) + by (auto simp: gta_der_def intro!: exI[of _"GFun f (map ts [0..< length ss])"] trancl_gtt_lang_arg_closed) blast + next + case False + then have "(q, p) |\<in>| ?eps|\<^sup>+|" using q(2) by simp + then show ?thesis using q(1) q' + proof (induct rule: ftrancl_induct) + case (Base q p) from Base(1) show ?case + proof + assume "(q, p) |\<in>| eps A" then show ?thesis using Base(2) ts q(3) + by (auto simp: gta_der_def intro!: exI[of _"GFun f (map ts [0..< length ss])"] + trancl_gtt_lang_arg_closed exI[of _ qs] exI[of _ q]) + next + assume "(q, p) |\<in>| (\<Delta>_trancl B A)" + then have "(q, p) |\<in>| \<Delta>_trancl B A" by (simp add: fmember.abs_eq) + from trancl_step[OF this] show ?thesis using Base(3, 4) + by auto + qed + next + case (Step p q r) + from Step(2, 4-) obtain s' where s': "(GFun f ss, s') \<in> (gtt_lang (A, B))\<^sup>+ \<and> q |\<in>| gta_der A s'" by auto + show ?case using Step(3) + proof + assume "(q, r) |\<in>| eps A" then show ?thesis using s' + by (auto simp: gta_der_def ta_der_eps intro!: exI[of _ s']) + next + assume "(q, r) |\<in>| \<Delta>_trancl B A" + then have "(q, r) |\<in>| \<Delta>_trancl B A" by (simp add: fmember.abs_eq) + from trancl_step[OF this] show ?thesis using s' by auto + qed + qed + qed +qed + +lemma GTT_trancl_asound: + "agtt_lang (GTT_trancl G) \<subseteq> gtrancl_rel UNIV (agtt_lang G)" +proof (intro subrelI, goal_cases LR) + case (LR s t) + then obtain s' q t' where *: "(s, s') \<in> (gtt_lang G)\<^sup>+" + "q |\<in>| gta_der (fst G) s'" "q |\<in>| gta_der (snd G) t'" "(t', t) \<in> (gtt_lang G)\<^sup>+" + by (auto simp: agtt_lang_def GTT_trancl_def trancl_converse \<Delta>_trancl_inv + simp flip: gtt_lang_swap[of "fst G" "snd G", unfolded prod.collapse agtt_lang_def, simplified] + dest!: GTT_trancl_sound_aux) + then have "(s', t') \<in> agtt_lang G" using *(2,3) + by (auto simp: agtt_lang_def) + then show ?case using *(1,4) unfolding gtrancl_rel_def + by auto +qed + +lemma GTT_trancl_sound: + "gtt_lang (GTT_trancl G) \<subseteq> (gtt_lang G)\<^sup>+" +proof - + note [dest] = GTT_trancl_sound_aux + have "gtt_accept (GTT_trancl G) s t \<Longrightarrow> (s, t) \<in> (gtt_lang G)\<^sup>+" for s t unfolding gtt_accept_def + proof (induct rule: gmctxt_cl.induct) + case (base s t) + from base obtain q where join: "q |\<in>| gta_der (fst (GTT_trancl G)) s" "q |\<in>| gta_der (snd (GTT_trancl G)) t" + by (auto simp: agtt_lang_def) + obtain s' where "(s, s') \<in> (gtt_lang G)\<^sup>+" "q |\<in>| gta_der (fst G) s'" using base join + by (auto simp: GTT_trancl_def \<Delta>_trancl_inv agtt_lang_def) + moreover obtain t' where "(t', t) \<in> (gtt_lang G)\<^sup>+" "q |\<in>| gta_der (snd G) t'" using join + by (auto simp: GTT_trancl_def gtt_lang_swap[of "fst G" "snd G", symmetric] trancl_converse \<Delta>_trancl_inv) + moreover have "(s', t') \<in> gtt_lang G" using calculation + by (auto simp: Restr_rtrancl_gtt_lang_eq_trancl_gtt_lang[symmetric] gtt_lang_join) + ultimately show "(s, t) \<in> (gtt_lang G)\<^sup>+" by (meson trancl.trancl_into_trancl trancl_trans) + qed (auto intro!: trancl_gtt_lang_arg_closed) + then show ?thesis by (auto simp: gtt_accept_def) +qed + +lemma GTT_trancl_alang: + "agtt_lang (GTT_trancl G) = gtrancl_rel UNIV (agtt_lang G)" + using GTT_trancl_asound GTT_trancl_acomplete by blast + +lemma GTT_trancl_lang: + "gtt_lang (GTT_trancl G) = (gtt_lang G)\<^sup>+" + using GTT_trancl_sound GTT_trancl_complete by blast + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Horn_Setup/Horn_Fset.thy b/thys/Regular_Tree_Relations/Horn_Setup/Horn_Fset.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Horn_Setup/Horn_Fset.thy @@ -0,0 +1,105 @@ +theory Horn_Fset + imports Horn_Inference FSet_Utils +begin + +locale horn_fset_impl = horn + + fixes infer0_impl :: "'a list" and infer1_impl :: "'a \<Rightarrow> 'a fset \<Rightarrow> 'a list" +begin + +lemma saturate_fold_simp [simp]: + "fold (\<lambda>xa. case_option None (f xa)) xs None = None" + by (induct xs) auto + +lemma saturate_fold_mono [partial_function_mono]: + "option.mono_body (\<lambda>f. fold (\<lambda>x. case_option None (\<lambda>y. f (x, y))) xs b)" + unfolding monotone_def fun_ord_def flat_ord_def +proof (intro allI impI, induct xs arbitrary: b) + case (Cons a xs) + show ?case + using Cons(1)[OF Cons(2), of "x (a, the b)"] Cons(2)[rule_format, of "(a, the b)"] + by (cases b) auto +qed auto + +partial_function (option) saturate_rec :: "'a \<Rightarrow> 'a fset \<Rightarrow> ('a fset) option" where + "saturate_rec x bs = (if x |\<in>| bs then Some bs else + fold (\<lambda>x. case_option None (saturate_rec x)) (infer1_impl x bs) (Some (finsert x bs)))" + +definition saturate_impl where + "saturate_impl = fold (\<lambda>x. case_option None (saturate_rec x)) infer0_impl (Some {||})" + +end + +locale horn_fset = horn_fset_impl + + assumes infer0: "infer0 = set infer0_impl" + and infer1: "\<And>x bs. infer1 x (fset bs) = set (infer1_impl x bs)" +begin + +lemma saturate_rec_sound: + "saturate_rec x bs = Some bs' \<Longrightarrow> ({x}, fset bs) \<turnstile> ({}, fset bs')" +proof (induct arbitrary: x bs bs' rule: saturate_rec.fixp_induct) + case 1 show ?case using option_admissible[of "\<lambda>(x, y) z. _ x y z"] + by fastforce +next + case (3 rec) + have [dest!]: "(set xs, fset ys) \<turnstile> ({}, fset bs')" + if "fold (\<lambda>x a. case a of None \<Rightarrow> None | Some a \<Rightarrow> rec x a) xs (Some ys) = Some bs'" + for xs ys using that + proof (induct xs arbitrary: ys) + case (Cons a xs) + show ?case using trans[OF step_mono[OF 3(1)], of a ys _ "set xs" "{}" "fset bs'"] Cons + by (cases "rec a ys") auto + qed (auto intro: refl) + show ?case using propagate[of x "{}" "fset bs", unfolded infer1 Un_empty_left] 3(2) + by (auto simp: delete fmember.rep_eq split: if_splits intro: trans delete) +qed auto + +lemma saturate_impl_sound: + assumes "saturate_impl = Some B'" + shows "fset B' = saturate" +proof - + have "(set xs, fset ys) \<turnstile> ({}, fset bs')" + if "fold (\<lambda>x a. case a of None \<Rightarrow> None | Some a \<Rightarrow> saturate_rec x a) xs (Some ys) = Some bs'" + for xs ys bs' using that + proof (induct xs arbitrary: ys) + case (Cons a xs) + show ?case + using trans[OF step_mono[OF saturate_rec_sound], of a ys _ "set xs" "{}" "fset bs'"] Cons + by (cases "saturate_rec a ys") auto + qed (auto intro: refl) + from this[of infer0_impl "{||}" B'] assms step_sound show ?thesis + by (auto simp: saturate_impl_def infer0) +qed + +lemma saturate_impl_complete: + assumes "finite saturate" + shows "saturate_impl \<noteq> None" +proof - + have *: "fold (\<lambda>x. case_option None (saturate_rec x)) ds (Some bs) \<noteq> None" + if "fset bs \<subseteq> saturate" "set ds \<subseteq> saturate" for bs ds + using that + proof (induct "card (saturate - fset bs)" arbitrary: bs ds rule: less_induct) + case less + show ?case using less(3) + proof (induct ds) + case (Cons d ds) + have "infer1 d (fset bs) \<subseteq> saturate" using less(2) Cons(2) + unfolding infer1_def by (auto intro: saturate.infer) + moreover have "card (saturate - fset (finsert d bs)) < card (saturate - fset bs)" if "d \<notin> fset bs" + using Cons(2) assms that + by (metis DiffI Diff_insert card_Diff1_less finite_Diff finsert.rep_eq in_mono insertCI list.simps(15)) + ultimately show ?case using less(1)[of "finsert d bs" "infer1_impl d bs @ ds"] less(2) Cons assms + unfolding fold.simps comp_def option.simps + apply (subst saturate_rec.simps) + apply (auto simp flip: saturate_rec.simps split!: if_splits simp: infer1) + apply (simp add: notin_fset saturate_rec.simps) + done + qed simp + qed + show ?thesis using *[of "{||}" "infer0_impl"] inv_start by (simp add: saturate_impl_def infer0) +qed + +end + +lemmas [code] = horn_fset_impl.saturate_rec.simps horn_fset_impl.saturate_impl_def + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Horn_Setup/Horn_Inference.thy b/thys/Regular_Tree_Relations/Horn_Setup/Horn_Inference.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Horn_Setup/Horn_Inference.thy @@ -0,0 +1,76 @@ +theory Horn_Inference + imports Main +begin + +datatype 'a horn = horn "'a list" 'a (infix "\<rightarrow>\<^sub>h" 55) + +locale horn = + fixes \<H> :: "'a horn set" +begin + +inductive_set saturate :: "'a set" where + infer: "as \<rightarrow>\<^sub>h a \<in> \<H> \<Longrightarrow> (\<And>x. x \<in> set as \<Longrightarrow> x \<in> saturate) \<Longrightarrow> a \<in> saturate" + +definition infer0 where + "infer0 = {a. [] \<rightarrow>\<^sub>h a \<in> \<H>}" + +definition infer1 where + "infer1 x B = {a |as a. as \<rightarrow>\<^sub>h a \<in> \<H> \<and> x \<in> set as \<and> set as \<subseteq> B \<union> {x}}" + +inductive step :: "'a set \<times> 'a set \<Rightarrow> 'a set \<times> 'a set \<Rightarrow> bool" (infix "\<turnstile>" 50) where + delete: "x \<in> B \<Longrightarrow> (insert x G, B) \<turnstile> (G, B)" +| propagate: "(insert x G, B) \<turnstile> (G \<union> infer1 x B, insert x B)" +| refl: "(G, B) \<turnstile> (G, B)" +| trans: "(G, B) \<turnstile> (G', B') \<Longrightarrow> (G', B') \<turnstile> (G'', B'') \<Longrightarrow> (G, B) \<turnstile> (G'', B'')" + +lemma step_mono: + "(G, B) \<turnstile> (G', B') \<Longrightarrow> (H \<union> G, B) \<turnstile> (H \<union> G', B')" + by (induction "(G, B)" "(G', B')" arbitrary: G B G' B' rule: step.induct) + (auto intro: step.intros simp: Un_assoc[symmetric]) + +fun invariant where + "invariant (G, B) \<longleftrightarrow> G \<subseteq> saturate \<and> B \<subseteq> saturate \<and> (\<forall>a as. as \<rightarrow>\<^sub>h a \<in> \<H> \<and> set as \<subseteq> B \<longrightarrow> a \<in> G \<union> B)" + +lemma inv_start: + shows "invariant (infer0, {})" + by (auto simp: infer0_def invariant.simps intro: infer) + +lemma inv_step: + assumes "invariant (G, B)" "(G, B) \<turnstile> (G', B')" + shows "invariant (G', B')" + using assms(2,1) +proof (induction "(G, B)" "(G', B')" arbitrary: G B G' B' rule: step.induct) + case (propagate x G B) + let ?G' = "G \<union> local.infer1 x B" and ?B' = "insert x B" + have "?G' \<subseteq> saturate" "?B' \<subseteq> saturate" + using assms(1) propagate by (auto 0 3 simp: infer1_def intro: saturate.infer) + moreover have "as \<rightarrow>\<^sub>h a \<in> \<H> \<Longrightarrow> set as \<subseteq> ?B' \<Longrightarrow> a \<in> ?G' \<union> ?B'" for a as + using assms(1) propagate by (fastforce simp: infer1_def) + ultimately show ?case by auto +qed auto + +lemma inv_end: + assumes "invariant ({}, B)" + shows "B = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) then show ?case using assms by auto +next + case (rl x) then show ?case using assms + by (induct x rule: saturate.induct) fastforce +qed + +lemma step_sound: + "(infer0, {}) \<turnstile> ({}, B) \<Longrightarrow> B = saturate" + by (metis inv_start inv_step inv_end) + +end + +lemma horn_infer0_union: + "horn.infer0 (\<H>\<^sub>1 \<union> \<H>\<^sub>2) = horn.infer0 \<H>\<^sub>1 \<union> horn.infer0 \<H>\<^sub>2" + by (auto simp: horn.infer0_def) + +lemma horn_infer1_union: + "horn.infer1 (\<H>\<^sub>1 \<union> \<H>\<^sub>2) x B = horn.infer1 \<H>\<^sub>1 x B \<union> horn.infer1 \<H>\<^sub>2 x B" + by (auto simp: horn.infer1_def) + +end diff --git a/thys/Regular_Tree_Relations/Horn_Setup/Horn_List.thy b/thys/Regular_Tree_Relations/Horn_Setup/Horn_List.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Horn_Setup/Horn_List.thy @@ -0,0 +1,102 @@ +theory Horn_List + imports Horn_Inference +begin + +locale horn_list_impl = horn + + fixes infer0_impl :: "'a list" and infer1_impl :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" +begin + +lemma saturate_fold_simp [simp]: + "fold (\<lambda>xa. case_option None (f xa)) xs None = None" + by (induct xs) auto + +lemma saturate_fold_mono [partial_function_mono]: + "option.mono_body (\<lambda>f. fold (\<lambda>x. case_option None (\<lambda>y. f (x, y))) xs b)" + unfolding monotone_def fun_ord_def flat_ord_def +proof (intro allI impI, induct xs arbitrary: b) + case (Cons a xs) + show ?case + using Cons(1)[OF Cons(2), of "x (a, the b)"] Cons(2)[rule_format, of "(a, the b)"] + by (cases b) auto +qed auto + +partial_function (option) saturate_rec :: "'a \<Rightarrow> 'a list \<Rightarrow> ('a list) option" where + "saturate_rec x bs = (if x \<in> set bs then Some bs else + fold (\<lambda>x. case_option None (saturate_rec x)) (infer1_impl x bs) (Some (x # bs)))" + +definition saturate_impl where + "saturate_impl = fold (\<lambda>x. case_option None (saturate_rec x)) infer0_impl (Some [])" + +end + +locale horn_list = horn_list_impl + + assumes infer0: "infer0 = set infer0_impl" + and infer1: "\<And>x bs. infer1 x (set bs) = set (infer1_impl x bs)" +begin + +lemma saturate_rec_sound: + "saturate_rec x bs = Some bs' \<Longrightarrow> ({x}, set bs) \<turnstile> ({}, set bs')" +proof (induct arbitrary: x bs bs' rule: saturate_rec.fixp_induct) + case 1 show ?case using option_admissible[of "\<lambda>(x, y) z. _ x y z"] + by fastforce +next + case (3 rec) + have [dest!]: "(set xs, set ys) \<turnstile> ({}, set bs')" + if "fold (\<lambda>x a. case a of None \<Rightarrow> None | Some a \<Rightarrow> rec x a) xs (Some ys) = Some bs'" + for xs ys using that + proof (induct xs arbitrary: ys) + case (Cons a xs) + show ?case using trans[OF step_mono[OF 3(1)], of a ys _ "set xs" "{}" "set bs'"] Cons + by (cases "rec a ys") auto + qed (auto intro: refl) + show ?case using propagate[of x "{}" "set bs", unfolded infer1 Un_empty_left] 3(2) + by (auto split: if_splits intro: trans delete) +qed auto + +lemma saturate_impl_sound: + assumes "saturate_impl = Some B'" + shows "set B' = saturate" +proof - + have "(set xs, set ys) \<turnstile> ({}, set bs')" + if "fold (\<lambda>x a. case a of None \<Rightarrow> None | Some a \<Rightarrow> saturate_rec x a) xs (Some ys) = Some bs'" + for xs ys bs' using that + proof (induct xs arbitrary: ys) + case (Cons a xs) + show ?case + using trans[OF step_mono[OF saturate_rec_sound], of a ys _ "set xs" "{}" "set bs'"] Cons + by (cases "saturate_rec a ys") auto + qed (auto intro: refl) + from this[of infer0_impl "[]" B'] assms step_sound show ?thesis + by (auto simp: saturate_impl_def infer0) +qed + +lemma saturate_impl_complete: + assumes "finite saturate" + shows "saturate_impl \<noteq> None" +proof - + have *: "fold (\<lambda>x. case_option None (saturate_rec x)) ds (Some bs) \<noteq> None" + if "set bs \<subseteq> saturate" "set ds \<subseteq> saturate" for bs ds + using that + proof (induct "card (saturate - set bs)" arbitrary: bs ds rule: less_induct) + case less + show ?case using less(3) + proof (induct ds) + case (Cons d ds) + have "infer1 d (set bs) \<subseteq> saturate" using less(2) Cons(2) + unfolding infer1_def by (auto intro: saturate.infer) + moreover have "card (saturate - set (d # bs)) < card (saturate - set bs)" if "d \<notin> set bs" + using Cons(2) assms that + by (metis (no_types, lifting) DiffI card_Diff1_less_iff card_Diff_insert card_Diff_singleton_if finite_Diff list.set_intros(1) list.simps(15) subsetD) + ultimately show ?case using less(1)[of "d # bs" "infer1_impl d bs @ ds"] less(2) Cons assms + unfolding fold.simps comp_def option.simps + by (subst saturate_rec.simps) (auto split: if_splits simp: infer1) + qed simp + qed + show ?thesis using *[of "[]" "infer0_impl"] inv_start by (simp add: saturate_impl_def infer0) +qed + +end + +lemmas [code] = horn_list_impl.saturate_rec.simps horn_list_impl.saturate_impl_def + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Pair_Automaton.thy b/thys/Regular_Tree_Relations/Pair_Automaton.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Pair_Automaton.thy @@ -0,0 +1,370 @@ +theory Pair_Automaton + imports Tree_Automata_Complement GTT_Compose +begin + +subsection \<open>Pair automaton and anchored GTTs\<close> + +definition pair_at_lang :: "('q, 'f) gtt \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> 'f gterm rel" where + "pair_at_lang \<G> Q = {(s, t) | s t p q. q |\<in>| gta_der (fst \<G>) s \<and> p |\<in>| gta_der (snd \<G>) t \<and> (q, p) |\<in>| Q}" + +lemma pair_at_lang_restr_states: + "pair_at_lang \<G> Q = pair_at_lang \<G> (Q |\<inter>| (\<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)))" + by (auto simp: pair_at_lang_def gta_der_def) (meson gterm_ta_der_states) + +lemma pair_at_langE: + assumes "(s, t) \<in> pair_at_lang \<G> Q" + obtains q p where "(q, p) |\<in>| Q" and "q |\<in>| gta_der (fst \<G>) s" and "p |\<in>| gta_der (snd \<G>) t" + using assms by (auto simp: pair_at_lang_def) + +lemma pair_at_langI: + assumes "q |\<in>| gta_der (fst \<G>) s" "p |\<in>| gta_der (snd \<G>) t" "(q, p) |\<in>| Q" + shows "(s, t) \<in> pair_at_lang \<G> Q" + using assms by (auto simp: pair_at_lang_def) + +lemma pair_at_lang_fun_states: + assumes "finj_on f (\<Q> (fst \<G>))" and "finj_on g (\<Q> (snd \<G>))" + and "Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" + shows "pair_at_lang \<G> Q = pair_at_lang (map_prod (fmap_states_ta f) (fmap_states_ta g) \<G>) (map_prod f g |`| Q)" + (is "?LS = ?RS") +proof + {fix s t assume "(s, t) \<in> ?LS" + then have "(s, t) \<in> ?RS" using ta_der_fmap_states_ta_mono[of f "fst \<G>" s] + using ta_der_fmap_states_ta_mono[of g "snd \<G>" t] + by (force simp: gta_der_def map_prod_def image_iff elim!: pair_at_langE split: prod.split intro!: pair_at_langI)} + then show "?LS \<subseteq> ?RS" by auto +next + {fix s t assume "(s, t) \<in> ?RS" + then obtain p q where rs: "p |\<in>| ta_der (fst \<G>) (term_of_gterm s)" "f p |\<in>| ta_der (fmap_states_ta f (fst \<G>)) (term_of_gterm s)" and + ts: "q |\<in>| ta_der (snd \<G>) (term_of_gterm t)" "g q |\<in>| ta_der (fmap_states_ta g (snd \<G>)) (term_of_gterm t)" and + st: "(f p, g q) |\<in>| (map_prod f g |`| Q)" using assms ta_der_fmap_states_inv[of f "fst \<G>" _ s] + using ta_der_fmap_states_inv[of g "snd \<G>" _ t] + by (auto simp: gta_der_def adapt_vars_term_of_gterm elim!: pair_at_langE) + (metis (no_types, opaque_lifting) fimageE fmap_prod_fimageI ta_der_fmap_states_conv) + then have "p |\<in>| \<Q> (fst \<G>)" "q |\<in>| \<Q> (snd \<G>)" by auto + then have "(p, q) |\<in>| Q" using assms st unfolding fimage_iff fBex_def + by (auto dest!: fsubsetD simp: finj_on_eq_iff) + then have "(s, t) \<in> ?LS" using st rs(1) ts(1) by (auto simp: gta_der_def intro!: pair_at_langI)} + then show "?RS \<subseteq> ?LS" by auto +qed + +lemma converse_pair_at_lang: + "(pair_at_lang \<G> Q)\<inverse> = pair_at_lang (prod.swap \<G>) (Q|\<inverse>|)" + by (auto simp: pair_at_lang_def) + +lemma pair_at_agtt: + "agtt_lang \<G> = pair_at_lang \<G> (fId_on (gtt_interface \<G>))" + by (auto simp: agtt_lang_def gtt_interface_def pair_at_lang_def gtt_states_def gta_der_def fId_on_iff) + +definition \<Delta>_eps_pair where + "\<Delta>_eps_pair \<G>\<^sub>1 Q\<^sub>1 \<G>\<^sub>2 Q\<^sub>2 \<equiv> Q\<^sub>1 |O| \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2) |O| Q\<^sub>2" + +lemma pair_comp_sound1: + assumes "(s, t) \<in> pair_at_lang \<G>\<^sub>1 Q\<^sub>1" + and "(t, u) \<in> pair_at_lang \<G>\<^sub>2 Q\<^sub>2" + shows "(s, u) \<in> pair_at_lang (fst \<G>\<^sub>1, snd \<G>\<^sub>2) (\<Delta>_eps_pair \<G>\<^sub>1 Q\<^sub>1 \<G>\<^sub>2 Q\<^sub>2)" +proof - + from pair_at_langE assms obtain p q q' r where + wit: "(p, q) |\<in>| Q\<^sub>1" "p |\<in>| gta_der (fst \<G>\<^sub>1) s" "q |\<in>| gta_der (snd \<G>\<^sub>1) t" + "(q', r) |\<in>| Q\<^sub>2" "q' |\<in>| gta_der (fst \<G>\<^sub>2) t" "r |\<in>| gta_der (snd \<G>\<^sub>2) u" + by metis + from wit(3, 5) have "(q, q') |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>\<^sub>1) (fst \<G>\<^sub>2)" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def' gta_der_def intro!: exI[of _ "term_of_gterm t"]) + then have "(p, r) |\<in>| \<Delta>_eps_pair \<G>\<^sub>1 Q\<^sub>1 \<G>\<^sub>2 Q\<^sub>2" using wit(1, 4) + by (auto simp: \<Delta>_eps_pair_def) + then show ?thesis using wit(2, 6) unfolding pair_at_lang_def + by auto +qed + +lemma pair_comp_sound2: + assumes "(s, u) \<in> pair_at_lang (fst \<G>\<^sub>1, snd \<G>\<^sub>2) (\<Delta>_eps_pair \<G>\<^sub>1 Q\<^sub>1 \<G>\<^sub>2 Q\<^sub>2)" + shows "\<exists> t. (s, t) \<in> pair_at_lang \<G>\<^sub>1 Q\<^sub>1 \<and> (t, u) \<in> pair_at_lang \<G>\<^sub>2 Q\<^sub>2" + using assms unfolding pair_at_lang_def \<Delta>_eps_pair_def + by (auto simp: \<Delta>\<^sub>\<epsilon>_def' gta_der_def) (metis gterm_of_term_inv) + +lemma pair_comp_sound: + "pair_at_lang \<G>\<^sub>1 Q\<^sub>1 O pair_at_lang \<G>\<^sub>2 Q\<^sub>2 = pair_at_lang (fst \<G>\<^sub>1, snd \<G>\<^sub>2) (\<Delta>_eps_pair \<G>\<^sub>1 Q\<^sub>1 \<G>\<^sub>2 Q\<^sub>2)" + by (auto simp: pair_comp_sound1 pair_comp_sound2 relcomp.simps) + +inductive_set \<Delta>_Atrans_set :: "('q \<times> 'q) fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) set" for Q \<A> \ where + base [simp]: "(p, q) |\<in>| Q \<Longrightarrow> (p, q) \<in> \<Delta>_Atrans_set Q \<A> \" +| step [intro]: "(p, q) \<in> \<Delta>_Atrans_set Q \<A> \ \<Longrightarrow> (q, r) |\<in>| \<Delta>\<^sub>\<epsilon> \ \<A> \<Longrightarrow> + (r, v) \<in> \<Delta>_Atrans_set Q \<A> \ \<Longrightarrow> (p, v) \<in> \<Delta>_Atrans_set Q \<A> \" + +lemma \<Delta>_Atrans_set_states: + "(p, q) \<in> \<Delta>_Atrans_set Q \<A> \ \<Longrightarrow> (p, q) \<in> fset ((fst |`| Q |\<union>| \<Q> \<A>) |\<times>| (snd |`| Q |\<union>| \<Q> \))" + by (induct rule: \<Delta>_Atrans_set.induct) (auto simp: fimage_iff fBex_def simp flip: fmember.rep_eq) + +lemma finite_\<Delta>_Atrans_set: "finite (\<Delta>_Atrans_set Q \<A> \)" +proof - + have "\<Delta>_Atrans_set Q \<A> \ \<subseteq> fset ((fst |`| Q |\<union>| \<Q> \<A>) |\<times>| (snd |`| Q |\<union>| \<Q> \))" + using \<Delta>_Atrans_set_states by auto + from finite_subset[OF this] show ?thesis by simp +qed + +context +includes fset.lifting +begin +lift_definition \<Delta>_Atrans :: "('q \<times> 'q) fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) fset" is \<Delta>_Atrans_set + by (simp add: finite_\<Delta>_Atrans_set) + +lemmas \<Delta>_Atrans_base [simp] = \<Delta>_Atrans_set.base [Transfer.transferred] +lemmas \<Delta>_Atrans_step [intro] = \<Delta>_Atrans_set.step [Transfer.transferred] +lemmas \<Delta>_Atrans_cases = \<Delta>_Atrans_set.cases[Transfer.transferred] +lemmas \<Delta>_Atrans_induct [consumes 1, case_names base step] = \<Delta>_Atrans_set.induct[Transfer.transferred] +end + +abbreviation "\<Delta>_Atrans_gtt \<G> Q \<equiv> \<Delta>_Atrans Q (fst \<G>) (snd \<G>)" + +lemma pair_trancl_sound1: + assumes "(s, t) \<in> (pair_at_lang \<G> Q)\<^sup>+" + shows "\<exists> q p. p |\<in>| gta_der (fst \<G>) s \<and> q |\<in>| gta_der (snd \<G>) t \<and> (p, q) |\<in>| \<Delta>_Atrans_gtt \<G> Q" + using assms +proof (induct) + case (step t v) + obtain p q r r' where reach_t: "r |\<in>| gta_der (fst \<G>) t" "q |\<in>| gta_der (snd \<G>) t" and + reach: "p |\<in>| gta_der (fst \<G>) s" "r' |\<in>| gta_der (snd \<G>) v" and + st: "(p, q) |\<in>| \<Delta>_Atrans_gtt \<G> Q" "(r, r') |\<in>| Q" using step(2, 3) + by (auto simp: pair_at_lang_def) + from reach_t have "(q, r) |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>) (fst \<G>)" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def' gta_der_def intro: ground_term_of_gterm) + then have "(p, r') |\<in>| \<Delta>_Atrans_gtt \<G> Q" using st by auto + then show ?case using reach reach_t + by (auto simp: pair_at_lang_def gta_der_def \<Delta>\<^sub>\<epsilon>_def' intro: ground_term_of_gterm) +qed (auto simp: pair_at_lang_def intro: \<Delta>_Atrans_base) + +lemma pair_trancl_sound2: + assumes "(p, q) |\<in>| \<Delta>_Atrans_gtt \<G> Q" + and "p |\<in>| gta_der (fst \<G>) s" "q |\<in>| gta_der (snd \<G>) t" + shows "(s, t) \<in> (pair_at_lang \<G> Q)\<^sup>+" using assms +proof (induct arbitrary: s t rule:\<Delta>_Atrans_induct) + case (step p q r v) + from step(2)[OF step(6)] step(5)[OF _ step(7)] step(3) + show ?case by (auto simp: gta_der_def \<Delta>\<^sub>\<epsilon>_def' intro!: ground_term_of_gterm) + (metis gterm_of_term_inv trancl_trans) +qed (auto simp: pair_at_lang_def) + +lemma pair_trancl_sound: + "(pair_at_lang \<G> Q)\<^sup>+ = pair_at_lang \<G> (\<Delta>_Atrans_gtt \<G> Q)" + by (auto simp: pair_trancl_sound2 dest: pair_trancl_sound1 elim: pair_at_langE intro: pair_at_langI) + +abbreviation "fst_pair_cl \<A> Q \<equiv> TA (rules \<A>) (eps \<A> |\<union>| (fId_on (\<Q> \<A>) |O| Q))" +definition pair_at_to_agtt :: "('q, 'f) gtt \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> ('q, 'f) gtt" where + "pair_at_to_agtt \<G> Q = (fst_pair_cl (fst \<G>) Q , TA (rules (snd \<G>)) (eps (snd \<G>)))" + +lemma fst_pair_cl_eps: + assumes "(p, q) |\<in>| (eps (fst_pair_cl \<A> Q))|\<^sup>+|" + and "\<Q> \<A> |\<inter>| snd |`| Q = {||}" + shows "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<or> (\<exists> r. (p = r \<or> (p, r) |\<in>| (eps \<A>)|\<^sup>+|) \<and> (r, q) |\<in>| Q)" using assms +proof (induct rule: ftrancl_induct) + case (Step p q r) + then have y: "q |\<in>| \<Q> \<A>" by (auto simp add: eps_trancl_statesD eps_statesD) + have [simp]: "(p, q) |\<in>| Q \<Longrightarrow> q |\<in>| snd |`| Q" for p q by (auto simp: fimage_iff) force + then show ?case using Step y + by auto (simp add: ftrancl_into_trancl) +qed auto + +lemma fst_pair_cl_res_aux: + assumes "\<Q> \<A> |\<inter>| snd |`| Q = {||}" + and "q |\<in>| ta_der (fst_pair_cl \<A> Q) (term_of_gterm t)" + shows "\<exists> p. p |\<in>| ta_der \<A> (term_of_gterm t) \<and> (q |\<notin>| \<Q> \<A> \<longrightarrow> (p, q) |\<in>| Q) \<and> (q |\<in>| \<Q> \<A> \<longrightarrow> p = q)" using assms +proof (induct t arbitrary: q) + case (GFun f ts) + then obtain qs q' where rule: "TA_rule f qs q' |\<in>| rules \<A>" "length qs = length ts" and + eps: "q' = q \<or> (q', q) |\<in>| (eps (fst_pair_cl \<A> Q))|\<^sup>+|" and + reach: "\<forall> i < length ts. qs ! i |\<in>| ta_der (fst_pair_cl \<A> Q) (term_of_gterm (ts ! i))" + by auto + {fix i assume ass: "i < length ts" then have st: "qs ! i |\<in>| \<Q> \<A>" using rule + by (auto simp: rule_statesD) + then have "qs ! i |\<notin>| snd |`| Q" using GFun(2) by auto + then have "qs ! i |\<in>| ta_der \<A> (term_of_gterm (ts ! i))" using reach st ass + using fst_pair_cl_eps[OF _ GFun(2)] GFun(1)[OF nth_mem[OF ass] GFun(2), of "qs ! i"] + by blast} note IH = this + show ?case + proof (cases "q' = q") + case True + then show ?thesis using rule reach IH + by (auto dest: rule_statesD intro!: exI[of _ q'] exI[of _ qs]) + next + case False note nt_eq = this + then have eps: "(q', q) |\<in>| (eps (fst_pair_cl \<A> Q))|\<^sup>+|" using eps by simp + from fst_pair_cl_eps[OF this assms(1)] show ?thesis + using False rule IH + proof (cases "q |\<notin>| \<Q> \<A>") + case True + from fst_pair_cl_eps[OF eps assms(1)] obtain r where + "q' = r \<or> (q', r) |\<in>| (eps \<A>)|\<^sup>+|" "(r, q) |\<in>| Q" using True + by (auto simp: eps_trancl_statesD) + then show ?thesis using nt_eq rule IH True + by (auto simp: fimage_iff eps_trancl_statesD) + next + case False + from fst_pair_cl_eps[OF eps assms(1)] False assms(1) + have "(q', q) |\<in>| (eps \<A>)|\<^sup>+|" + by (auto simp: fimage_iff) (metis fempty_iff fimage_eqI finterI snd_conv)+ + then show ?thesis using IH rule + by (intro exI[of _ q]) (auto simp: eps_trancl_statesD) + qed + qed +qed + +lemma restr_distjoing: + assumes "Q |\<subseteq>| \<Q> \<A> |\<times>| \<Q> \<BB>" + and "\<Q> \<A> |\<inter>| \<Q> \<BB> = {||}" + shows "\<Q> \<A> |\<inter>| snd |`| Q = {||}" + using assms by auto + +lemma pair_at_agtt_conv: + assumes "Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" and "\<Q> (fst \<G>) |\<inter>| \<Q> (snd \<G>) = {||}" + shows "pair_at_lang \<G> Q = agtt_lang (pair_at_to_agtt \<G> Q)" (is "?LS = ?RS") +proof + let ?TA = "fst_pair_cl (fst \<G>) Q" + {fix s t assume ls: "(s, t) \<in> ?LS" + then obtain q p where w: "(q, p) |\<in>| Q" "q |\<in>| gta_der (fst \<G>) s" "p |\<in>| gta_der (snd \<G>) t" + by (auto elim: pair_at_langE) + from w(2) have "q |\<in>| gta_der ?TA s" "q |\<in>| \<Q> (fst \<G>)" + using ta_der_mono'[of "fst \<G>" ?TA "term_of_gterm s"] + by (auto simp add: fin_mono ta_subset_def gta_der_def in_mono) + then have "(s, t) \<in> ?RS" using w(1, 3) + by (auto simp: pair_at_to_agtt_def agtt_lang_def gta_der_def ta_der_eps intro!: exI[of _ p]) + (metis fId_onI frelcompI funionI2 ta.sel(2) ta_der_eps)} + then show "?LS \<subseteq> ?RS" by auto +next + {fix s t assume ls: "(s, t) \<in> ?RS" + then obtain q where w: "q |\<in>| ta_der (fst_pair_cl (fst \<G>) Q) (term_of_gterm s)" + "q |\<in>| ta_der (snd \<G>) (term_of_gterm t)" + by (auto simp: agtt_lang_def pair_at_to_agtt_def gta_der_def) + from w(2) have "q |\<in>| \<Q> (snd \<G>)" "q |\<notin>| \<Q> (fst \<G>)" using assms(2) + by auto + from fst_pair_cl_res_aux[OF restr_distjoing[OF assms] w(1)] this w(2) + have "(s, t) \<in> ?LS" by (auto simp: agtt_lang_def pair_at_to_agtt_def gta_der_def intro: pair_at_langI)} + then show "?RS \<subseteq> ?LS" by auto +qed + +definition pair_at_to_agtt' where + "pair_at_to_agtt' \<G> Q = (let \<A> = fmap_states_ta Inl (fst \<G>) in + let \ = fmap_states_ta Inr (snd \<G>) in + let Q' = Q |\<inter>| (\<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)) in + pair_at_to_agtt (\<A>, \) (map_prod Inl Inr |`| Q'))" + +lemma pair_at_agtt_cost: + "pair_at_lang \<G> Q = agtt_lang (pair_at_to_agtt' \<G> Q)" +proof - + let ?G = "(fmap_states_ta CInl (fst \<G>), fmap_states_ta CInr (snd \<G>))" + let ?Q = "(Q |\<inter>| (\<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)))" + let ?Q' = "map_prod CInl CInr |`| ?Q" + have *: "pair_at_lang \<G> Q = pair_at_lang \<G> ?Q" + using pair_at_lang_restr_states by blast + have "pair_at_lang \<G> ?Q = pair_at_lang (map_prod (fmap_states_ta CInl) (fmap_states_ta CInr) \<G>) (map_prod CInl CInr |`| ?Q)" + by (intro pair_at_lang_fun_states[where ?\<G> = \<G> and ?Q = ?Q and ?f = CInl and ?g = CInr]) + (auto simp: finj_CInl_CInr) + then have **:"pair_at_lang \<G> ?Q = pair_at_lang ?G ?Q'" by (simp add: map_prod_simp') + have "pair_at_lang ?G ?Q' = agtt_lang (pair_at_to_agtt ?G ?Q')" + by (intro pair_at_agtt_conv[where ?\<G> = ?G]) auto + then show ?thesis unfolding * ** pair_at_to_agtt'_def Let_def + by simp +qed + +lemma \<Delta>_Atrans_states_stable: + assumes "Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" + shows "\<Delta>_Atrans_gtt \<G> Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" +proof + fix s assume ass: "s |\<in>| \<Delta>_Atrans_gtt \<G> Q" + then obtain t u where s: "s = (t, u)" by (cases s) blast + show "s |\<in>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" using ass assms unfolding s + by (induct rule: \<Delta>_Atrans_induct) auto +qed + +lemma \<Delta>_Atrans_map_prod: + assumes "finj_on f (\<Q> (fst \<G>))" and "finj_on g (\<Q> (snd \<G>))" + and "Q |\<subseteq>| \<Q> (fst \<G>) |\<times>| \<Q> (snd \<G>)" + shows "map_prod f g |`| (\<Delta>_Atrans_gtt \<G> Q) = \<Delta>_Atrans_gtt (map_prod (fmap_states_ta f) (fmap_states_ta g) \<G>) (map_prod f g |`| Q)" + (is "?LS = ?RS") +proof - + {fix p q assume "(p, q) |\<in>| \<Delta>_Atrans_gtt \<G> Q" + then have "(f p, g q) |\<in>| ?RS" using assms + proof (induct rule: \<Delta>_Atrans_induct) + case (step p q r v) + from step(3, 6, 7) have "(g q, f r) |\<in>| \<Delta>\<^sub>\<epsilon> (fmap_states_ta g (snd \<G>)) (fmap_states_ta f (fst \<G>))" + by (auto simp: \<Delta>\<^sub>\<epsilon>_def' intro!: ground_term_of_gterm) + (metis ground_term_of_gterm ground_term_to_gtermD ta_der_to_fmap_states_der) + then show ?case using step by auto + qed (auto simp add: fmap_prod_fimageI)} + moreover + {fix p q assume "(p, q) |\<in>| ?RS" + then have "(p, q) |\<in>| ?LS" using assms + proof (induct rule: \<Delta>_Atrans_induct) + case (step p q r v) + let ?f = "the_finv_into (\<Q> (fst \<G>)) f" let ?g = "the_finv_into (\<Q> (snd \<G>)) g" + have sub: "\<Delta>\<^sub>\<epsilon> (snd \<G>) (fst \<G>) |\<subseteq>| \<Q> (snd \<G>) |\<times>| \<Q> (fst \<G>)" + using \<Delta>\<^sub>\<epsilon>_statesD(1, 2) by fastforce + have s_e: "(?f p, ?g q) |\<in>| \<Delta>_Atrans_gtt \<G> Q" "(?f r, ?g v) |\<in>| \<Delta>_Atrans_gtt \<G> Q" + using step assms(1, 2) fsubsetD[OF \<Delta>_Atrans_states_stable[OF assms(3)]] + using finj_on_eq_iff[OF assms(1)] finj_on_eq_iff + using the_finv_into_f_f[OF assms(1)] the_finv_into_f_f[OF assms(2)] + by auto + from step(3) have "(?g q, ?f r) |\<in>| \<Delta>\<^sub>\<epsilon> (snd \<G>) (fst \<G>)" + using step(6-) sub + using ta_der_fmap_states_conv[OF assms(1)] ta_der_fmap_states_conv[OF assms(2)] + using the_finv_into_f_f[OF assms(1)] the_finv_into_f_f[OF assms(2)] + by (auto simp: \<Delta>\<^sub>\<epsilon>_fmember fimage_iff fBex_def) + (metis ground_term_of_gterm ground_term_to_gtermD ta_der_fmap_states_inv) + then have "(q, r) |\<in>| map_prod g f |`| \<Delta>\<^sub>\<epsilon> (snd \<G>) (fst \<G>)" using step + using the_finv_into_f_f[OF assms(1)] the_finv_into_f_f[OF assms(2)] sub + by auto (smt \<Delta>\<^sub>\<epsilon>_statesD(1, 2) f_the_finv_into_f fmap_prod_fimageI fmap_states) + then show ?case using s_e assms(1, 2) s_e + using fsubsetD[OF sub] + using fsubsetD[OF \<Delta>_Atrans_states_stable[OF assms(3)]] + using \<Delta>_Atrans_step[of "?f p" "?g q" Q "fst \<G>" "snd \<G>" "?f r" "?g v"] + using the_finv_into_f_f[OF assms(1)] the_finv_into_f_f[OF assms(2)] + by (auto simp: fimage_iff fBex_def) + (smt Pair_inject prod_fun_fimageE step.hyps(2) step.hyps(5) step.prems(3)) + qed auto} + ultimately show ?thesis by auto +qed + +\<comment> \<open>Section: Pair Automaton is closed under Determinization\<close> + +definition Q_pow where + "Q_pow Q \<S>\<^sub>1 \<S>\<^sub>2 = + {|(Wrapp X, Wrapp Y) | X Y p q. X |\<in>| fPow \<S>\<^sub>1 \<and> Y |\<in>| fPow \<S>\<^sub>2 \<and> p |\<in>| X \<and> q |\<in>| Y \<and> (p, q) |\<in>| Q|}" + +lemma Q_pow_fmember: + "(X, Y) |\<in>| Q_pow Q \<S>\<^sub>1 \<S>\<^sub>2 \<longleftrightarrow> (\<exists> p q. ex X |\<in>| fPow \<S>\<^sub>1 \<and> ex Y |\<in>| fPow \<S>\<^sub>2 \<and> p |\<in>| ex X \<and> q |\<in>| ex Y \<and> (p, q) |\<in>| Q)" +proof - + let ?S = "{(Wrapp X, Wrapp Y) | X Y p q. X |\<in>| fPow \<S>\<^sub>1 \<and> Y |\<in>| fPow \<S>\<^sub>2 \<and> p |\<in>| X \<and> q |\<in>| Y \<and> (p, q) |\<in>| Q}" + have "?S \<subseteq> map_prod Wrapp Wrapp ` fset (fPow \<S>\<^sub>1 |\<times>| fPow \<S>\<^sub>2)" by (auto simp flip: fmember.rep_eq) + from finite_subset[OF this] show ?thesis unfolding Q_pow_def + apply auto apply blast + by (meson FSet_Lex_Wrapper.exhaust_sel) +qed + +lemma pair_automaton_det_lang_sound_complete: + "pair_at_lang \<G> Q = pair_at_lang (map_both ps_ta \<G>) (Q_pow Q (\<Q> (fst \<G>)) (\<Q> (snd \<G>)))" (is "?LS = ?RS") +proof - + {fix s t assume "(s, t) \<in> ?LS" + then obtain p q where + res : "p |\<in>| ta_der (fst \<G>) (term_of_gterm s)" + "q |\<in>| ta_der (snd \<G>) (term_of_gterm t)" "(p, q) |\<in>| Q" + by (auto simp: pair_at_lang_def gta_der_def) + from ps_rules_complete[OF this(1)] ps_rules_complete[OF this(2)] this(3) + have "(s, t) \<in> ?RS" using fPow_iff ps_ta_states' + by (auto simp: pair_at_lang_def gta_der_def Q_pow_fmember) + force} + moreover + {fix s t assume "(s, t) \<in> ?RS" then have "(s, t) \<in> ?LS" + using ps_rules_sound + by (auto simp: pair_at_lang_def gta_der_def ps_ta_def Let_def Q_pow_fmember) blast} + ultimately show ?thesis by auto +qed + +lemma pair_automaton_complement_sound_complete: + assumes "partially_completely_defined_on \<A> \<F>" and "partially_completely_defined_on \ \<F>" + and "ta_det \<A>" and "ta_det \" + shows "pair_at_lang (\<A>, \) (\<Q> \<A> |\<times>| \<Q> \ |-| Q) = gterms (fset \<F>) \<times> gterms (fset \<F>) - pair_at_lang (\<A>, \) Q" + using assms unfolding partially_completely_defined_on_def pair_at_lang_def + apply (auto simp: gta_der_def) + apply (metis ta_detE) + apply fastforce + done + +end diff --git a/thys/Regular_Tree_Relations/ROOT b/thys/Regular_Tree_Relations/ROOT new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/ROOT @@ -0,0 +1,47 @@ +chapter AFP + +session Regular_Tree_Relations (AFP) = "HOL-Library" + + options + [timeout = 600] + sessions + "Knuth_Bendix_Order" + directories + "Util" + "Horn_Setup" + "Tree_Automata" + theories + "Util/Term_Context" + "Util/Basic_Utils" + "Util/FSet_Utils" + "Util/Ground_Terms" + "Util/Ground_Ctxt" + "Util/Ground_Closure" + theories + "Horn_Setup/Horn_Inference" + "Horn_Setup/Horn_List" + "Horn_Setup/Horn_Fset" + theories + "Tree_Automata/Tree_Automata" + "Tree_Automata/Tree_Automata_Det" + "Tree_Automata/Tree_Automata_Complement" + "Tree_Automata/Tree_Automata_Pumping" + "Tree_Automata/Myhill_Nerode" + theories + "GTT" + "GTT_Compose" + "GTT_Transitive_Closure" + "Pair_Automaton" + "AGTT" + "RRn_Automata" + "RR2_Infinite" + theories + "Tree_Automata/Tree_Automata_Abstract_Impl" + "Tree_Automata/Tree_Automata_Impl" + "Tree_Automata/Tree_Automata_Class_Instances_Impl" + "Regular_Relation_Abstract_Impl" + "RR2_Infinite_Q_infinity" + "Regular_Relation_Impl" + document_files + "root.bib" + "root.tex" + diff --git a/thys/Regular_Tree_Relations/RR2_Infinite.thy b/thys/Regular_Tree_Relations/RR2_Infinite.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/RR2_Infinite.thy @@ -0,0 +1,507 @@ +theory RR2_Infinite + imports RRn_Automata Tree_Automata_Pumping +begin + + +lemma map_ta_rule_id [simp]: "map_ta_rule f id r = (r_root r) (map f (r_lhs_states r)) \<rightarrow> (f (r_rhs r))" for f r + by (simp add: ta_rule.expand ta_rule.map_sel(1 - 3)) + +(* Finitness/Infinitness facts *) + +lemma no_upper_bound_infinite: + assumes "\<forall>(n::nat). \<exists>t \<in> S. n < f t" + shows "infinite S" +proof (rule ccontr, simp) + assume "finite S" + then obtain n where "n = Max (f ` S)" "\<forall> t \<in> S. f t \<le> n" by auto + then show False using assms linorder_not_le by blast +qed + +lemma set_constr_finite: + assumes "finite F" + shows "finite {h x | x. x \<in> F \<and> P x}" using assms + by (induct) auto + +lemma bounded_depth_finite: + assumes fin_F: "finite \<F>" and "\<Union> (funas_term ` S) \<subseteq> \<F>" + and "\<forall>t \<in> S. depth t \<le> n" and "\<forall>t \<in> S. ground t" + shows "finite S" using assms(2-) +proof (induction n arbitrary: S) + case 0 + {fix t assume elem: "t \<in> S" + from 0 have "depth t = 0" "ground t" "funas_term t \<subseteq> \<F>" using elem by auto + then have "\<exists> f. (f, 0) \<in> \<F> \<and> t = Fun f []" by (cases t rule: depth.cases) auto} + then have "S \<subseteq> {Fun f [] |f . (f, 0) \<in> \<F>}" by (auto simp add: image_iff) + from finite_subset[OF this] show ?case + using set_constr_finite[OF fin_F, of "\<lambda> (f, n). Fun f []" "\<lambda> x. snd x = 0"] + by auto +next + case (Suc n) + from Suc obtain S' where + S: "S' = {t :: ('a, 'b) term . ground t \<and> funas_term t \<subseteq> \<F> \<and> depth t \<le> n}" "finite S'" + by (auto simp add: SUP_le_iff) + then obtain L F where L: "set L = S'" "set F = \<F>" using fin_F by (meson finite_list) + let ?Sn = "{Fun f ts | f ts. (f, length ts) \<in> \<F> \<and> set ts \<subseteq> S'}" + let ?Ln = "concat (map (\<lambda> (f, n). map (\<lambda> ts. Fun f ts) (List.n_lists n L)) F)" + {fix t assume elem: "t \<in> S" + from Suc have "depth t \<le> Suc n" "ground t" "funas_term t \<subseteq> \<F>" using elem by auto + then have "funas_term t \<subseteq> \<F> \<and> (\<forall> x \<in> set (args t). depth x \<le> n) \<and> ground t" + by (cases t rule: depth.cases) auto + then have "t \<in> ?Sn \<union> S'" + using S by (cases t) auto} note sub = this + {fix t assume elem: "t \<in> ?Sn" + then obtain f ts where [simp]: "t = Fun f ts" and invar: "(f, length ts) \<in> \<F>" "set ts \<subseteq> S'" + by blast + then have "Fun f ts \<in> set (map (\<lambda> ts. Fun f ts) (List.n_lists (length ts) L))" using L(1) + by (auto simp: image_iff set_n_lists) + then have "t \<in> set ?Ln" using invar(1) L(2) by auto} + from this sub have sub: "?Sn \<subseteq> set ?Ln" "S \<subseteq> ?Sn \<union> S'" by blast+ + from finite_subset[OF sub(1)] finite_subset[OF sub(2)] finite_UnI[of ?Sn, OF _ S(2)] + show ?case by blast +qed + +lemma infinite_imageD: + "infinite (f ` S) \<Longrightarrow> inj_on f S \<Longrightarrow> infinite S" + by blast + +lemma infinite_imageD2: + "infinite (f ` S) \<Longrightarrow> inj f \<Longrightarrow> infinite S" + by blast + +lemma infinite_inj_image_infinite: + assumes "infinite S" and "inj_on f S" + shows "infinite (f ` S)" + using assms finite_image_iff by blast + +(*The following lemma tells us that number of terms greater than a certain depth are infinite*) +lemma infinte_no_depth_limit: + assumes "infinite S" and "finite \<F>" + and "\<forall>t \<in> S. funas_term t \<subseteq> \<F>" and "\<forall>t \<in> S. ground t" + shows "\<forall>(n::nat). \<exists>t \<in> S. n < (depth t)" +proof(rule allI, rule ccontr) + fix n::nat + assume "\<not> (\<exists>t \<in> S. (depth t) > n)" + hence "\<forall>t \<in> S. depth t \<le> n" by auto + from bounded_depth_finite[OF assms(2) _ this] show False using assms + by auto +qed + +lemma depth_gterm_conv: + "depth (term_of_gterm t) = depth (term_of_gterm t)" + by (metis leD nat_neq_iff poss_gposs_conv poss_length_bounded_by_depth poss_length_depth) + +lemma funs_term_ctxt [simp]: + "funs_term C\<langle>s\<rangle> = funs_ctxt C \<union> funs_term s" + by (induct C) auto + +lemma pigeonhole_ta_infinit_terms: + fixes t ::"'f gterm" and \<A> :: "('q, 'f) ta" + defines "t' \<equiv> term_of_gterm t :: ('f, 'q) term" + assumes "fcard (\<Q> \<A>) < depth t'" and "q |\<in>| gta_der \<A> t" and "P (funas_gterm t)" + shows "infinite {t . q |\<in>| gta_der \<A> t \<and> P (funas_gterm t)}" +proof - + from pigeonhole_tree_automata[OF _ assms(3)[unfolded gta_der_def]] assms(2,4) + obtain C C2 s v p where ctxt: "C2 \<noteq> \<box>" "C\<langle>s\<rangle> = t'" "C2\<langle>v\<rangle> = s" and + loop: "p |\<in>| ta_der \<A> v" "p |\<in>| ta_der \<A> C2\<langle>Var p\<rangle>" "q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" + unfolding assms(1) by auto + let ?terms = "\<lambda> n. C\<langle>(C2 ^n)\<langle>v\<rangle>\<rangle>" let ?inner = "\<lambda> n. (C2 ^n)\<langle>v\<rangle>" + have gr: "ground_ctxt C2" "ground_ctxt C" "ground v" + using arg_cong[OF ctxt(2), of ground] unfolding ctxt(3)[symmetric] assms(1) + by fastforce+ + moreover have funas: "funas_term (?terms (Suc n)) = funas_term t'" for n + unfolding ctxt(2, 3)[symmetric] using ctxt_comp_n_pres_funas by auto + moreover have der: "q |\<in>| ta_der \<A> (?terms (Suc n))" for n using loop + by (meson ta_der_ctxt ta_der_ctxt_n_loop) + moreover have "n < depth (?terms (Suc n))" for n + by (meson ctxt(1) ctxt_comp_n_lower_bound depth_ctxt_less_eq less_le_trans) + ultimately have "q |\<in>| ta_der \<A> (?terms (Suc n)) \<and> ground (?terms (Suc n)) \<and> + P (funas_term (?terms (Suc n))) \<and> n < depth (?terms (Suc n))" for n using assms(4) + by (auto simp: assms(1) funas_term_of_gterm_conv) + then have inf: "infinite {t. q |\<in>| ta_der \<A> t \<and> ground t \<and> P (funas_term t)}" + by (intro no_upper_bound_infinite[of _ depth]) blast + have inj: "inj_on gterm_of_term {t. q |\<in>| ta_der \<A> t \<and> ground t \<and> P (funas_term t)}" + by (intro gterm_of_term_inj) simp + show ?thesis + by (intro infinite_super[OF _ infinite_inj_image_infinite[OF inf inj]]) + (auto simp: image_def gta_der_def funas_gterm_gterm_of_term) +qed + + +lemma gterm_to_None_Some_funas [simp]: + "funas_gterm (gterm_to_None_Some t) \<subseteq> (\<lambda> (f, n). ((None, Some f), n)) ` \<F> \<longleftrightarrow> funas_gterm t \<subseteq> \<F>" + by (induct t) (auto simp: funas_gterm_def, blast) + +lemma funas_gterm_bot_some_decomp: + assumes "funas_gterm s \<subseteq> (\<lambda> (f, n). ((None, Some f), n)) ` \<F>" + shows "\<exists> t. gterm_to_None_Some t = s \<and> funas_gterm t \<subseteq> \<F>" using assms +proof (induct s) + case (GFun f ts) + from GFun(1)[OF nth_mem] obtain ss where l: "length ss = length ts \<and> (\<forall>i<length ts. gterm_to_None_Some (ss ! i) = ts ! i)" + using Ex_list_of_length_P[of "length ts" "\<lambda> s i. gterm_to_None_Some s = ts ! i"] GFun(2-) + by (auto simp: funas_gterm_def) (meson UN_subset_iff nth_mem) + then have "i < length ss \<Longrightarrow> funas_gterm (ss ! i) \<subseteq> \<F>" for i using GFun(2) + by (auto simp: UN_subset_iff) (smt (z3) gterm_to_None_Some_funas nth_mem subsetD) + then show ?case using GFun(2-) l + by (cases f) (force simp: map_nth_eq_conv UN_subset_iff dest!: in_set_idx intro!: exI[of _ "GFun (the (snd f)) ss"]) +qed + +(* Definition INF, Q_infinity and automata construction *) + +definition "Inf_branching_terms \<R> \<F> = {t . infinite {u. (t, u) \<in> \<R> \<and> funas_gterm u \<subseteq> fset \<F>} \<and> funas_gterm t \<subseteq> fset \<F>}" + +definition "Q_infty \<A> \<F> = {|q | q. infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}|}" + +lemma Q_infty_fmember: + "q |\<in>| Q_infty \<A> \<F> \<longleftrightarrow> infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}" +proof - + have "{q | q. infinite {t | t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))}} \<subseteq> fset (\<Q> \<A>)" + using not_finite_existsD notin_fset by fastforce + from finite_subset[OF this] show ?thesis + by (auto simp: Q_infty_def) +qed + +abbreviation q_inf_dash_intro_rules where + "q_inf_dash_intro_rules Q r \<equiv> if (r_rhs r) |\<in>| Q \<and> fst (r_root r) = None then {|(r_root r) (map CInl (r_lhs_states r)) \<rightarrow> CInr (r_rhs r)|} else {||}" + +abbreviation args :: "'a list \<Rightarrow> nat \<Rightarrow> ('a + 'a) list" where + "args \<equiv> \<lambda> qs i. map CInl (take i qs) @ CInr (qs ! i) # map CInl (drop (Suc i) qs)" + +abbreviation q_inf_dash_closure_rules :: "('q, 'f) ta_rule \<Rightarrow> ('q + 'q, 'f) ta_rule list" where + "q_inf_dash_closure_rules r \<equiv> (let (f, qs, q) = (r_root r, r_lhs_states r, r_rhs r) in + (map (\<lambda> i. f (args qs i) \<rightarrow> CInr q) [0 ..< length qs]))" + +definition Inf_automata :: "('q, 'f option \<times> 'f option) ta \<Rightarrow> 'q fset \<Rightarrow> ('q + 'q, 'f option \<times> 'f option) ta" where + "Inf_automata \<A> Q = TA + (( |\<Union>| (q_inf_dash_intro_rules Q |`| rules \<A>)) |\<union>| ( |\<Union>| ((fset_of_list \<circ> q_inf_dash_closure_rules) |`| rules \<A>)) |\<union>| + map_ta_rule CInl id |`| rules \<A>) (map_both Inl |`| eps \<A> |\<union>| map_both CInr |`| eps \<A>)" + +definition Inf_reg where + "Inf_reg \<A> Q = Reg (CInr |`| fin \<A>) (Inf_automata (ta \<A>) Q)" + +lemma Inr_Inl_rel_comp: + "map_both CInr |`| S |O| map_both CInl |`| S = {||}" by auto + +lemmas eps_split = ftrancl_Un2_separatorE[OF Inr_Inl_rel_comp] + +lemma Inf_automata_eps_simp [simp]: + shows "(map_both Inl |`| eps \<A> |\<union>| map_both CInr |`| eps \<A>)|\<^sup>+| = + (map_both CInl |`| eps \<A>)|\<^sup>+| |\<union>| (map_both CInr |`| eps \<A>)|\<^sup>+|" +proof - + {fix x y z assume "(x, y) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+|" + "(y, z) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+|" + then have False + by (metis Inl_Inr_False eps_statesI(1, 2) eps_states_image fimageE ftranclD ftranclD2)} + then show ?thesis by (auto simp: Inf_automata_def eps_split) +qed + +lemma map_both_CInl_ftrancl_conv: + "(map_both CInl |`| eps \<A>)|\<^sup>+| = map_both CInl |`| (eps \<A>)|\<^sup>+|" + by (intro ftrancl_map_both_fsubset) (auto simp: finj_CInl_CInr) + +lemma map_both_CInr_ftrancl_conv: + "(map_both CInr |`| eps \<A>)|\<^sup>+| = map_both CInr |`| (eps \<A>)|\<^sup>+|" + by (intro ftrancl_map_both_fsubset) (auto simp: finj_CInl_CInr) + +lemmas map_both_ftrancl_conv = map_both_CInl_ftrancl_conv map_both_CInr_ftrancl_conv + +lemma Inf_automata_Inl_to_eps [simp]: + "(CInl p, CInl q) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+|" + "(CInr p, CInr q) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+|" + "(CInl q, CInl p) |\<in>| (map_both CInr |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> False" + "(CInr q, CInr p) |\<in>| (map_both CInl |`| eps \<A>)|\<^sup>+| \<longleftrightarrow> False" + by (auto simp: map_both_ftrancl_conv dest: fmap_prod_fimageI) + +lemma Inl_eps_Inr: + "(CInl q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> (CInr q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|" + by (auto simp: Inf_automata_def) + +lemma Inr_rhs_eps_Inr_lhs: + assumes "(q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|" + obtains q' where "q = CInr q'" using assms ftrancl_map_both_fsubset[OF finj_CInl_CInr(1)] + by (cases q) (auto simp: Inf_automata_def map_both_ftrancl_conv) + +lemma Inl_rhs_eps_Inl_lhs: + assumes "(q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+|" + obtains q' where "q = CInl q'" using assms + by (cases q) (auto simp: Inf_automata_def map_both_ftrancl_conv) + +lemma Inf_automata_eps [simp]: + "(CInl q, CInr p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> False" + "(CInr q, CInl p) |\<in>| (eps (Inf_automata \<A> Q))|\<^sup>+| \<longleftrightarrow> False" + by (auto elim: Inr_rhs_eps_Inr_lhs Inl_rhs_eps_Inl_lhs) + +lemma Inl_A_res_Inf_automata: + "ta_der (fmap_states_ta CInl \<A>) t |\<subseteq>| ta_der (Inf_automata \<A> Q) t" + by (intro ta_der_mono) (auto simp: Inf_automata_def rev_fimage_eqI fmap_states_ta_def') + +lemma Inl_res_A_res_Inf_automata: + "CInl |`| ta_der \<A> (term_of_gterm t) |\<subseteq>| ta_der (Inf_automata \<A> Q) (term_of_gterm t)" + by (intro fsubset_trans[OF ta_der_fmap_states_ta_mono[of CInl \<A> t]]) (auto simp: Inl_A_res_Inf_automata) + +lemma r_rhs_CInl_args_A_rule: + assumes "f qs \<rightarrow> CInl q |\<in>| rules (Inf_automata \<A> Q)" + obtains qs' where "qs = map CInl qs'" "f qs' \<rightarrow> q |\<in>| rules \<A>" using assms + by (auto simp: Inf_automata_def split!: if_splits) + +lemma A_rule_to_dash_closure: + assumes "f qs \<rightarrow> q |\<in>| rules \<A>" and "i < length qs" + shows "f (args qs i) \<rightarrow> CInr q |\<in>| rules (Inf_automata \<A> Q)" + using assms by (auto simp add: Inf_automata_def fimage_iff fBall_def upt_fset intro!: fBexI[OF _ assms(1)]) + +lemma Inf_automata_reach_to_dash_reach: + assumes "CInl p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInl q)\<rangle>" + shows "CInr p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q)\<rangle>" (is "_ |\<in>| ta_der ?A _") + using assms +proof (induct C arbitrary: p) + case (More f ss C ts) + from More(2) obtain qs q' where + rule: "f qs \<rightarrow> q' |\<in>| rules ?A" "length qs = Suc (length ss + length ts)" and + eps: "q' = CInl p \<or> (q', CInl p) |\<in>| (eps ?A)|\<^sup>+|" and + reach: "\<forall> i < Suc (length ss + length ts). qs ! i |\<in>| ta_der ?A ((ss @ C\<langle>Var (CInl q)\<rangle> # ts) ! i)" + by auto + from eps obtain q'' where [simp]: "q' = CInl q''" + by (cases q') (auto simp add: Inf_automata_def eps_split elim: ftranclE converse_ftranclE) + from rule obtain qs' where args: "qs = map CInl qs'" "f qs' \<rightarrow> q'' |\<in>| rules \<A>" + using r_rhs_CInl_args_A_rule by (metis \<open>q' = CInl q''\<close>) + then have "CInl (qs' ! length ss) |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInl q)\<rangle>" using reach + by (auto simp: all_Suc_conv nth_append_Cons) (metis length_map less_add_Suc1 local.rule(2) nth_append_length nth_map reach) + from More(1)[OF this] More(2) show ?case + using rule args eps reach A_rule_to_dash_closure[OF args(2), of "length ss" Q] + by (auto simp: Inl_eps_Inr id_take_nth_drop all_Suc_conv + intro!: exI[of _ "CInr q''"] exI[of _ "map CInl (take (length ss) qs') @ CInr (qs' ! length ss) # map CInl (drop (Suc (length ss)) qs')"]) + (auto simp: nth_append_Cons min_def) +qed (auto simp: Inf_automata_def) + +lemma Inf_automata_dashI: + assumes "run \<A> r (gterm_to_None_Some t)" and "ex_rule_state r |\<in>| Q" + shows "CInr (ex_rule_state r) |\<in>| gta_der (Inf_automata \<A> Q) (gterm_to_None_Some t)" +proof (cases t) + case [simp]: (GFun f ts) + from run_root_rule[OF assms(1)] run_argsD[OF assms(1)] have + rule: "TA_rule (None, Some f) (map ex_comp_state (gargs r)) (ex_rule_state r) |\<in>| rules \<A>" "length (gargs r) = length ts" and + reach: "\<forall> i < length ts. ex_comp_state (gargs r ! i) |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some (ts ! i)))" + by (auto intro!: run_to_comp_st_gta_der[unfolded gta_der_def comp_def]) + from rule assms(2) have "(None, Some f) (map (CInl \<circ> ex_comp_state) (gargs r)) \<rightarrow> CInr (ex_rule_state r) |\<in>| rules (Inf_automata \<A> Q)" + by (auto simp: Inf_automata_def) force + then show ?thesis using reach rule Inl_res_A_res_Inf_automata[of \<A> "gterm_to_None_Some (ts ! i)" Q for i] + by (auto simp: gta_der_def intro!: exI[of _ "CInr (ex_rule_state r)"] exI[of _ "map (CInl \<circ> ex_comp_state) (gargs r)"]) + blast +qed + +lemma Inf_automata_dash_reach_to_reach: + assumes "p |\<in>| ta_der (Inf_automata \<A> Q) t" (is "_ |\<in>| ta_der ?A _") + shows "remove_sum p |\<in>| ta_der \<A> (map_vars_term remove_sum t)" using assms +proof (induct t arbitrary: p) + case (Var x) then show ?case + by (cases p; cases x) (auto simp: Inf_automata_def ftrancl_map_both map_both_ftrancl_conv) +next + case (Fun f ss) + from Fun(2) obtain qs q' where + rule: "f qs \<rightarrow> q' |\<in>| rules ?A" "length qs = length ss" and + eps: "q' = p \<or> (q', p) |\<in>| (eps ?A)|\<^sup>+|" and + reach: "\<forall> i < length ss. qs ! i |\<in>| ta_der ?A (ss ! i)" by auto + from rule have r: "f (map (remove_sum) qs) \<rightarrow> (remove_sum q') |\<in>| rules \<A>" + by (auto simp: comp_def Inf_automata_def min_def id_take_nth_drop[symmetric] upt_fset + simp flip: drop_map take_map split!: if_splits) + moreover have "remove_sum q' = remove_sum p \<or> (remove_sum q', remove_sum p) |\<in>| (eps \<A>)|\<^sup>+|" using eps + by (cases "is_Inl q'"; cases "is_Inl p") (auto elim!: is_InlE is_InrE, auto simp: Inf_automata_def) + ultimately show ?case using reach rule(2) Fun(1)[OF nth_mem, of i "qs ! i" for i] + by auto (metis (mono_tags, lifting) length_map map_nth_eq_conv)+ +qed + +lemma depth_poss_split: + assumes "Suc (depth (term_of_gterm t) + n) < depth (term_of_gterm u)" + shows "\<exists> p q. p @ q \<in> gposs u \<and> n < length q \<and> p \<notin> gposs t" +proof - + from poss_length_depth obtain p m where p: "p \<in> gposs u" "length p = m" "depth (term_of_gterm u) = m" + using poss_gposs_conv by blast + then obtain m' where dt: "depth (term_of_gterm t) = m'" by blast + from assms dt p(2, 3) have "length (take (Suc m') p) = Suc m'" + by (metis Suc_leI depth_gterm_conv length_take less_add_Suc1 less_imp_le_nat less_le_trans min.absorb2) + then have nt: "take (Suc m') p \<notin> gposs t" using poss_length_bounded_by_depth dt depth_gterm_conv + by (metis Suc_n_not_le_n gposs_to_poss) + moreover have "n < length (drop (Suc m') p)" using assms depth_gterm_conv dt p(2-) + by (metis add_Suc diff_diff_left length_drop zero_less_diff) + ultimately show ?thesis by (metis append_take_drop_id p(1)) +qed + +lemma Inf_to_automata: + assumes "RR2_spec \<A> \<R>" and "t \<in> Inf_branching_terms \<R> \<F>" + shows "\<exists> u. gpair t u \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" (is "\<exists> u. gpair t u \<in> \<L> ?B") +proof - + let ?A = "Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)" + let ?t_of_g = "\<lambda> t. term_of_gterm t :: ('b, 'a) term" + obtain n where depth_card: "depth (?t_of_g t) + fcard (\<Q> (ta \<A>)) < n" by auto + from assms(1, 2) have fin: "infinite {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}" + by (auto simp: RR2_spec_def Inf_branching_terms_def) + from infinte_no_depth_limit[of "?t_of_g ` {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}" "fset \<F>"] this + have "\<forall> n. \<exists>t \<in> ?t_of_g ` {u. gpair t u \<in> \<L> \<A> \<and> funas_gterm u \<subseteq> fset \<F>}. n < depth t" + by (simp add: infinite_inj_image_infinite[OF fin] funas_term_of_gterm_conv inj_term_of_gterm) + from this depth_card obtain u where funas: "funas_gterm u \<subseteq> fset \<F>" and + depth: "Suc n < depth (?t_of_g u)" and lang: "gpair t u \<in> \<L> \<A>" by auto + have "Suc (depth (term_of_gterm t) + fcard (\<Q> (ta \<A>))) < depth (term_of_gterm u)" + using depth depth_card by (metis Suc_less_eq2 depth_gterm_conv less_trans) + from depth_poss_split[OF this] obtain p q where + pos: "p @ q \<in> gposs u" "p \<notin> gposs t" and card: "fcard (\<Q> (ta \<A>)) < length q" by auto + then have gp: "gsubt_at (gpair t u) p = gterm_to_None_Some (gsubt_at u p)" + using subst_at_gpair_nt_poss_None_Some[of p] by force + from lang obtain r where r: "run (ta \<A>) r (gpair t u)" "ex_comp_state r |\<in>| fin \<A>" + unfolding \<L>_def gta_lang_def by (fastforce dest: gta_der_to_run) + from pos have p_gtu: "p \<in> gposs (gpair t u)" and pu: "p \<in> gposs u" + using not_gposs_append by auto + have qinf: "ex_rule_state (gsubt_at r p) |\<in>| Q_infty (ta \<A>) \<F>" + using funas_gterm_gsubt_at_subseteq[OF pu] funas card + unfolding Q_infty_fmember gta_der_def[symmetric] + by (intro infinite_super[THEN infinite_imageD2[OF _ inj_gterm_to_None_Some], + OF _ pigeonhole_ta_infinit_terms[of "ta \<A>" "gsubt_at (gpair t u) p" _ + "\<lambda> t. t \<subseteq> (\<lambda>(f, n). ((None, Some f), n)) ` fset \<F>", + OF _ run_to_gta_der_gsubt_at(1)[OF r(1) p_gtu]]]) + (auto simp: poss_length_bounded_by_depth[of q] image_iff gp less_le_trans + pos(1) poss_gposs_conv pu dest!: funas_gterm_bot_some_decomp) + from Inf_automata_dashI[OF run_gsubt_cl[OF r(1) p_gtu, unfolded gp] qinf] + have dashI: "CInr (ex_rule_state (gsubt_at r p)) |\<in>| gta_der (Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)) (gsubt_at (gpair t u) p)" + unfolding gp[symmetric] . + have "CInl (ex_comp_state r) |\<in>| ta_der ?A (ctxt_at_pos (term_of_gterm (gpair t u)) p)\<langle>Var (CInl (ex_rule_state (gsubt_at r p)))\<rangle>" + using ta_der_fmap_states_ta[OF run_ta_der_ctxt_split2[OF r(1) p_gtu], of CInl, THEN fsubsetD[OF Inl_A_res_Inf_automata]] + unfolding replace_term_at_replace_at_conv[OF gposs_to_poss[OF p_gtu]] + by (auto simp: gterm.map_ident simp flip: map_term_replace_at_dist[OF gposs_to_poss[OF p_gtu]]) + from ta_der_ctxt[OF dashI[unfolded gta_der_def] Inf_automata_reach_to_dash_reach[OF this]] + have "CInr (ex_comp_state r) |\<in>| gta_der (Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)) (gpair t u)" + unfolding replace_term_at_replace_at_conv[OF gposs_to_poss[OF p_gtu]] + unfolding replace_gterm_conv[OF p_gtu] + by (auto simp: gta_der_def) + moreover from r(2) have "CInr (ex_comp_state r) |\<in>| fin (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" + by (auto simp: Inf_reg_def) + ultimately show ?thesis using r(2) + by (auto simp: \<L>_def gta_der_def Inf_reg_def intro: exI[of _ u]) +qed + +lemma CInr_Inf_automata_to_q_state: + assumes "CInr p |\<in>| ta_der (Inf_automata \<A> Q) t" and "ground t" + shows "\<exists> C s q. C\<langle>s\<rangle> = t \<and> CInr q |\<in>| ta_der (Inf_automata \<A> Q) s \<and> q |\<in>| Q \<and> + CInr p |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q)\<rangle> \<and> + (fst \<circ> fst \<circ> the \<circ> root) s = None" using assms +proof (induct t arbitrary: p) + case (Fun f ts) + let ?A = "(Inf_automata \<A> Q)" + from Fun(2) obtain qs q' where + rule: "f qs \<rightarrow> CInr q' |\<in>| rules ?A" "length qs = length ts" and + eps: "q' = p \<or> (CInr q', CInr p) |\<in>| (eps ?A)|\<^sup>+|" and + reach: "\<forall> i < length ts. qs ! i |\<in>| ta_der ?A (ts ! i)" + by auto (metis Inr_rhs_eps_Inr_lhs) + consider (a) "\<And> i. i < length qs \<Longrightarrow> \<exists> q''. qs ! i = CInl q''" | (b) "\<exists> i < length qs. \<exists> q''. qs ! i = CInr q''" + by (meson remove_sum.cases) + then show ?case + proof cases + case a + then have "f qs \<rightarrow> CInr q' |\<in>| |\<Union>| (q_inf_dash_intro_rules Q |`| rules \<A>)" using rule + by (auto simp: Inf_automata_def min_def upt_fset split!: if_splits) + (metis (no_types, lifting) Inl_Inr_False Suc_pred append_eq_append_conv id_take_nth_drop + length_Cons length_drop length_greater_0_conv length_map + less_nat_zero_code list.size(3) nth_append_length rule(2)) + then show ?thesis using reach eps rule + by (intro exI[of _ Hole] exI[of _ "Fun f ts"] exI[of _ q']) + (auto split!: if_splits) + next + case b + then obtain i q'' where b: "i < length ts" "qs ! i = CInr q''" using rule(2) by auto + then have "CInr q'' |\<in>| ta_der ?A (ts ! i)" using rule(2) reach by auto + from Fun(3) Fun(1)[OF nth_mem, OF b(1) this] b rule(2) obtain C s q''' where + ctxt: "C\<langle>s\<rangle> = ts ! i" and + qinf: "CInr q''' |\<in>| ta_der (Inf_automata \<A> Q) s \<and> q''' |\<in>| Q" and + reach2: "CInr q'' |\<in>| ta_der (Inf_automata \<A> Q) C\<langle>Var (CInr q''')\<rangle>" and + "(fst \<circ> fst \<circ> the \<circ> root) s = None" + by auto + then show ?thesis using rule eps reach ctxt qinf reach2 b(1) b(2)[symmetric] + by (auto simp: min_def nth_append_Cons simp flip: map_append id_take_nth_drop[OF b(1)] + intro!: exI[of _ "More f (take i ts) C (drop (Suc i) ts)"] exI[of _ "s"] exI[of _ "q'''"] exI[of _ "CInr q'"] exI[of _ "qs"]) + qed +qed auto + +lemma aux_lemma: + assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" + and "infinite {u | u. gpair t u \<in> \<L> \<A>}" + shows "t \<in> Inf_branching_terms \<R> \<F>" +proof - + from assms have [simp]: "gpair t u \<in> \<L> \<A> \<longleftrightarrow> (t, u) \<in> \<R> \<and> u \<in> \<T>\<^sub>G (fset \<F>)" + for u by (auto simp: RR2_spec_def) + from assms have "t \<in> \<T>\<^sub>G (fset \<F>)" unfolding RR2_spec_def + by (auto dest: not_finite_existsD) + then show ?thesis using assms unfolding Inf_branching_terms_def + by (auto simp: \<T>\<^sub>G_equivalent_def) +qed + +lemma Inf_automata_to_Inf: + assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" + and "gpair t u \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" + shows "t \<in> Inf_branching_terms \<R> \<F>" +proof - + let ?con = "\<lambda> t. term_of_gterm (gterm_to_None_Some t)" + let ?A = "Inf_automata (ta \<A>) (Q_infty (ta \<A>) \<F>)" + from assms(3) obtain q where fin: "q |\<in>| fin \<A>" and + reach_fin: "CInr q |\<in>| ta_der ?A (term_of_gterm (gpair t u))" + by (auto simp: Inf_reg_def \<L>_def Inf_automata_def elim!: gta_langE) + from CInr_Inf_automata_to_q_state[OF reach_fin] obtain C s p where + ctxt: "C\<langle>s\<rangle> = term_of_gterm (gpair t u)" and + q_inf_st: "CInr p |\<in>| ta_der ?A s" "p |\<in>| Q_infty (ta \<A>) \<F>" and + reach: "CInr q |\<in>| ta_der ?A C\<langle>Var (CInr p)\<rangle>" and + none: "(fst \<circ> fst \<circ> the \<circ> root) s = None" by auto + have gr: "ground s" "ground_ctxt C" using arg_cong[OF ctxt, of ground] + by auto + have reach: "q |\<in>| ta_der (ta \<A>) (adapt_vars_ctxt C)\<langle>Var p\<rangle>" + using gr Inf_automata_dash_reach_to_reach[OF reach] + by (auto simp: map_vars_term_ctxt_apply) + from q_inf_st(2) have inf: "infinite {v. funas_gterm v \<subseteq> fset \<F> \<and> p |\<in>| ta_der (ta \<A>) (?con v)}" + by (simp add: Q_infty_fmember) + have inf: "infinite {v. funas_gterm v \<subseteq> fset \<F> \<and> q |\<in>| gta_der (ta \<A>) (gctxt_of_ctxt C)\<langle>gterm_to_None_Some v\<rangle>\<^sub>G}" + using reach ground_ctxt_adapt_ground[OF gr(2)] gr + by (intro infinite_super[OF _ inf], auto simp: gta_der_def) + (smt (z3) adapt_vars_ctxt adapt_vars_term_of_gterm ground_gctxt_of_ctxt_apply_gterm ta_der_ctxt) + have *: "gfun_at (gterm_of_term C\<langle>s\<rangle>) (hole_pos C) = gfun_at (gterm_of_term s) []" + by (induct C) (auto simp: nth_append_Cons) + from arg_cong[OF ctxt, of "\<lambda> t. gfun_at (gterm_of_term t) (hole_pos C)"] none + have hp_nt: "ghole_pos (gctxt_of_ctxt C) \<notin> gposs t" unfolding ground_hole_pos_to_ghole[OF gr(2)] + using gfun_at_gpair[of t u "hole_pos C"] gr * + by (cases s) (auto simp flip: poss_gposs_mem_conv split: if_splits elim: gfun_at_possE) + from gpair_ctxt_decomposition[OF hp_nt, of u "gsubt_at u (hole_pos C)"] + have to_gpair: "gpair t (gctxt_at_pos u (hole_pos C))\<langle>v\<rangle>\<^sub>G = (gctxt_of_ctxt C)\<langle>gterm_to_None_Some v\<rangle>\<^sub>G" for v + unfolding ground_hole_pos_to_ghole[OF gr(2)] using ctxt gr + using subst_at_gpair_nt_poss_None_Some[OF _ hp_nt, of u] + by (metis (no_types, lifting) UnE \<open>ghole_pos (gctxt_of_ctxt C) = hole_pos C\<close> + gposs_of_gpair gsubt_at_gctxt_apply_ghole hole_pos_in_ctxt_apply hp_nt poss_gposs_conv term_of_gterm_ctxt_apply) + have inf: "infinite {v. gpair t ((gctxt_at_pos u (hole_pos C))\<langle>v\<rangle>\<^sub>G) \<in> \<L> \<A>}" using fin + by (intro infinite_super[OF _ inf]) (auto simp: \<L>_def gta_der_def simp flip: to_gpair) + have "infinite {u |u. gpair t u \<in> \<L> \<A>}" + by (intro infinite_super[OF _ infinite_inj_image_infinite[OF inf gctxt_apply_inj_on_term[of "gctxt_at_pos u (hole_pos C)"]]]) + (auto simp: image_def intro: infinite_super) + then show ?thesis using assms(1, 2) + by (intro aux_lemma[of \<A>]) simp +qed + +lemma Inf_automata_subseteq: + "\<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>)) \<subseteq> \<L> \<A>" (is "\<L> ?IA \<subseteq> _") +proof + fix s assume l: "s \<in> \<L> ?IA" + then obtain q where w: "q |\<in>| fin ?IA" "q |\<in>| ta_der (ta ?IA) (term_of_gterm s)" + by (auto simp: \<L>_def elim!: gta_langE) + from w(1) have "remove_sum q |\<in>| fin \<A>" + by (auto simp: Inf_reg_def Inf_automata_def) + then show "s \<in> \<L> \<A>" using Inf_automata_dash_reach_to_reach[of q "ta \<A>"] w(2) + by (auto simp: gterm.map_ident \<L>_def Inf_reg_def) + (metis gta_langI map_vars_term_term_of_gterm) +qed + +lemma \<L>_Inf_reg: + assumes "RR2_spec \<A> \<R>" and "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" + shows "gfst ` \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>)) = Inf_branching_terms \<R> \<F>" +proof - + {fix s assume ass: "s \<in> \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" + then have "\<exists> t u. s = gpair t u" using Inf_automata_subseteq[of \<A> \<F>] assms(1) + by (auto simp: RR2_spec_def) + then have "gfst s \<in> Inf_branching_terms \<R> \<F>" + using ass Inf_automata_to_Inf[OF assms] + by (force simp: gfst_gpair)} + then show ?thesis using Inf_to_automata[OF assms(1), of _ \<F>] + by (auto simp: gfst_gpair) (metis gfst_gpair image_iff) +qed +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/RR2_Infinite_Q_infinity.thy b/thys/Regular_Tree_Relations/RR2_Infinite_Q_infinity.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/RR2_Infinite_Q_infinity.thy @@ -0,0 +1,464 @@ +theory RR2_Infinite_Q_infinity + imports RR2_Infinite +begin + +(* This section constructs an executable membership check for Q infinity, + since Inf_automata is already executable (for all sets Q where checking membership is executable) +*) + +lemma if_cong': + "b = c \<Longrightarrow> x = u \<Longrightarrow> y = v \<Longrightarrow> (if b then x else y) = (if c then u else v)" + by auto + +(* The reachable terms where eps transitions can only occur after the rule *) +fun ta_der_strict :: "('q,'f) ta \<Rightarrow> ('f,'q) term \<Rightarrow> 'q fset" where + "ta_der_strict \<A> (Var q) = {|q|}" +| "ta_der_strict \<A> (Fun f ts) = {| q' | q' q qs. TA_rule f qs q |\<in>| rules \<A> \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|) \<and> + length qs = length ts \<and> (\<forall> i < length ts. qs ! i |\<in>| ta_der_strict \<A> (ts ! i))|}" + +lemma ta_der_strict_Var: + "q |\<in>| ta_der_strict \<A> (Var x) \<longleftrightarrow> x = q" + unfolding ta_der.simps by auto + +lemma ta_der_strict_Fun: + "q |\<in>| ta_der_strict \<A> (Fun f ts) \<longleftrightarrow> (\<exists> ps p. TA_rule f ps p |\<in>| (rules \<A>) \<and> + (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|) \<and> length ps = length ts \<and> + (\<forall> i < length ts. ps ! i |\<in>| ta_der_strict \<A> (ts ! i)))" (is "?Ls \<longleftrightarrow> ?Rs") + unfolding ta_der_strict.simps + by (intro iffI fCollect_memberI finite_Collect_less_eq[OF _ finite_eps[of \<A>]]) auto + +declare ta_der_strict.simps[simp del] +lemmas ta_der_strict_simps [simp] = ta_der_strict_Var ta_der_strict_Fun + +lemma ta_der_strict_sub_ta_der: + "ta_der_strict \<A> t |\<subseteq>| ta_der \<A> t" +proof (induct t) + case (Fun f ts) + then show ?case + by auto (metis fsubsetD nth_mem)+ +qed auto + +lemma ta_der_strict_ta_der_eq_on_ground: + assumes"ground t" + shows "ta_der \<A> t = ta_der_strict \<A> t" +proof + {fix q assume "q |\<in>| ta_der \<A> t" then have "q |\<in>| ta_der_strict \<A> t" using assms + proof (induct t arbitrary: q) + case (Fun f ts) + then show ?case apply auto + using nth_mem by blast+ + qed auto} + then show "ta_der \<A> t |\<subseteq>| ta_der_strict \<A> t" + by auto +next + show "ta_der_strict \<A> t |\<subseteq>| ta_der \<A> t" using ta_der_strict_sub_ta_der . +qed + +lemma ta_der_to_ta_strict: + assumes "q |\<in>| ta_der A C\<langle>Var p\<rangle>" and "ground_ctxt C" + shows "\<exists> q'. (p = q' \<or> (p, q') |\<in>| (eps A)|\<^sup>+|) \<and> q |\<in>| ta_der_strict A C\<langle>Var q'\<rangle>" + using assms +proof (induct C arbitrary: q p) + case (More f ss C ts) + from More(2) obtain qs q' where + r: "TA_rule f qs q' |\<in>| rules A" "length qs = Suc (length ss + length ts)" "q' = q \<or> (q', q) |\<in>| (eps A)|\<^sup>+|" and + rec: "\<forall> i < length qs. qs ! i |\<in>| ta_der A ((ss @ C\<langle>Var p\<rangle> # ts) ! i)" + by auto + from More(1)[of "qs ! length ss" p] More(3) rec r(2) obtain q'' where + mid: "(p = q'' \<or> (p, q'') |\<in>| (eps A)|\<^sup>+|) \<and> qs ! length ss |\<in>| ta_der_strict A C\<langle>Var q''\<rangle>" + by auto (metis length_map less_add_Suc1 nth_append_length) + then have "\<forall> i < length qs. qs ! i |\<in>| ta_der_strict A ((ss @ C\<langle>Var q''\<rangle> # ts) ! i)" + using rec r(2) More(3) + using ta_der_strict_ta_der_eq_on_ground[of _ A] + by (auto simp: nth_append_Cons all_Suc_conv fmember.rep_eq split:if_splits cong: if_cong') + then show ?case using rec r conjunct1[OF mid] + by (rule_tac x = q'' in exI, auto intro!: exI[of _ q'] exI[of _ qs]) +qed auto + +fun root_ctxt where + "root_ctxt (More f ss C ts) = f" +| "root_ctxt \<box> = undefined" + +lemma root_to_root_ctxt [simp]: + assumes "C \<noteq> \<box>" + shows "fst (the (root C\<langle>t\<rangle>)) \<longleftrightarrow> root_ctxt C" + using assms by (cases C) auto + + +(* Q_inf section *) + +inductive_set Q_inf for \<A> where + trans: "(p, q) \<in> Q_inf \<A> \<Longrightarrow> (q, r) \<in> Q_inf \<A> \<Longrightarrow> (p, r) \<in> Q_inf \<A>" +| rule: "(None, Some f) qs \<rightarrow> q |\<in>| rules \<A> \<Longrightarrow> i < length qs \<Longrightarrow> (qs ! i, q) \<in> Q_inf \<A>" +| eps: "(p, q) \<in> Q_inf \<A> \<Longrightarrow> (q, r) |\<in>| eps \<A> \<Longrightarrow> (p, r) \<in> Q_inf \<A>" + +abbreviation "Q_inf_e \<A> \<equiv> {q | p q. (p, p) \<in> Q_inf \<A> \<and> (p, q) \<in> Q_inf \<A>}" + +lemma Q_inf_states_ta_states: + assumes "(p, q) \<in> Q_inf \<A>" + shows "p |\<in>| \<Q> \<A>" "q |\<in>| \<Q> \<A>" + using assms by (induct) (auto simp: rule_statesD eps_statesD) + +lemma Q_inf_finite: + "finite (Q_inf \<A>)" "finite (Q_inf_e \<A>)" +proof - + have *: "Q_inf \<A> \<subseteq> fset (\<Q> \<A> |\<times>| \<Q> \<A>)" "Q_inf_e \<A> \<subseteq> fset (\<Q> \<A>)" + by (auto simp add: Q_inf_states_ta_states(1, 2) subrelI simp flip: fmember.rep_eq) + show "finite (Q_inf \<A>)" + by (intro finite_subset[OF *(1)]) simp + show "finite (Q_inf_e \<A>)" + by (intro finite_subset[OF *(2)]) simp +qed + +context +includes fset.lifting +begin +lift_definition fQ_inf :: "('a, 'b option \<times> 'c option) ta \<Rightarrow> ('a \<times> 'a) fset" is Q_inf + by (simp add: Q_inf_finite(1)) +lift_definition fQ_inf_e :: "('a, 'b option \<times> 'c option) ta \<Rightarrow> 'a fset" is Q_inf_e + using Q_inf_finite(2) . +end + + +lemma Q_inf_ta_eps_Q_inf: + assumes "(p, q) \<in> Q_inf \<A>" and "(q, q') |\<in>| (eps \<A>)|\<^sup>+|" + shows "(p, q') \<in> Q_inf \<A>" using assms(2, 1) + by (induct rule: ftrancl_induct) (auto simp add: Q_inf.eps) + +lemma lhs_state_rule: + assumes "(p, q) \<in> Q_inf \<A>" + shows "\<exists> f qs r. (None, Some f) qs \<rightarrow> r |\<in>| rules \<A> \<and> p |\<in>| fset_of_list qs" + using assms by induct (force intro: nth_mem)+ + +lemma Q_inf_reach_state_rule: + assumes "(p, q) \<in> Q_inf \<A>" and "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" + shows "\<exists> ss ts f C. q |\<in>| ta_der \<A> (More (None, Some f) ss C ts)\<langle>Var p\<rangle> \<and> ground_ctxt (More (None, Some f) ss C ts)" + (is "\<exists> ss ts f C. ?P ss ts f C q p") + using assms +proof (induct) + case (trans p q r) + then obtain f1 f2 ss1 ts1 ss2 ts2 C1 C2 where + C: "?P ss1 ts1 f1 C1 q p" "?P ss2 ts2 f2 C2 r q" by blast + then show ?case + apply (rule_tac x = "ss2" in exI, rule_tac x = "ts2" in exI, rule_tac x = "f2" in exI, + rule_tac x = "C2 \<circ>\<^sub>c (More (None, Some f1) ss1 C1 ts1)" in exI) + apply (auto simp del: ctxt_apply_term.simps) + apply (metis Subterm_and_Context.ctxt_ctxt_compose ctxt_compose.simps(2) ta_der_ctxt) + done +next + case (rule f qs q i) + have "\<forall> i < length qs. \<exists> t. qs ! i |\<in>| ta_der \<A> t \<and> ground t" + using rule(1, 2) fset_mp[OF rule(3), of "qs ! i" for i] + by auto (meson fnth_mem rule_statesD(4) ta_reachableE) + then obtain ts where wit: "length ts = length qs" + "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (ts ! i) \<and> ground (ts ! i)" + using Ex_list_of_length_P[of "length qs" "\<lambda> x i. qs ! i |\<in>| ta_der \<A> x \<and> ground x"] by blast + {fix j assume "j < length qs" + then have "qs ! j |\<in>| ta_der \<A> ((take i ts @ Var (qs ! i) # drop (Suc i) ts) ! j)" + using wit by (cases "j < i") (auto simp: min_def nth_append_Cons)} + then have "\<forall> i < length qs. qs ! i |\<in>| (map (ta_der \<A>) (take i ts @ Var (qs ! i) # drop (Suc i) ts)) ! i" + using wit rule(2) by (auto simp: nth_append_Cons) + then have res: "q |\<in>| ta_der \<A> (Fun (None, Some f) (take i ts @ Var (qs ! i) # drop (Suc i) ts))" + using rule(1, 2) wit by (auto simp: min_def nth_append_Cons intro!: exI[of _ q] exI[of _ qs]) + then show ?case using rule(1, 2) wit + apply (rule_tac x = "take i ts" in exI, rule_tac x = "drop (Suc i) ts" in exI) + apply (auto simp: take_map drop_map dest!: in_set_takeD in_set_dropD simp del: ta_der_simps intro!: exI[of _ f] exI[of _ Hole]) + apply (metis all_nth_imp_all_set)+ + done +next + case (eps p q r) + then show ?case by (meson r_into_rtrancl ta_der_eps) +qed + +lemma rule_target_Q_inf: + assumes "(None, Some f) qs \<rightarrow> q' |\<in>| rules \<A>" and "i < length qs" + shows "(qs ! i, q') \<in> Q_inf \<A>" using assms + by (intro rule) auto + +lemma rule_target_eps_Q_inf: + assumes "(None, Some f) qs \<rightarrow> q' |\<in>| rules \<A>" "(q', q) |\<in>| (eps \<A>)|\<^sup>+|" + and "i < length qs" + shows "(qs ! i, q) \<in> Q_inf \<A>" + using assms(2, 1, 3) by (induct rule: ftrancl_induct) (auto intro: rule eps) + + +lemma step_in_Q_inf: + assumes "q |\<in>| ta_der_strict \<A> (map_funs_term (\<lambda>f. (None, Some f)) (Fun f (ss @ Var p # ts)))" + shows "(p, q) \<in> Q_inf \<A>" + using assms rule_target_eps_Q_inf[of f _ _ \<A> q] rule_target_Q_inf[of f _ q \<A>] + by (auto simp: comp_def nth_append_Cons split!: if_splits) + + +lemma ta_der_Q_inf: + assumes "q |\<in>| ta_der_strict \<A> (map_funs_term (\<lambda>f. (None, Some f)) (C\<langle>Var p\<rangle>))" and "C \<noteq> Hole" + shows "(p, q) \<in> Q_inf \<A>" using assms +proof (induct C arbitrary: q) + case (More f ss C ts) + then show ?case + proof (cases "C = Hole") + case True + then show ?thesis using More(2) by (auto simp: step_in_Q_inf) + next + case False + then obtain q' where q: "q' |\<in>| ta_der_strict \<A> (map_funs_term (\<lambda>f. (None, Some f)) C\<langle>Var p\<rangle>)" + "q |\<in>| ta_der_strict \<A> (map_funs_term (\<lambda>f. (None, Some f)) (Fun f (ss @ Var q' # ts)))" + using More(2) length_map + (* SLOW *) + by (auto simp: comp_def nth_append_Cons split: if_splits cong: if_cong') + (smt nat_neq_iff nth_map ta_der_strict_simps)+ + have "(p, q') \<in> Q_inf \<A>" using More(1)[OF q(1) False] . + then show ?thesis using step_in_Q_inf[OF q(2)] by (auto intro: trans) + qed +qed auto + +lemma Q_inf_e_infinite_terms_res: + assumes "q \<in> Q_inf_e \<A>" and "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" + shows "infinite {t. q |\<in>| ta_der \<A> (term_of_gterm t) \<and> fst (groot_sym t) = None}" +proof - + let ?P ="\<lambda> u. ground u \<and> q |\<in>| ta_der \<A> u \<and> fst (fst (the (root u))) = None" + have groot[simp]: "fst (fst (the (root (term_of_gterm t)))) = fst (groot_sym t)" for t by (cases t) auto + have [simp]: "C \<noteq> \<box> \<Longrightarrow> fst (fst (the (root C\<langle>t\<rangle>))) = fst (root_ctxt C)" for C t by (cases C) auto + from assms(1) obtain p where cycle: "(p, p) \<in> Q_inf \<A>" "(p, q) \<in> Q_inf \<A>" by auto + from Q_inf_reach_state_rule[OF cycle(1) assms(2)] obtain C where + ctxt: "C \<noteq> \<box>" "ground_ctxt C" and reach: "p |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" + by blast + obtain C2 where + closing_ctxt: "C2 \<noteq> \<box>" "ground_ctxt C2" "fst (root_ctxt C2) = None" and cl_reach: "q |\<in>| ta_der \<A> C2\<langle>Var p\<rangle>" + by (metis (full_types) Q_inf_reach_state_rule[OF cycle(2) assms(2)] ctxt.distinct(1) fst_conv root_ctxt.simps(1)) + from assms(2) obtain t where t: "p |\<in>| ta_der \<A> t" and gr_t: "ground t" + by (meson Q_inf_states_ta_states(1) cycle(1) fsubsetD ta_reachableE) + let ?terms = "\<lambda> n. (C ^ Suc n)\<langle>t\<rangle>" let ?S = "{?terms n | n. p |\<in>| ta_der \<A> (?terms n) \<and> ground (?terms n)}" + have "ground (?terms n)" for n using ctxt(2) gr_t by auto + moreover have "p |\<in>| ta_der \<A> (?terms n)" for n using reach t(1) + by (auto simp: ta_der_ctxt) (meson ta_der_ctxt ta_der_ctxt_n_loop) + ultimately have inf: "infinite ?S" using ctxt_comp_n_lower_bound[OF ctxt(1)] + using no_upper_bound_infinite[of _ depth, of ?S] by blast + from infinite_inj_image_infinite[OF this] have inf:"infinite (ctxt_apply_term C2 ` ?S)" + by (smt ctxt_eq inj_on_def) + {fix u assume "u \<in> (ctxt_apply_term C2 ` ?S)" + then have "?P u" unfolding image_Collect using closing_ctxt cl_reach + by (auto simp: ta_der_ctxt)} + from this have inf: "infinite {u. ground u \<and> q |\<in>| ta_der \<A> u \<and> fst (fst (the (root u))) = None}" + by (intro infinite_super[OF _ inf] subsetI) fast + have inf: "infinite (gterm_of_term ` {u. ground u \<and> q |\<in>| ta_der \<A> u \<and> fst (fst (the (root u))) = None})" + by (intro infinite_inj_image_infinite[OF inf] gterm_of_term_inj) auto + show ?thesis + by (intro infinite_super[OF _ inf]) (auto dest: groot_sym_gterm_of_term) +qed + + + + + + + + + + + + + +lemma gfun_at_after_hole_pos: + assumes "ghole_pos C \<le>\<^sub>p p" + shows "gfun_at C\<langle>t\<rangle>\<^sub>G p = gfun_at t (p -\<^sub>p ghole_pos C)" using assms +proof (induct C arbitrary: p) + case (GMore f ss C ts) then show ?case + by (cases p) auto +qed auto + +lemma pos_diff_0 [simp]: "p -\<^sub>p p = []" + by (auto simp: pos_diff_def) + +lemma Max_suffI: "finite A \<Longrightarrow> A = B \<Longrightarrow> Max A = Max B" + by (intro Max_eq_if) auto + +lemma nth_args_depth_eqI: + assumes "length ss = length ts" + and "\<And> i. i < length ts \<Longrightarrow> depth (ss ! i) = depth (ts ! i)" + shows "depth (Fun f ss) = depth (Fun g ts)" +proof - + from assms(1, 2) have "depth ` set ss = depth ` set ts" + using nth_map_conv[OF assms(1), of depth depth] + by (simp flip: set_map) + from Max_suffI[OF _ this] show ?thesis using assms(1) + by (cases ss; cases ts) auto +qed + +lemma subt_at_ctxt_apply_hole_pos [simp]: "C\<langle>s\<rangle> |_ hole_pos C = s" + by (induct C) auto + +lemma ctxt_at_pos_ctxt_apply_hole_poss [simp]: "ctxt_at_pos C\<langle>s\<rangle> (hole_pos C) = C" + by (induct C) auto + +abbreviation "map_funs_ctxt f \<equiv> map_ctxt f (\<lambda> x. x)" +lemma map_funs_term_ctxt_apply [simp]: + "map_funs_term f C\<langle>s\<rangle> = (map_funs_ctxt f C)\<langle>map_funs_term f s\<rangle>" + by (induct C) auto + +lemma map_funs_term_ctxt_decomp: + assumes "map_funs_term fg t = C\<langle>s\<rangle>" + shows "\<exists> D u. C = map_funs_ctxt fg D \<and> s = map_funs_term fg u \<and> t = D\<langle>u\<rangle>" +using assms +proof (induct C arbitrary: t) + case Hole + show ?case + by (rule exI[of _ Hole], rule exI[of _ t], insert Hole, auto) +next + case (More g bef C aft) + from More(2) obtain f ts where t: "t = Fun f ts" by (cases t, auto) + from More(2)[unfolded t] have f: "fg f = g" and ts: "map (map_funs_term fg) ts = bef @ C\<langle>s\<rangle> # aft" (is "?ts = ?bca") by auto + from ts have "length ?ts = length ?bca" by auto + then have len: "length ts = length ?bca" by auto + note id = ts[unfolded map_nth_eq_conv[OF len], THEN spec, THEN mp] + let ?i = "length bef" + from len have i: "?i < length ts" by auto + from id[of ?i] have "map_funs_term fg (ts ! ?i) = C\<langle>s\<rangle>" by auto + from More(1)[OF this] obtain D u where D: "C = map_funs_ctxt fg D" and + u: "s = map_funs_term fg u" and id: "ts ! ?i = D\<langle>u\<rangle>" by auto + from ts have "take ?i ?ts = take ?i ?bca" by simp + also have "... = bef" by simp + finally have bef: "map (map_funs_term fg) (take ?i ts) = bef" by (simp add: take_map) + from ts have "drop (Suc ?i) ?ts = drop (Suc ?i) ?bca" by simp + also have "... = aft" by simp + finally have aft: "map (map_funs_term fg) (drop (Suc ?i) ts) = aft" by (simp add:drop_map) + let ?bda = "take ?i ts @ D\<langle>u\<rangle> # drop (Suc ?i) ts" + show ?case + proof (rule exI[of _ "More f (take ?i ts) D (drop (Suc ?i) ts)"], + rule exI[of _ u], simp add: u f D bef aft t) + have "ts = take ?i ts @ ts ! ?i # drop (Suc ?i) ts" + by (rule id_take_nth_drop[OF i]) + also have "... = ?bda" by (simp add: id) + finally show "ts = ?bda" . + qed +qed + + + + + +lemma prod_automata_from_none_root_dec: + assumes "gta_lang Q \<A> \<subseteq> {gpair s t| s t. funas_gterm s \<subseteq> \<F> \<and> funas_gterm t \<subseteq> \<F>}" + and "q |\<in>| ta_der \<A> (term_of_gterm t)" and "fst (groot_sym t) = None" + and "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" and "q |\<in>| ta_productive Q \<A>" + shows "\<exists> u. t = gterm_to_None_Some u \<and> funas_gterm u \<subseteq> \<F>" +proof - + have *: "gfun_at t [] = Some (groot_sym t)" by (cases t) auto + from assms(4, 5) obtain C q\<^sub>f where ctxt: "ground_ctxt C" and + fin: "q\<^sub>f |\<in>| ta_der \<A> C\<langle>Var q\<rangle>" "q\<^sub>f |\<in>| Q" + by (auto simp: ta_productive_def'[OF assms(4)]) + then obtain s v where gp: "gpair s v = (gctxt_of_ctxt C)\<langle>t\<rangle>\<^sub>G" and + funas: "funas_gterm v \<subseteq> \<F>" + using assms(1, 2) gta_langI[OF fin(2), of \<A> "(gctxt_of_ctxt C)\<langle>t\<rangle>\<^sub>G"] + by (auto simp: ta_der_ctxt ground_gctxt_of_ctxt_apply_gterm) + from gp have mem: "hole_pos C \<in> gposs s \<union> gposs v" + by auto (metis Un_iff ctxt ghole_pos_in_apply gposs_of_gpair ground_hole_pos_to_ghole) + from this have "hole_pos C \<notin> gposs s" using assms(3) + using arg_cong[OF gp, of "\<lambda> t. gfun_at t (hole_pos C)"] + using ground_hole_pos_to_ghole[OF ctxt] + using gfun_at_after_hole_pos[OF position_less_refl, of "gctxt_of_ctxt C"] + by (auto simp: gfun_at_gpair * split: if_splits) + (metis fstI gfun_at_None_ngposs_iff)+ + from subst_at_gpair_nt_poss_None_Some[OF _ this, of v] this + have "t = gterm_to_None_Some (gsubt_at v (hole_pos C)) \<and> funas_gterm (gsubt_at v (hole_pos C)) \<subseteq> \<F>" + using funas mem funas_gterm_gsubt_at_subseteq + by (auto simp: gp intro!: exI[of _ "gsubt_at v (hole_pos C)"]) + (metis ctxt ground_hole_pos_to_ghole gsubt_at_gctxt_apply_ghole) + then show ?thesis by blast +qed + +lemma infinite_set_dec_infinite: + assumes "infinite S" and "\<And> s. s \<in> S \<Longrightarrow> \<exists> t. f t = s \<and> P t" + shows "infinite {t | t s. s \<in> S \<and> f t = s \<and> P t}" (is "infinite ?T") +proof (rule ccontr) + assume ass: "\<not> infinite ?T" + have "S \<subseteq> f ` {x . P x}" using assms(2) by auto + then show False using ass assms(1) + by (auto simp: subset_image_iff) + (smt Ball_Collect finite_imageI image_subset_iff infinite_iff_countable_subset subset_eq) +qed + +lemma Q_inf_exec_impl_Q_inf: + assumes "gta_lang Q \<A> \<subseteq> {gpair s t| s t. funas_gterm s \<subseteq> fset \<F> \<and> funas_gterm t \<subseteq> fset \<F>}" + and "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" and "\<Q> \<A> |\<subseteq>| ta_productive Q \<A>" + and "q \<in> Q_inf_e \<A>" + shows "q |\<in>| Q_infty \<A> \<F>" +proof - + let ?S = "{t. q |\<in>| ta_der \<A> (term_of_gterm t) \<and> fst (groot_sym t) = None}" + let ?P = "\<lambda> t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (term_of_gterm (gterm_to_None_Some t))" + let ?F = "(\<lambda>(f, n). ((None, Some f), n)) |`| \<F>" + from Q_inf_e_infinite_terms_res[OF assms(4, 2)] have inf: "infinite ?S" by auto + {fix t assume "t \<in> ?S" + then have "\<exists> u. t = gterm_to_None_Some u \<and> funas_gterm u \<subseteq> fset \<F>" + using prod_automata_from_none_root_dec[OF assms(1)] assms(2, 3) + using fin_mono by fastforce} + then show ?thesis using infinite_set_dec_infinite[OF inf, of gterm_to_None_Some ?P] + by (auto simp: Q_infty_fmember) blast +qed + + +lemma Q_inf_impl_Q_inf_exec: + assumes "q |\<in>| Q_infty \<A> \<F>" + shows "q \<in> Q_inf_e \<A>" +proof - + let ?t_of_g = "\<lambda> t. term_of_gterm t :: ('b option \<times> 'b option, 'a) term" + let ?t_og_g2 = "\<lambda> t. term_of_gterm t :: ('b, 'a) term" + let ?inf = "(?t_og_g2 :: 'b gterm \<Rightarrow> ('b, 'a) term) ` {t |t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (?t_of_g (gterm_to_None_Some t))}" + obtain n where card_st: "fcard (\<Q> \<A>) < n" by blast + from assms(1) have "infinite {t |t. funas_gterm t \<subseteq> fset \<F> \<and> q |\<in>| ta_der \<A> (?t_of_g (gterm_to_None_Some t))}" + unfolding Q_infty_def by blast + from infinite_inj_image_infinite[OF this, of "?t_og_g2"] have inf: "infinite ?inf" using inj_term_of_gterm by blast + {fix s assume "s \<in> ?inf" then have "ground s" "funas_term s \<subseteq> fset \<F>" by (auto simp: funas_term_of_gterm_conv subsetD)} + from infinte_no_depth_limit[OF inf, of "fset \<F>"] this obtain u where + funas: "funas_gterm u \<subseteq> fset \<F>" and card_d: "n < depth (?t_og_g2 u)" and reach: "q |\<in>| ta_der \<A> (?t_of_g (gterm_to_None_Some u))" + by auto blast + have "depth (?t_og_g2 u) = depth (?t_of_g (gterm_to_None_Some u))" + proof (induct u) + case (GFun f ts) then show ?case + by (auto simp: comp_def intro: nth_args_depth_eqI) + qed + from this pigeonhole_tree_automata[OF _ reach] card_st card_d obtain C2 C s v p where + ctxt: "C2 \<noteq> \<box>" "C\<langle>s\<rangle> = term_of_gterm (gterm_to_None_Some u)" "C2\<langle>v\<rangle> = s" and + loop: "p |\<in>| ta_der \<A> v \<and> p |\<in>| ta_der \<A> C2\<langle>Var p\<rangle> \<and> q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" + by auto + from ctxt have gr: "ground_ctxt C2" "ground_ctxt C" by auto (metis ground_ctxt_apply ground_term_of_gterm)+ + from ta_der_to_ta_strict[OF _ gr(1)] loop obtain q' where + to_strict: "(p = q' \<or> (p, q') |\<in>| (eps \<A>)|\<^sup>+|) \<and> p |\<in>| ta_der_strict \<A> C2\<langle>Var q'\<rangle>" by fastforce + have *: "\<exists> C. C2 = map_funs_ctxt lift_None_Some C \<and> C \<noteq> \<box>" using ctxt(1, 2) + by (auto simp flip: ctxt(3)) (smt ctxt.simps(8) map_funs_term_ctxt_decomp map_term_of_gterm) + then have q_p: "(q', p) \<in> Q_inf \<A>" using to_strict ta_der_Q_inf[of p \<A> _ q'] ctxt + by auto + then have cycle: "(q', q') \<in> Q_inf \<A>" using to_strict by (auto intro: Q_inf_ta_eps_Q_inf) + show ?thesis + proof (cases "C = \<box>") + case True then show ?thesis + using cycle q_p loop by (auto intro: Q_inf_ta_eps_Q_inf) + next + case False + obtain q'' where r: "p = q'' \<or> (p, q'') |\<in>| (eps \<A>)|\<^sup>+|" "q |\<in>| ta_der_strict \<A> C\<langle>Var q''\<rangle>" + using ta_der_to_ta_strict[OF conjunct2[OF conjunct2[OF loop]] gr(2)] by auto + then have "(q'', q) \<in> Q_inf \<A>" using ta_der_Q_inf[of q \<A> _ q''] ctxt False + by auto (smt (z3) ctxt.simps(8) map_funs_term_ctxt_decomp map_term_of_gterm)+ + then show ?thesis using r(1) cycle q_p + by (auto simp: Q_inf_ta_eps_Q_inf intro!: exI[of _ q']) + (meson Q_inf.trans Q_inf_ta_eps_Q_inf)+ + qed +qed + +lemma Q_infty_fQ_inf_e_conv: + assumes "gta_lang Q \<A> \<subseteq> {gpair s t| s t. funas_gterm s \<subseteq> fset \<F> \<and> funas_gterm t \<subseteq> fset \<F>}" + and "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" and "\<Q> \<A> |\<subseteq>| ta_productive Q \<A>" + shows "Q_infty \<A> \<F> = fQ_inf_e \<A>" + using Q_inf_impl_Q_inf_exec Q_inf_exec_impl_Q_inf[OF assms] + by (auto simp: fQ_inf_e.rep_eq fmember.rep_eq) fastforce + +definition Inf_reg_impl where + "Inf_reg_impl R = Inf_reg R (fQ_inf_e (ta R))" + +lemma Inf_reg_impl_sound: + assumes "\<L> \<A> \<subseteq> {gpair s t| s t. funas_gterm s \<subseteq> fset \<F> \<and> funas_gterm t \<subseteq> fset \<F>}" + and "\<Q>\<^sub>r \<A> |\<subseteq>| ta_reachable (ta \<A>)" and "\<Q>\<^sub>r \<A> |\<subseteq>| ta_productive (fin \<A>) (ta \<A>)" + shows "\<L> (Inf_reg_impl \<A>) = \<L> (Inf_reg \<A> (Q_infty (ta \<A>) \<F>))" + using Q_infty_fQ_inf_e_conv[of "fin \<A>" "ta \<A>" \<F>] assms[unfolded \<L>_def] + by (simp add: Inf_reg_impl_def) + +end diff --git a/thys/Regular_Tree_Relations/RRn_Automata.thy b/thys/Regular_Tree_Relations/RRn_Automata.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/RRn_Automata.thy @@ -0,0 +1,1536 @@ +theory RRn_Automata + imports Tree_Automata_Complement Ground_Ctxt +begin +section \<open>Regular relations\<close> + +subsection \<open>Encoding pairs of terms\<close> + +text \<open>The encoding of two terms $s$ and $t$ is given by its tree domain, which is the union of the +domains of $s$ and $t$, and the labels, which arise from looking up each position in $s$ and $t$, +respectively.\<close> + +definition gpair :: "'f gterm \<Rightarrow> 'g gterm \<Rightarrow> ('f option \<times> 'g option) gterm" where + "gpair s t = glabel (\<lambda>p. (gfun_at s p, gfun_at t p)) (gunion (gdomain s) (gdomain t))" + +text \<open>We provide an efficient implementation of gpair.\<close> + +definition zip_fill :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a option \<times> 'b option) list" where + "zip_fill xs ys = zip (map Some xs @ replicate (length ys - length xs) None) + (map Some ys @ replicate (length xs - length ys) None)" + +lemma zip_fill_code [code]: + "zip_fill xs [] = map (\<lambda>x. (Some x, None)) xs" + "zip_fill [] ys = map (\<lambda>y. (None, Some y)) ys" + "zip_fill (x # xs) (y # ys) = (Some x, Some y) # zip_fill xs ys" + subgoal by (induct xs) (auto simp: zip_fill_def) + subgoal by (induct ys) (auto simp: zip_fill_def) + subgoal by (auto simp: zip_fill_def) + done + +lemma length_zip_fill [simp]: + "length (zip_fill xs ys) = max (length xs) (length ys)" + by (auto simp: zip_fill_def) + +lemma nth_zip_fill: + assumes "i < max (length xs) (length ys)" + shows "zip_fill xs ys ! i = (if i < length xs then Some (xs ! i) else None, if i < length ys then Some (ys ! i) else None)" + using assms by (auto simp: zip_fill_def nth_append) + +fun gpair_impl :: "'f gterm option \<Rightarrow> 'g gterm option \<Rightarrow> ('f option \<times> 'g option) gterm" where + "gpair_impl (Some s) (Some t) = gpair s t" +| "gpair_impl (Some s) None = map_gterm (\<lambda>f. (Some f, None)) s" +| "gpair_impl None (Some t) = map_gterm (\<lambda>f. (None, Some f)) t" +| "gpair_impl None None = GFun (None, None) []" + +declare gpair_impl.simps(2-4)[code] + +lemma gpair_impl_code [simp, code]: + "gpair_impl (Some s) (Some t) = + (case s of GFun f ss \<Rightarrow> case t of GFun g ts \<Rightarrow> + GFun (Some f, Some g) (map (\<lambda>(s, t). gpair_impl s t) (zip_fill ss ts)))" +proof (induct "gdomain s" "gdomain t" arbitrary: s t rule: gunion.induct) + case (1 f ss g ts) + obtain f' ss' where [simp]: "s = GFun f' ss'" by (cases s) + obtain g' ts' where [simp]: "t = GFun g' ts'" by (cases t) + show ?case using 1(2,3) 1(1)[of i "ss' ! i" "ts' ! i" for i] + by (auto simp: gpair_def comp_def nth_zip_fill intro: glabel_map_gterm_conv[unfolded comp_def] + intro!: nth_equalityI) +qed + +lemma gpair_code [code]: + "gpair s t = gpair_impl (Some s) (Some t)" + by simp + +(* export_code gpair in Haskell *) + +declare gpair_impl.simps(1)[simp del] + +text \<open>We can easily prove some basic properties. I believe that proving them by induction with a +definition along the lines of @{const gpair_impl} would be very cumbersome.\<close> + +lemma gpair_swap: + "map_gterm prod.swap (gpair s t) = gpair t s" + by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gpair_def) + +lemma gpair_assoc: + defines "f \<equiv> \<lambda>(f, gh). (f, gh \<bind> fst, gh \<bind> snd)" + defines "g \<equiv> \<lambda>(fg, h). (fg \<bind> fst, fg \<bind> snd, h)" + shows "map_gterm f (gpair s (gpair t u)) = map_gterm g (gpair (gpair s t) u)" + by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gpair_def f_def g_def) + + +subsection \<open>Decoding of pairs\<close> + +fun gcollapse :: "'f option gterm \<Rightarrow> 'f gterm option" where + "gcollapse (GFun None _) = None" +| "gcollapse (GFun (Some f) ts) = Some (GFun f (map the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts))))" + +lemma gcollapse_groot_None [simp]: + "groot_sym t = None \<Longrightarrow> gcollapse t = None" + "fst (groot t) = None \<Longrightarrow> gcollapse t = None" + by (cases t, simp)+ + +definition gfst :: "('f option \<times> 'g option) gterm \<Rightarrow> 'f gterm" where + "gfst = the \<circ> gcollapse \<circ> map_gterm fst" + +definition gsnd :: "('f option \<times> 'g option) gterm \<Rightarrow> 'g gterm" where + "gsnd = the \<circ> gcollapse \<circ> map_gterm snd" + +lemma filter_less_upt: + "[i\<leftarrow>[i..<m] . i < n] = [i..<min n m]" +proof (cases "i \<le> m") + case True then show ?thesis + proof (induct rule: inc_induct) + case (step n) then show ?case by (auto simp: upt_rec[of n]) + qed simp +qed simp + +lemma gcollapse_aux: + assumes "gposs s = {p. p \<in> gposs t \<and> gfun_at t p \<noteq> Some None}" + shows "gposs (the (gcollapse t)) = gposs s" + "\<And>p. p \<in> gposs s \<Longrightarrow> gfun_at (the (gcollapse t)) p = (gfun_at t p \<bind> id)" +proof (goal_cases) + define s' t' where "s' \<equiv> gdomain s" and "t' \<equiv> gdomain t" + have *: "gposs (the (gcollapse t)) = gposs s \<and> + (\<forall>p. p \<in> gposs s \<longrightarrow> gfun_at (the (gcollapse t)) p = (gfun_at t p \<bind> id))" + using assms s'_def t'_def + proof (induct s' t' arbitrary: s t rule: gunion.induct) + case (1 f' ss' g' ts') + obtain f ss where s [simp]: "s = GFun f ss" by (cases s) + obtain g ts where t [simp]: "t = GFun (Some g) ts" + using arg_cong[OF 1(2), of "\<lambda>P. [] \<in> P"] by (cases t) auto + have *: "i < length ts \<Longrightarrow> \<not> Option.is_none (gcollapse (ts ! i)) \<longleftrightarrow> i < length ss" for i + using arg_cong[OF 1(2), of "\<lambda>P. [i] \<in> P"] by (cases "ts ! i") auto + have l: "length ss \<le> length ts" + using arg_cong[OF 1(2), of "\<lambda>P. [length ss-1] \<in> P"] by auto + have [simp]: "[t\<leftarrow>map gcollapse ts . \<not> Option.is_none t] = take (length ss) (map gcollapse ts)" + by (subst (2) map_nth[symmetric]) (auto simp add: * filter_map comp_def filter_less_upt + cong: filter_cong[OF refl, of "[0..<length ts]", unfolded set_upt atLeastLessThan_iff] + intro!: nth_equalityI) + have [simp]: "i < length ss \<Longrightarrow> gposs (ss ! i) = gposs (the (gcollapse (ts ! i)))" for i + using conjunct1[OF 1(1), of i "ss ! i" "ts ! i"] l arg_cong[OF 1(2), of "\<lambda>P. {p. i # p \<in> P}"] + 1(3,4) by simp + show ?case + proof (intro conjI allI, goal_cases A B) + case A show ?case using l by (auto simp: comp_def split: if_splits) + next + case (B p) show ?case + proof (cases p) + case (Cons i q) then show ?thesis using arg_cong[OF 1(2), of "\<lambda>P. {p. i # p \<in> P}"] + spec[OF conjunct2[OF 1(1)], of i "ss ! i" "ts ! i" q] 1(3,4) by auto + qed auto + qed + qed + { case 1 then show ?case using * by blast + next + case 2 then show ?case using * by blast } +qed + +lemma gfst_gpair: + "gfst (gpair s t) = s" +proof - + have *: "gposs s = {p \<in> gposs (map_gterm fst (gpair s t)). gfun_at (map_gterm fst (gpair s t)) p \<noteq> Some None}" + using gfun_at_nongposs + by (fastforce simp: gpair_def elim: gfun_at_possE) + show ?thesis unfolding gfst_def comp_def using gcollapse_aux[OF *] + by (auto intro!: eq_gterm_by_gposs_gfun_at simp: gpair_def) +qed + +lemma gsnd_gpair: + "gsnd (gpair s t) = t" + using gfst_gpair[of t s] gpair_swap[of t s, symmetric] + by (simp add: gfst_def gsnd_def gpair_def gterm.map_comp comp_def) + +lemma gpair_impl_None_Inv: + "map_gterm (the \<circ> snd) (gpair_impl None (Some t)) = t" + by (simp add: gterm.map_ident gterm.map_comp comp_def) + +subsection \<open>Contexts to gpair\<close> + +lemma gpair_context1: + assumes "length ts = length us" + shows "gpair (GFun f ts) (GFun f us) = GFun (Some f, Some f) (map (case_prod gpair) (zip ts us))" + using assms unfolding gpair_code by (auto intro!: nth_equalityI simp: zip_fill_def) + +lemma gpair_context2: + assumes "\<And> i. i < length ts \<Longrightarrow> ts ! i = gpair (ss ! i) (us ! i)" + and "length ss = length ts" and "length us = length ts" + shows "GFun (Some f, Some h) ts = gpair (GFun f ss) (GFun h us)" + using assms unfolding gpair_code gpair_impl_code + by (auto simp: zip_fill_def intro!: nth_equalityI) + +lemma map_funs_term_some_gpair: + shows "gpair t t = map_gterm (\<lambda>f. (Some f, Some f)) t" +proof (induct t) + case (GFun f ts) + then show ?case by (auto intro!: gpair_context2[symmetric]) +qed + + +lemma gpair_inject [simp]: + "gpair s t = gpair s' t' \<longleftrightarrow> s = s' \<and> t = t'" + by (metis gfst_gpair gsnd_gpair) + +abbreviation gterm_to_None_Some :: "'f gterm \<Rightarrow> ('f option \<times> 'f option) gterm" where + "gterm_to_None_Some t \<equiv> map_gterm (\<lambda>f. (None, Some f)) t" +abbreviation "gterm_to_Some_None t \<equiv> map_gterm (\<lambda>f. (Some f, None)) t" + +lemma inj_gterm_to_None_Some: "inj gterm_to_None_Some" + by (meson Pair_inject gterm.inj_map inj_onI option.inject) + +lemma zip_fill1: + assumes "length ss < length ts" + shows "zip_fill ss ts = zip (map Some ss) (map Some (take (length ss) ts)) @ + map (\<lambda> x. (None, Some x)) (drop (length ss) ts)" + using assms by (auto simp: zip_fill_def list_eq_iff_nth_eq nth_append simp add: min.absorb2) + +lemma zip_fill2: + assumes "length ts < length ss" + shows "zip_fill ss ts = zip (map Some (take (length ts) ss)) (map Some ts) @ + map (\<lambda> x. (Some x, None)) (drop (length ts) ss)" + using assms by (auto simp: zip_fill_def list_eq_iff_nth_eq nth_append simp add: min.absorb2) + +(* GPair position lemmas *) + +(* MOVE me*) +lemma not_gposs_append [simp]: + assumes "p \<notin> gposs t" + shows "p @ q \<in> gposs t = False" using assms poss_gposs_conv + using poss_append_poss by blast + +(*end Move *) + +lemma gfun_at_gpair: + "gfun_at (gpair s t) p = (if p \<in> gposs s then (if p \<in> gposs t + then Some (gfun_at s p, gfun_at t p) + else Some (gfun_at s p, None)) else + (if p \<in> gposs t then Some (None, gfun_at t p) else None))" + using gfun_at_glabel by (auto simp: gpair_def) + +lemma gposs_of_gpair [simp]: + shows "gposs (gpair s t) = gposs s \<union> gposs t" + by (auto simp: gpair_def) + +lemma poss_to_gpair_poss: + "p \<in> gposs s \<Longrightarrow> p \<in> gposs (gpair s t)" + "p \<in> gposs t \<Longrightarrow> p \<in> gposs (gpair s t)" + by auto + +lemma gsubt_at_gpair_poss: + assumes "p \<in> gposs s" and "p \<in> gposs t" + shows "gsubt_at (gpair s t) p = gpair (gsubt_at s p) (gsubt_at t p)" using assms + by (auto simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at) + +lemma subst_at_gpair_nt_poss_Some_None: + assumes "p \<in> gposs s" and "p \<notin> gposs t" + shows "gsubt_at (gpair s t) p = gterm_to_Some_None (gsubt_at s p)" using assms gfun_at_poss + by (force simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at) + +lemma subst_at_gpair_nt_poss_None_Some: + assumes "p \<in> gposs t" and "p \<notin> gposs s" + shows "gsubt_at (gpair s t) p = gterm_to_None_Some (gsubt_at t p)" using assms gfun_at_poss + by (force simp: gunion_gsubt_at_poss gfun_at_gpair intro!: eq_gterm_by_gposs_gfun_at) + + +lemma gpair_ctxt_decomposition: + fixes C defines "p \<equiv> ghole_pos C" + assumes "p \<notin> gposs s" and "gpair s t = C\<langle>gterm_to_None_Some u\<rangle>\<^sub>G" + shows "gpair s (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G = C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G" + using assms(2-) +proof - + note p[simp] = assms(1) + have pt: "p \<in> gposs t" and pc: "p \<in> gposs C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G" + and pu: "p \<in> gposs C\<langle>gterm_to_None_Some u\<rangle>\<^sub>G" + using arg_cong[OF assms(3), of gposs] assms(2) ghole_pos_in_apply + by auto + have *: "gctxt_at_pos (gpair s (gctxt_at_pos t (ghole_pos C))\<langle>v\<rangle>\<^sub>G) (ghole_pos C) = gctxt_at_pos (gpair s t) (ghole_pos C)" + using assms(2) pt + by (intro eq_gctxt_at_pos) + (auto simp: gposs_gctxt_at_pos gunion_gsubt_at_poss gfun_at_gpair gfun_at_gctxt_at_pos_not_after) + have "gsubt_at (gpair s (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G) p = gsubt_at C\<langle>gterm_to_None_Some v\<rangle>\<^sub>G p" + using pt assms(2) subst_at_gpair_nt_poss_None_Some[OF _ assms(2), of "(gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G"] + using ghole_pos_gctxt_at_pos + by (simp add: ghole_pos_in_apply) + then show ?thesis using assms(2) ghole_pos_gctxt_at_pos + using gsubst_at_gctxt_at_eq_gtermD[OF assms(3) pu] + by (intro gsubst_at_gctxt_at_eq_gtermI[OF _ pc]) + (auto simp: ghole_pos_in_apply * gposs_gctxt_at_pos[OF pt, unfolded p]) +qed + +lemma groot_gpair [simp]: + "fst (groot (gpair s t)) = (Some (fst (groot s)), Some (fst (groot t)))" + by (cases s; cases t) (auto simp add: gpair_code) + +lemma ground_ctxt_adapt_ground [intro]: + assumes "ground_ctxt C" + shows "ground_ctxt (adapt_vars_ctxt C)" + using assms by (induct C) auto + +lemma adapt_vars_ctxt2 : + assumes "ground_ctxt C" + shows "adapt_vars_ctxt (adapt_vars_ctxt C) = adapt_vars_ctxt C" using assms + by (induct C) (auto simp: adapt_vars2) + +subsection \<open>Encoding of lists of terms\<close> + +definition gencode :: "'f gterm list \<Rightarrow> 'f option list gterm" where + "gencode ts = glabel (\<lambda>p. map (\<lambda>t. gfun_at t p) ts) (gunions (map gdomain ts))" + +definition gdecode_nth :: "'f option list gterm \<Rightarrow> nat \<Rightarrow> 'f gterm" where + "gdecode_nth t i = the (gcollapse (map_gterm (\<lambda>f. f ! i) t))" + +lemma gdecode_nth_gencode: + assumes "i < length ts" + shows "gdecode_nth (gencode ts) i = ts ! i" +proof - + have *: "gposs (ts ! i) = {p \<in> gposs (map_gterm (\<lambda>f. f ! i) (gencode ts)). + gfun_at (map_gterm (\<lambda>f. f ! i) (gencode ts)) p \<noteq> Some None}" + using assms + by (auto simp: gencode_def elim: gfun_at_possE dest: gfun_at_poss_gpossD) (force simp: fun_at_def' split: if_splits) + show ?thesis unfolding gdecode_nth_def comp_def using assms gcollapse_aux[OF *] + by (auto intro!: eq_gterm_by_gposs_gfun_at simp: gencode_def) + (metis (no_types) gposs_map_gterm length_map list.set_map map_nth_eq_conv nth_mem) +qed + +definition gdecode :: "'f option list gterm \<Rightarrow> 'f gterm list" where + "gdecode t = (case t of GFun f ts \<Rightarrow> map (\<lambda>i. gdecode_nth t i) [0..<length f])" + +lemma gdecode_gencode: + "gdecode (gencode ts) = ts" +proof (cases "gencode ts") + case (GFun f ts') + have "length f = length ts" using arg_cong[OF GFun, of "\<lambda>t. gfun_at t []"] + by (auto simp: gencode_def) + then show ?thesis using gdecode_nth_gencode[of _ ts] + by (auto intro!: nth_equalityI simp: gdecode_def GFun) +qed + +definition gencode_impl :: "'f gterm option list \<Rightarrow> 'f option list gterm" where + "gencode_impl ts = glabel (\<lambda>p. map (\<lambda>t. t \<bind> (\<lambda>t. gfun_at t p)) ts) (gunions (map (case_option (GFun () []) gdomain) ts))" + +lemma gencode_code [code]: + "gencode ts = gencode_impl (map Some ts)" + by (auto simp: gencode_def gencode_impl_def comp_def) + +lemma gencode_singleton: + "gencode [t] = map_gterm (\<lambda>f. [Some f]) t" + using glabel_map_gterm_conv[unfolded comp_def, of "\<lambda>t. [t]" t] + by (simp add: gunions_def gencode_def) + +lemma gencode_pair: + "gencode [t, u] = map_gterm (\<lambda>(f, g). [f, g]) (gpair t u)" + by (simp add: gunions_def gencode_def gpair_def map_gterm_glabel comp_def) + + +subsection \<open>RRn relations\<close> + +definition RR1_spec where + "RR1_spec A T \<longleftrightarrow> \<L> A = T" + +definition RR2_spec where + "RR2_spec A T \<longleftrightarrow> \<L> A = {gpair t u |t u. (t, u) \<in> T}" + +definition RRn_spec where + "RRn_spec n A R \<longleftrightarrow> \<L> A = gencode ` R \<and> (\<forall>ts \<in> R. length ts = n)" + +lemma RR1_to_RRn_spec: + assumes "RR1_spec A T" + shows "RRn_spec 1 (fmap_funs_reg (\<lambda>f. [Some f]) A) ((\<lambda>t. [t]) ` T)" +proof - + have [simp]: "inj_on (\<lambda>f. [Some f]) X" for X by (auto simp: inj_on_def) + show ?thesis using assms + by (auto simp: RR1_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def gencode_singleton) +qed + +lemma RR2_to_RRn_spec: + assumes "RR2_spec A T" + shows "RRn_spec 2 (fmap_funs_reg (\<lambda>(f, g). [f, g]) A) ((\<lambda>(t, u). [t, u]) ` T)" +proof - + have [simp]: "inj_on (\<lambda>(f, g). [f, g]) X" for X by (auto simp: inj_on_def) + show ?thesis using assms + by (auto simp: RR2_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def prod.case_distrib gencode_pair) +qed + +lemma RRn_to_RR2_spec: + assumes "RRn_spec 2 A T" + shows "RR2_spec (fmap_funs_reg (\<lambda> f. (f ! 0 , f ! 1)) A) ((\<lambda> f. (f ! 0, f ! 1)) ` T)" (is "RR2_spec ?A ?T") +proof - + {fix xs assume "xs \<in> T" then have "length xs = 2" using assms by (auto simp: RRn_spec_def) + then obtain t u where *: "xs = [t, u]" + by (metis (no_types, lifting) One_nat_def Suc_1 length_0_conv length_Suc_conv) + have **: "(\<lambda>f. (f ! 0, f ! Suc 0)) \<circ> (\<lambda>(f, g). [f, g]) = id" by auto + have "map_gterm (\<lambda>f. (f ! 0, f ! Suc 0)) (gencode xs) = gpair t u" + unfolding * gencode_pair gterm.map_comp ** gterm.map_id .. + then have "\<exists> t u. xs = [t, u] \<and> map_gterm (\<lambda>f. (f ! 0, f ! Suc 0)) (gencode xs) = gpair t u" + using * by blast} + then show ?thesis using assms + by (force simp: RR2_spec_def RRn_spec_def fmap_funs_\<L> image_comp comp_def prod.case_distrib gencode_pair image_iff Bex_def) +qed + +lemma relabel_RR1_spec [simp]: + "RR1_spec (relabel_reg A) T \<longleftrightarrow> RR1_spec A T" + by (simp add: RR1_spec_def) + +lemma relabel_RR2_spec [simp]: + "RR2_spec (relabel_reg A) T \<longleftrightarrow> RR2_spec A T" + by (simp add: RR2_spec_def) + +lemma relabel_RRn_spec [simp]: + "RRn_spec n (relabel_reg A) T \<longleftrightarrow> RRn_spec n A T" + by (simp add: RRn_spec_def) + +lemma trim_RR1_spec [simp]: + "RR1_spec (trim_reg A) T \<longleftrightarrow> RR1_spec A T" + by (simp add: RR1_spec_def \<L>_trim) + +lemma trim_RR2_spec [simp]: + "RR2_spec (trim_reg A) T \<longleftrightarrow> RR2_spec A T" + by (simp add: RR2_spec_def \<L>_trim) + +lemma trim_RRn_spec [simp]: + "RRn_spec n (trim_reg A) T \<longleftrightarrow> RRn_spec n A T" + by (simp add: RRn_spec_def \<L>_trim) + +lemma swap_RR2_spec: + assumes "RR2_spec A R" + shows "RR2_spec (fmap_funs_reg prod.swap A) (prod.swap ` R)" using assms + by (force simp add: RR2_spec_def fmap_funs_\<L> gpair_swap image_iff) + +subsection \<open>Nullary automata\<close> + +lemma false_RRn_spec: + "RRn_spec n empty_reg {}" + by (auto simp: RRn_spec_def \<L>_epmty) + +lemma true_RR0_spec: + "RRn_spec 0 (Reg {|q|} (TA {|[] [] \<rightarrow> q|} {||})) {[]}" + by (auto simp: RRn_spec_def \<L>_def const_ta_lang gencode_def gunions_def) + +subsection \<open>Pairing RR1 languages\<close> + +text \<open>cf. @{const "gpair"}.\<close> + +abbreviation "lift_Some_None s \<equiv> (Some s, None)" +abbreviation "lift_None_Some s \<equiv> (None, Some s)" +abbreviation "pair_eps A B \<equiv> (\<lambda> (p, q). ((Some (fst p), q), (Some (snd p), q))) |`| (eps A |\<times>| finsert None (Some |`| \<Q> B))" +abbreviation "pair_rule \<equiv> (\<lambda> (ra, rb). TA_rule (Some (r_root ra), Some (r_root rb)) (zip_fill (r_lhs_states ra) (r_lhs_states rb)) (Some (r_rhs ra), Some (r_rhs rb)))" + +lemma lift_Some_None_pord_swap [simp]: + "prod.swap \<circ> lift_Some_None = lift_None_Some" + "prod.swap \<circ> lift_None_Some = lift_Some_None" + by auto + +lemma eps_to_pair_eps_Some_None: + "(p, q) |\<in>| eps \<A> \<Longrightarrow> (lift_Some_None p, lift_Some_None q) |\<in>| pair_eps \<A> \" + by force + +definition pair_automaton :: "('p, 'f) ta \<Rightarrow> ('q, 'g) ta \<Rightarrow> ('p option \<times> 'q option, 'f option \<times> 'g option) ta" where + "pair_automaton A B = TA + (map_ta_rule lift_Some_None lift_Some_None |`| rules A |\<union>| + map_ta_rule lift_None_Some lift_None_Some |`| rules B |\<union>| + pair_rule |`| (rules A |\<times>| rules B)) + (pair_eps A B |\<union>| map_both prod.swap |`| (pair_eps B A))" + +definition pair_automaton_reg where + "pair_automaton_reg R L = Reg (Some |`| fin R |\<times>| Some |`| fin L) (pair_automaton (ta R) (ta L))" + + +lemma pair_automaton_eps_simps: + "(lift_Some_None p, p') |\<in>| eps (pair_automaton A B) \<longleftrightarrow> (lift_Some_None p, p') |\<in>| pair_eps A B" + "(q , lift_Some_None q') |\<in>| eps (pair_automaton A B) \<longleftrightarrow> (q , lift_Some_None q') |\<in>| pair_eps A B" + by (auto simp: pair_automaton_def eps_to_pair_eps_Some_None) + +lemma pair_automaton_eps_Some_SomeD: + "((Some p, Some p'), r) |\<in>| eps (pair_automaton A B) \<Longrightarrow> fst r \<noteq> None \<and> snd r \<noteq> None \<and> (Some p = fst r \<or> Some p' = snd r) \<and> + (Some p \<noteq> fst r \<longrightarrow> (p, the (fst r)) |\<in>| (eps A)) \<and> (Some p' \<noteq> snd r \<longrightarrow> (p', the (snd r)) |\<in>| (eps B))" + by (auto simp: pair_automaton_def) + +lemma pair_automaton_eps_Some_SomeD2: + "(r, (Some p, Some p')) |\<in>| eps (pair_automaton A B) \<Longrightarrow> fst r \<noteq> None \<and> snd r \<noteq> None \<and> (fst r = Some p \<or> snd r = Some p') \<and> + (fst r \<noteq> Some p \<longrightarrow> (the (fst r), p) |\<in>| (eps A)) \<and> (snd r \<noteq> Some p' \<longrightarrow> (the (snd r), p') |\<in>| (eps B))" + by (auto simp: pair_automaton_def) + +lemma pair_eps_Some_None: + fixes p q q' + defines "l \<equiv> (p, q)" and "r \<equiv> lift_Some_None q'" + assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" + shows "q = None \<and> p \<noteq> None \<and> (the p, q') |\<in>| (eps A)|\<^sup>+|" using assms(3, 1, 2) +proof (induct arbitrary: q' q rule: ftrancl_induct) + case (Step b) + then show ?case unfolding pair_automaton_eps_simps + by (auto simp: pair_automaton_eps_simps) + (meson not_ftrancl_into) +qed (auto simp: pair_automaton_def) + +lemma pair_eps_Some_Some: + fixes p q + defines "l \<equiv> (Some p, Some q)" + assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" + shows "fst r \<noteq> None \<and> snd r \<noteq> None \<and> + (fst l \<noteq> fst r \<longrightarrow> (p, the (fst r)) |\<in>| (eps A)|\<^sup>+|) \<and> + (snd l \<noteq> snd r \<longrightarrow> (q, the (snd r)) |\<in>| (eps B)|\<^sup>+|)" + using assms(2, 1) +proof (induct arbitrary: p q rule: ftrancl_induct) + case (Step b c) + then obtain r r' where *: "b = (Some r, Some r')" by (cases b) auto + show ?case using Step(2) + using pair_automaton_eps_Some_SomeD[OF Step(3)[unfolded *]] + by (auto simp: *) (meson not_ftrancl_into)+ +qed (auto simp: pair_automaton_def) + +lemma pair_eps_Some_Some2: + fixes p q + defines "r \<equiv> (Some p, Some q)" + assumes "(l, r) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" + shows "fst l \<noteq> None \<and> snd l \<noteq> None \<and> + (fst l \<noteq> fst r \<longrightarrow> (the (fst l), p) |\<in>| (eps A)|\<^sup>+|) \<and> + (snd l \<noteq> snd r \<longrightarrow> (the (snd l), q) |\<in>| (eps B)|\<^sup>+|)" + using assms(2, 1) +proof (induct arbitrary: p q rule: ftrancl_induct) + case (Step b c) + from pair_automaton_eps_Some_SomeD2[OF Step(3)] + obtain r r' where *: "c = (Some r, Some r')" by (cases c) auto + from Step(2)[OF this] show ?case + using pair_automaton_eps_Some_SomeD[OF Step(3)[unfolded *]] + by (auto simp: *) (meson not_ftrancl_into)+ +qed (auto simp: pair_automaton_def) + + +lemma map_pair_automaton: + "pair_automaton (fmap_funs_ta f A) (fmap_funs_ta g B) = + fmap_funs_ta (\<lambda>(a, b). (map_option f a, map_option g b)) (pair_automaton A B)" (is "?Ls = ?Rs") +proof - + let ?ls = "pair_rule \<circ> map_prod (map_ta_rule id f) (map_ta_rule id g)" + let ?rs = "map_ta_rule id (\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> pair_rule" + have *: "(\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> lift_Some_None = lift_Some_None \<circ> f" + "(\<lambda>(a, b). (map_option f a, map_option g b)) \<circ> lift_None_Some = lift_None_Some \<circ> g" + by (auto simp: comp_def) + have "?ls x = ?rs x" for x + by (cases x) (auto simp: ta_rule.map_sel) + then have [simp]: "?ls = ?rs" by blast + then have "rules ?Ls = rules ?Rs" + unfolding pair_automaton_def fmap_funs_ta_def + by (simp add: fimage_funion map_ta_rule_comp * map_prod_ftimes) + moreover have "eps ?Ls = eps ?Rs" + unfolding pair_automaton_def fmap_funs_ta_def + by (simp add: fimage_funion \<Q>_def) + ultimately show ?thesis + by (intro TA_equalityI) simp +qed + +lemmas map_pair_automaton_12 = + map_pair_automaton[of _ _ id, unfolded fmap_funs_ta_id option.map_id] + map_pair_automaton[of id _ _, unfolded fmap_funs_ta_id option.map_id] + +lemma fmap_states_funs_ta_commute: + "fmap_states_ta f (fmap_funs_ta g A) = fmap_funs_ta g (fmap_states_ta f A)" +proof - + have [simp]: "map_ta_rule f id (map_ta_rule id g r) = map_ta_rule id g (map_ta_rule f id r)" for r + by (cases r) auto + show ?thesis + by (auto simp: ta_rule.case_distrib fmap_states_ta_def fmap_funs_ta_def fimage_iff fBex_def split: ta_rule.splits) +qed + +lemma states_pair_automaton: + "\<Q> (pair_automaton A B) |\<subseteq>| (finsert None (Some |`| \<Q> A) |\<times>| (finsert None (Some |`| \<Q> B)))" + unfolding pair_automaton_def + apply (intro \<Q>_subseteq_I) + apply (auto simp: ta_rule.map_sel in_fset_conv_nth nth_zip_fill rule_statesD eps_statesD) + apply (simp add: rule_statesD)+ + done + + +lemma swap_pair_automaton: + assumes "(p, q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm t)" + shows "(q, p) |\<in>| ta_der (pair_automaton B A) (term_of_gterm (map_gterm prod.swap t))" +proof - + let ?m = "map_ta_rule prod.swap prod.swap" + have [simp]: "map prod.swap (zip_fill xs ys) = zip_fill ys xs" for xs ys + by (auto simp: zip_fill_def zip_nth_conv comp_def intro!: nth_equalityI) + let ?swp = "\<lambda>X. fmap_states_ta prod.swap (fmap_funs_ta prod.swap X)" + { fix A B + let ?AB = "?swp (pair_automaton A B)" and ?BA = "pair_automaton B A" + have "eps ?AB |\<subseteq>| eps ?BA" "rules ?AB |\<subseteq>| rules ?BA" + by (auto simp: fmap_states_ta_def fmap_funs_ta_def pair_automaton_def fimage_iff ta_rule.map_comp) + force+ + } note * = this + let ?BA = "?swp (?swp (pair_automaton B A))" and ?AB = "?swp (pair_automaton A B)" + have **: "r |\<in>| rules (pair_automaton B A) \<Longrightarrow> ?m r |\<in>| ?m |`| rules (pair_automaton B A)" for r + by blast + have "r |\<in>| rules ?BA \<Longrightarrow> r |\<in>| rules ?AB" "e |\<in>| eps ?BA \<Longrightarrow> e |\<in>| eps ?AB" for r e + using *[of B A] map_ta_rule_prod_swap_id + unfolding fmap_funs_ta_def fmap_states_ta_def + by (auto simp: map_ta_rule_comp fimage_iff fBex_def ta_rule.map_id0 intro!: exI[of _ "?m r"]) + then have "eps ?BA |\<subseteq>| eps ?AB" "rules ?BA |\<subseteq>| rules ?AB" + by blast+ + then have "fmap_states_ta prod.swap (fmap_funs_ta prod.swap (pair_automaton A B)) = pair_automaton B A" + using *[of A B] by (simp add: fmap_states_funs_ta_commute fmap_funs_ta_comp fmap_states_ta_comp TA_equalityI) + then show ?thesis + using ta_der_fmap_states_ta[OF ta_der_fmap_funs_ta[OF assms], of prod.swap prod.swap] + by (simp add: gterm.map_comp comp_def) +qed + +lemma to_ta_der_pair_automaton: + "p |\<in>| ta_der A (term_of_gterm t) \<Longrightarrow> + (Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (Some f, None)) t))" + "q |\<in>| ta_der B (term_of_gterm u) \<Longrightarrow> + (None, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (None, Some f)) u))" + "p |\<in>| ta_der A (term_of_gterm t) \<Longrightarrow> q |\<in>| ta_der B (term_of_gterm u) \<Longrightarrow> + (Some p, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (gpair t u))" +proof (goal_cases sn ns ss) + let ?AB = "pair_automaton A B" + have 1: "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm (map_gterm (\<lambda>f. (Some f, None)) s))" + if "p |\<in>| ta_der A (term_of_gterm s)" for A B p s + by (intro fsubsetD[OF ta_der_mono, OF _ _ ta_der_fmap_states_ta[OF ta_der_fmap_funs_ta[OF that]], + unfolded map_term_of_gterm id_def gterm.map_ident]) + (auto simp add: pair_automaton_def fmap_states_ta_def fmap_funs_ta_def ta_rule.map_comp image_iff eps_to_pair_eps_Some_None) + have 2: "q |\<in>| ta_der B (term_of_gterm t) \<Longrightarrow> + (None, Some q) |\<in>| ta_der ?AB (term_of_gterm (map_gterm (\<lambda>g. (None, Some g)) t))" + for q t using swap_pair_automaton[OF 1[of q B t A]] by (simp add: gterm.map_comp comp_def) + { + case sn then show ?case by (rule 1) + next + case ns then show ?case by (rule 2) + next + case ss then show ?case + proof (induct t arbitrary: p q u) + case (GFun f ts) + obtain g us where u [simp]: "u = GFun g us" by (cases u) + obtain p' ps where p': "f ps \<rightarrow> p' |\<in>| rules A" "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|" "length ps = length ts" + "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts ! i))" using GFun(2) by auto + obtain q' qs where q': "g qs \<rightarrow> q' |\<in>| rules B" "q' = q \<or> (q', q) |\<in>| (eps B)|\<^sup>+|" "length qs = length us" + "\<And>i. i < length us \<Longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us ! i))" using GFun(3) by auto + have *: "Some p |\<in>| Some |`| \<Q> A" "Some q' |\<in>| Some |`| \<Q> B" + using p'(2,1) q'(1) + by (auto simp: rule_statesD eps_trancl_statesD) + have eps: "p' = p \<and> q' = q \<or> ((Some p', Some q'), (Some p, Some q)) |\<in>| (eps ?AB)|\<^sup>+|" + proof (cases "p' = p") + case True note p = this then show ?thesis + proof (cases "q' = q") + case False + then have "(q', q) |\<in>| (eps B)|\<^sup>+|" using q'(2) by auto + then show ?thesis using p'(1) + using ftrancl_map[of "eps B" "\<lambda>q. (Some p', Some q)" "eps ?AB" q' q] + by (auto simp: p pair_automaton_def fimage_iff fBex_def rule_statesD) + qed (simp add: p) + next + case False note p = this + then have *: "(p', p) |\<in>| (eps A)|\<^sup>+|" using p'(2) by auto + then have eps: "((Some p', Some q'), Some p, Some q') |\<in>| (eps (pair_automaton A B))|\<^sup>+|" + using q'(1) ftrancl_map[of "eps A" "\<lambda>p. (Some p, Some q')" "eps ?AB" p' p] + by (auto simp: p pair_automaton_def fimage_iff fBex_def rule_statesD) + show ?thesis + proof (cases "q' = q") + case True then show ?thesis using eps + by simp + next + case False + then have "(q', q) |\<in>| (eps B)|\<^sup>+|" using q'(2) by auto + then have "((Some p, Some q'), Some p, Some q) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" + using * ftrancl_map[of "eps B" "\<lambda>q. (Some p, Some q)" "eps ?AB" q' q] + by (auto simp: p pair_automaton_def fimage_iff fBex_def eps_trancl_statesD) + then show ?thesis using eps + by (meson ftrancl_trans) + qed + qed + have "(Some f, Some g) zip_fill ps qs \<rightarrow> (Some p', Some q') |\<in>| rules ?AB" + using p'(1) q'(1) by (force simp: pair_automaton_def) + then show ?case using GFun(1)[OF nth_mem p'(4) q'(4)] p'(1 - 3) q'(1 - 3) eps + using 1[OF p'(4), of _ B] 2[OF q'(4)] + by (auto simp: gpair_code nth_zip_fill less_max_iff_disj + intro!: exI[of _ "zip_fill ps qs"] exI[of _ "Some p'"] exI[of _ "Some q'"]) + qed + } +qed + +lemma from_ta_der_pair_automaton: + "(None, None) |\<notin>| ta_der (pair_automaton A B) (term_of_gterm s)" + "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow> + \<exists>t. p |\<in>| ta_der A (term_of_gterm t) \<and> s = map_gterm (\<lambda>f. (Some f, None)) t" + "(None, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow> + \<exists>u. q |\<in>| ta_der B (term_of_gterm u) \<and> s = map_gterm (\<lambda>f. (None, Some f)) u" + "(Some p, Some q) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s) \<Longrightarrow> + \<exists>t u. p |\<in>| ta_der A (term_of_gterm t) \<and> q |\<in>| ta_der B (term_of_gterm u) \<and> s = gpair t u" +proof (goal_cases nn sn ns ss) + let ?AB = "pair_automaton A B" + { fix p s A B assume "(Some p, None) |\<in>| ta_der (pair_automaton A B) (term_of_gterm s)" + then have "\<exists>t. p |\<in>| ta_der A (term_of_gterm t) \<and> s = map_gterm (\<lambda>f. (Some f, None)) t" + proof (induct s arbitrary: p) + case (GFun h ss) + obtain rs sp nq where r: "h rs \<rightarrow> (sp, nq) |\<in>| rules (pair_automaton A B)" + "sp = Some p \<and> nq = None \<or> ((sp, nq), (Some p, None)) |\<in>| (eps (pair_automaton A B))|\<^sup>+|" "length rs = length ss" + "\<And>i. i < length ss \<Longrightarrow> rs ! i |\<in>| ta_der (pair_automaton A B) (term_of_gterm (ss ! i))" + using GFun(2) by auto + obtain p' where pq: "sp = Some p'" "nq = None" "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|" + using r(2) pair_eps_Some_None[of sp nq p A B] + by (cases sp) auto + obtain f ps where h: "h = lift_Some_None f" "rs = map lift_Some_None ps" + "f ps \<rightarrow> p' |\<in>| rules A" + using r(1) unfolding pq(1, 2) by (auto simp: pair_automaton_def map_ta_rule_cases) + obtain ts where "\<And>i. i < length ss \<Longrightarrow> + ps ! i |\<in>| ta_der A (term_of_gterm (ts i)) \<and> ss ! i = map_gterm (\<lambda>f. (Some f, None)) (ts i)" + using GFun(1)[OF nth_mem, of i "ps ! i" for i] r(4)[unfolded h(2)] r(3)[unfolded h(2) length_map] + by auto metis + then show ?case using h(3) pq(3) r(3)[unfolded h(2) length_map] + by (intro exI[of _ "GFun f (map ts [0..<length ss])"]) (auto simp: h(1) intro!: nth_equalityI) + qed + } note 1 = this + have 2: "\<exists>u. q |\<in>| ta_der B (term_of_gterm u) \<and> s = map_gterm (\<lambda>g. (None, Some g)) u" + if "(None, Some q) |\<in>| ta_der ?AB (term_of_gterm s)" for q s + using 1[OF swap_pair_automaton, OF that] + by (auto simp: gterm.map_comp comp_def gterm.map_ident + dest!: arg_cong[of "map_gterm prod.swap _" _ "map_gterm prod.swap", unfolded gterm.map_comp]) + { + case nn + then show ?case + by (intro ta_der_not_reach) (auto simp: pair_automaton_def map_ta_rule_cases) + next + case sn then show ?case by (rule 1) + next + case ns then show ?case by (rule 2) + next + case ss then show ?case + proof (induct s arbitrary: p q) + case (GFun h ss) + obtain rs sp sq where r: "h rs \<rightarrow> (sp, sq) |\<in>| rules ?AB" + "sp = Some p \<and> sq = Some q \<or> ((sp, sq), (Some p, Some q)) |\<in>| (eps ?AB)|\<^sup>+|" "length rs = length ss" + "\<And>i. i < length ss \<Longrightarrow> rs ! i |\<in>| ta_der ?AB (term_of_gterm (ss ! i))" + using GFun(2) by auto + from r(2) have "sp \<noteq> None" "sq \<noteq> None" using pair_eps_Some_Some2[of "(sp, sq)" p q] + by auto + then obtain p' q' where pq: "sp = Some p'" "sq = Some q'" + "p' = p \<or> (p', p) |\<in>| (eps A)|\<^sup>+|" "q' = q \<or> (q', q) |\<in>| (eps B)|\<^sup>+|" + using r(2) pair_eps_Some_Some[where ?r = "(Some p, Some q)" and ?A = A and ?B = B] + using pair_eps_Some_Some2[of "(sp, sq)" p q] + by (cases sp; cases sq) auto + obtain f g ps qs where h: "h = (Some f, Some g)" "rs = zip_fill ps qs" + "f ps \<rightarrow> p' |\<in>| rules A" "g qs \<rightarrow> q' |\<in>| rules B" + using r(1) unfolding pq(1,2) by (auto simp: pair_automaton_def map_ta_rule_cases) + have *: "\<exists>t u. ps ! i |\<in>| ta_der A (term_of_gterm t) \<and> qs ! i |\<in>| ta_der B (term_of_gterm u) \<and> ss ! i = gpair t u" + if "i < length ps" "i < length qs" for i + using GFun(1)[OF nth_mem, of i "ps ! i" "qs ! i"] r(4)[unfolded pq(1,2) h(2), of i] that + r(3)[symmetric] by (auto simp: nth_zip_fill h(2)) + { fix i assume "i < length ss" + then have "\<exists>t u. (i < length ps \<longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm t)) \<and> + (i < length qs \<longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm u)) \<and> + ss ! i = gpair_impl (if i < length ps then Some t else None) (if i < length qs then Some u else None)" + using *[of i] 1[of "ps ! i" A B "ss ! i"] 2[of "qs ! i" "ss ! i"] r(4)[of i] r(3)[symmetric] + by (cases "i < length ps"; cases "i < length qs") + (auto simp add: h(2) nth_zip_fill less_max_iff_disj gpair_code split: gterm.splits) } + then obtain ts us where "\<And>i. i < length ss \<Longrightarrow> + (i < length ps \<longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts i))) \<and> + (i < length qs \<longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us i))) \<and> + ss ! i = gpair_impl (if i < length ps then Some (ts i) else None) (if i < length qs then Some (us i) else None)" + by metis + moreover then have "\<And>i. i < length ps \<Longrightarrow> ps ! i |\<in>| ta_der A (term_of_gterm (ts i))" + "\<And>i. i < length qs \<Longrightarrow> qs ! i |\<in>| ta_der B (term_of_gterm (us i))" + using r(3)[unfolded h(2)] by auto + ultimately show ?case using h(3,4) pq(3,4) r(3)[symmetric] + by (intro exI[of _ "GFun f (map ts [0..<length ps])"] exI[of _ "GFun g (map us [0..<length qs])"]) + (auto simp: gpair_code h(1,2) less_max_iff_disj nth_zip_fill intro!: nth_equalityI split: prod.splits gterm.splits) + qed + } +qed + + +lemma diagonal_automaton: + assumes "RR1_spec A R" + shows "RR2_spec (fmap_funs_reg (\<lambda>f. (Some f, Some f)) A) {(s, s) | s. s \<in> R}" using assms + by (auto simp: RR2_spec_def RR1_spec_def fmap_funs_reg_def fmap_funs_gta_lang map_funs_term_some_gpair \<L>_def) + +lemma pair_automaton: + assumes "RR1_spec A T" "RR1_spec B U" + shows "RR2_spec (pair_automaton_reg A B) (T \<times> U)" +proof - + let ?AB = "pair_automaton (ta A) (ta B)" + { fix t u assume t: "t \<in> T" and u: "u \<in> U" + obtain p where p: "p |\<in>| fin A" "p |\<in>| ta_der (ta A) (term_of_gterm t)" using t assms(1) + by (auto simp: RR1_spec_def gta_lang_def \<L>_def gta_der_def) + obtain q where q: "q |\<in>| fin B" "q |\<in>| ta_der (ta B) (term_of_gterm u)" using u assms(2) + by (auto simp: RR1_spec_def gta_lang_def \<L>_def gta_der_def) + have "gpair t u \<in> \<L> (pair_automaton_reg A B)" using p(1) q(1) to_ta_der_pair_automaton(3)[OF p(2) q(2)] + by (auto simp: pair_automaton_reg_def \<L>_def) + } moreover + { fix s assume "s \<in> \<L> (pair_automaton_reg A B)" + from this[unfolded gta_lang_def \<L>_def] + obtain r where r: "r |\<in>| fin (pair_automaton_reg A B)" "r |\<in>| gta_der ?AB s" + by (auto simp: pair_automaton_reg_def) + obtain p q where pq: "r = (Some p, Some q)" "p |\<in>| fin A" "q |\<in>| fin B" + using r(1) by (auto simp: pair_automaton_reg_def) + from from_ta_der_pair_automaton(4)[OF r(2)[unfolded pq(1) gta_der_def]] + obtain t u where "p |\<in>| ta_der (ta A) (term_of_gterm t)" "q |\<in>| ta_der (ta B) (term_of_gterm u)" "s = gpair t u" + by (elim exE conjE) note * = this + then have "t \<in> \<L> A" "u \<in> \<L> B" using pq(2,3) + by (auto simp: \<L>_def) + then have "\<exists>t u. s = gpair t u \<and> t \<in> T \<and> u \<in> U" using assms + by (auto simp: RR1_spec_def *(3) intro!: exI[of _ t, OF exI[of _ u]]) + } ultimately show ?thesis by (auto simp: RR2_spec_def) +qed + +lemma pair_automaton': + shows "\<L> (pair_automaton_reg A B) = case_prod gpair ` (\<L> A \<times> \<L> B)" + using pair_automaton[of A _ B] by (auto simp: RR1_spec_def RR2_spec_def) + + +subsection \<open>Collapsing\<close> + +text \<open>cf. @{const "gcollapse"}.\<close> + +fun collapse_state_list where + "collapse_state_list Qn Qs [] = [[]]" +| "collapse_state_list Qn Qs (q # qs) = (let rec = collapse_state_list Qn Qs qs in + (if q |\<in>| Qn \<and> q |\<in>| Qs then map (Cons None) rec @ map (Cons (Some q)) rec + else if q |\<in>| Qn then map (Cons None) rec + else if q |\<in>| Qs then map (Cons (Some q)) rec + else [[]]))" + +lemma collapse_state_list_inner_length: + assumes "qss = collapse_state_list Qn Qs qs" + and "\<forall> i < length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs" + and "i < length qss" + shows "length (qss ! i) = length qs" using assms +proof (induct qs arbitrary: qss i) + case (Cons q qs) + have "\<forall>i<length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs" using Cons(3) by auto + then show ?case using Cons(1)[of "collapse_state_list Qn Qs qs"] Cons(2-) + by (auto simp: Let_def nth_append) +qed auto + +lemma collapse_fset_inv_constr: + assumes "\<forall> i < length qs'. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> + qs ! i |\<in>| Qs \<and> qs' ! i = Some (qs ! i)" + and "length qs = length qs'" + shows "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" using assms +proof (induct qs arbitrary: qs') + case (Cons q qs) + have "(tl qs') |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" using Cons(2-) + by (intro Cons(1)[of "tl qs'"]) (cases qs', auto) + then show ?case using Cons(2-) + by (cases qs') (auto simp: Let_def image_def) +qed auto + +lemma collapse_fset_inv_constr2: + assumes "\<forall> i < length qs. qs ! i |\<in>| Qn \<or> qs ! i |\<in>| Qs" + and "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs qs)" and "i < length qs'" + shows "qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> qs' ! i = Some (qs ! i)" + using assms +proof (induct qs arbitrary: qs' i) + case (Cons a qs) + have "i \<noteq> 0 \<Longrightarrow> qs ! (i - 1) |\<in>| Qn \<and> tl qs' ! (i - 1) = None \<or> qs ! (i - 1) |\<in>| Qs \<and> tl qs' ! (i - 1) = Some (qs ! (i - 1))" + using Cons(2-) + by (intro Cons(1)[of "tl qs'" "i - 1"]) (auto simp: Let_def split: if_splits) + then show ?case using Cons(2-) + by (cases i) (auto simp: Let_def split: if_splits) +qed auto + +definition collapse_rule where + "collapse_rule A Qn Qs = + |\<Union>| ((\<lambda> r. fset_of_list (map (\<lambda> qs. TA_rule (r_root r) qs (Some (r_rhs r))) (collapse_state_list Qn Qs (r_lhs_states r)))) |`| + ffilter (\<lambda> r. (\<forall> i < length (r_lhs_states r). r_lhs_states r ! i |\<in>| Qn \<or> r_lhs_states r ! i |\<in>| Qs)) + (ffilter (\<lambda> r. r_root r \<noteq> None) (rules A)))" + +definition collapse_rule_fset where + "collapse_rule_fset A Qn Qs = (\<lambda> r. TA_rule (the (r_root r)) (map the (filter (\<lambda>q. \<not> Option.is_none q) (r_lhs_states r))) (the (r_rhs r))) |`| + collapse_rule A Qn Qs" + +lemma collapse_rule_set_conv: + "fset (collapse_rule_fset A Qn Qs) = {TA_rule f (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) q | f qs qs' q. + TA_rule (Some f) qs q |\<in>| rules A \<and> length qs = length qs' \<and> + (\<forall>i < length qs. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> (qs' ! i) = Some (qs ! i))} " (is "?Ls = ?Rs") +proof + {fix f qs' q qs assume ass: "TA_rule (Some f) qs q |\<in>| rules A" + "length qs = length qs'" + "\<forall>i < length qs. qs ! i |\<in>| Qn \<and> qs' ! i = None \<or> qs ! i |\<in>| Qs \<and> (qs' ! i) = Some (qs ! i)" + then have "TA_rule (Some f) qs' (Some q) |\<in>| collapse_rule A Qn Qs" + using collapse_fset_inv_constr[of qs' qs Qn Qs] unfolding collapse_rule_def + by (auto simp: fset_of_list.rep_eq fimage_iff intro!: fBexI[of _ "TA_rule (Some f) qs q"]) + then have "TA_rule f (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) q \<in> ?Ls" + unfolding collapse_rule_fset_def + by (auto simp: image_iff Bex_def fmember.rep_eq intro!: exI[of _"TA_rule (Some f) qs' (Some q)"])} + then show "?Rs \<subseteq> ?Ls" by blast +next + {fix f qs q assume ass: "TA_rule f qs q \<in> ?Ls" + then obtain ps qs' where w: "TA_rule (Some f) ps q |\<in>| rules A" + "\<forall> i < length ps. ps ! i |\<in>| Qn \<or> ps ! i |\<in>| Qs" + "qs' |\<in>| fset_of_list (collapse_state_list Qn Qs ps)" + "qs = map the (filter (\<lambda>q. \<not> Option.is_none q) qs')" + unfolding collapse_rule_fset_def collapse_rule_def + by (auto simp: fmember.rep_eq ffUnion.rep_eq fset_of_list.rep_eq) (metis ta_rule.collapse) + then have "\<forall> i < length qs'. ps ! i |\<in>| Qn \<and> qs' ! i = None \<or> ps ! i |\<in>| Qs \<and> qs' ! i = Some (ps ! i)" + using collapse_fset_inv_constr2 + by metis + moreover have "length ps = length qs'" + using collapse_state_list_inner_length[of _ Qn Qs ps] + using w(2, 3) calculation(1) + by (auto simp: in_fset_conv_nth) + ultimately have "TA_rule f qs q \<in> ?Rs" + using w(1) unfolding w(4) + by auto fastforce} + then show "?Ls \<subseteq> ?Rs" + by (intro subsetI) (metis (no_types, lifting) ta_rule.collapse) +qed + + +lemma collapse_rule_fmember [simp]: + "TA_rule f qs q |\<in>| (collapse_rule_fset A Qn Qs) \<longleftrightarrow> (\<exists> qs' ps. + qs = map the (filter (\<lambda>q. \<not> Option.is_none q) qs') \<and> TA_rule (Some f) ps q |\<in>| rules A \<and> length ps = length qs' \<and> + (\<forall>i < length ps. ps ! i |\<in>| Qn \<and> qs' ! i = None \<or> ps ! i |\<in>| Qs \<and> (qs' ! i) = Some (ps ! i)))" + unfolding fmember.rep_eq collapse_rule_set_conv + by auto + +definition "Qn A \<equiv> (let S = (r_rhs |`| ffilter (\<lambda> r. r_root r = None) (rules A)) in (eps A)|\<^sup>+| |``| S |\<union>| S)" +definition "Qs A \<equiv> (let S = (r_rhs |`| ffilter (\<lambda> r. r_root r \<noteq> None) (rules A)) in (eps A)|\<^sup>+| |``| S |\<union>| S)" + +lemma Qn_member_iff [simp]: + "q |\<in>| Qn A \<longleftrightarrow> (\<exists> ps p. TA_rule None ps p |\<in>| rules A \<and> (p = q \<or> (p, q) |\<in>| (eps A)|\<^sup>+|))" (is "?Ls \<longleftrightarrow> ?Rs") +proof - + {assume ass: "q |\<in>| Qn A" then obtain r where + "r_rhs r = q \<or> (r_rhs r, q) |\<in>| (eps A)|\<^sup>+|" "r |\<in>| rules A" "r_root r = None" + by (force simp: Qn_def Image_def image_def Let_def fImage.rep_eq simp flip: fmember.rep_eq) + then have "?Ls \<Longrightarrow> ?Rs" by (cases r) auto} + moreover have "?Rs \<Longrightarrow> ?Ls" by (force simp: Qn_def Image_def image_def Let_def fImage.rep_eq fmember.rep_eq) + ultimately show ?thesis by blast +qed + +lemma Qs_member_iff [simp]: + "q |\<in>| Qs A \<longleftrightarrow> (\<exists> f ps p. TA_rule (Some f) ps p |\<in>| rules A \<and> (p = q \<or> (p, q) |\<in>| (eps A)|\<^sup>+|))" (is "?Ls \<longleftrightarrow> ?Rs") +proof - + {assume ass: "q |\<in>| Qs A" then obtain f r where + "r_rhs r = q \<or> (r_rhs r, q) |\<in>| (eps A)|\<^sup>+|" "r |\<in>| rules A" "r_root r = Some f" + by (force simp: Qs_def Image_def image_def Let_def fImage.rep_eq simp flip: fmember.rep_eq) + then have "?Ls \<Longrightarrow> ?Rs" by (cases r) auto} + moreover have "?Rs \<Longrightarrow> ?Ls" by (force simp: Qs_def Image_def image_def Let_def fImage.rep_eq fmember.rep_eq) + ultimately show ?thesis by blast +qed + + +lemma collapse_Qn_Qs_set_conv: + "fset (Qn A) = {q' |qs q q'. TA_rule None qs q |\<in>| rules A \<and> (q = q' \<or> (q, q') |\<in>| (eps A)|\<^sup>+|)}" (is "?Ls1 = ?Rs1") + "fset (Qs A) = {q' |f qs q q'. TA_rule (Some f) qs q |\<in>| rules A \<and> (q = q' \<or> (q, q') |\<in>| (eps A)|\<^sup>+|)}" (is "?Ls2 = ?Rs2") + by (auto simp flip: fmember.rep_eq) force+ + +definition collapse_automaton :: "('q, 'f option) ta \<Rightarrow> ('q, 'f) ta" where + "collapse_automaton A = TA (collapse_rule_fset A (Qn A) (Qs A)) (eps A)" + +definition collapse_automaton_reg where + "collapse_automaton_reg R = Reg (fin R) (collapse_automaton (ta R))" + +lemma ta_states_collapse_automaton: + "\<Q> (collapse_automaton A) |\<subseteq>| \<Q> A" + apply (intro \<Q>_subseteq_I) + apply (auto simp: collapse_automaton_def fmember.rep_eq collapse_Qn_Qs_set_conv collapse_rule_set_conv + fset_of_list.rep_eq in_set_conv_nth rule_statesD[unfolded fmember.rep_eq] eps_statesD[unfolded fmember.rep_eq]) + apply (metis Option.is_none_def fnth_mem notin_fset option.sel rule_statesD(3) ta_rule.sel(2)) + done + +lemma last_nthI: + assumes "i < length ts" "\<not> i < length ts - Suc 0" + shows "ts ! i = last ts" using assms + by (induct ts arbitrary: i) + (auto, metis last_conv_nth length_0_conv less_antisym nth_Cons') + +lemma collapse_automaton': + assumes "\<Q> A |\<subseteq>| ta_reachable A" (* cf. ta_trim *) + shows "gta_lang Q (collapse_automaton A) = the ` (gcollapse ` gta_lang Q A - {None})" +proof - + define Qn' where "Qn' = Qn A" + define Qs' where "Qs' = Qs A" + {fix t assume t: "t \<in> gta_lang Q (collapse_automaton A)" + then obtain q where q: "q |\<in>| Q" "q |\<in>| ta_der (collapse_automaton A) (term_of_gterm t)" by auto + have "\<exists> t'. q |\<in>| ta_der A (term_of_gterm t') \<and> gcollapse t' \<noteq> None \<and> t = the (gcollapse t')" using q(2) + proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + from GFun(1 - 3) obtain qs rs where ps: "TA_rule (Some f) qs p |\<in>| rules A" "length qs = length rs" + "\<And>i. i < length qs \<Longrightarrow> qs ! i |\<in>| Qn' \<and> rs ! i = None \<or> qs ! i |\<in>| Qs' \<and> rs ! i = Some (qs ! i)" + "ps = map the (filter (\<lambda>q. \<not> Option.is_none q) rs)" + by (auto simp: collapse_automaton_def Qn'_def Qs'_def) + obtain ts' where ts': + "ps ! i |\<in>| ta_der A (term_of_gterm (ts' i))" "gcollapse (ts' i) \<noteq> None" "ts ! i = the (gcollapse (ts' i))" + if "i < length ts" for i using GFun(5) by metis + from ps(2, 3, 4) have rs: "i < length qs \<Longrightarrow> rs ! i = None \<or> rs ! i = Some (qs ! i)" for i + by auto + {fix i assume "i < length qs" "rs ! i = None" + then have "\<exists> t'. groot_sym t' = None \<and> qs ! i |\<in>| ta_der A (term_of_gterm t')" + using ps(1, 2) ps(3)[of i] + by (auto simp: ta_der_trancl_eps Qn'_def groot_sym_groot_conv elim!: ta_reachable_rule_gtermE[OF assms]) + (force dest: ta_der_trancl_eps)+} + note None = this + {fix i assume i: "i < length qs" "rs ! i = Some (qs ! i)" + have "map Some ps = filter (\<lambda>q. \<not> Option.is_none q) rs" using ps(4) + by (induct rs arbitrary: ps) (auto simp add: Option.is_none_def) + from filter_rev_nth_idx[OF _ _ this, of i] + have *: "rs ! i = map Some ps ! filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i" + "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i < length ps" + using ps(2, 4) i by auto + then have "the (rs ! i) = ps ! filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i" + "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i < length ps" + by auto} note Some = this + let ?P = "\<lambda> t i. qs ! i |\<in>| ta_der A (term_of_gterm t) \<and> + (rs ! i = None \<longrightarrow> groot_sym t = None) \<and> + (rs ! i = Some (qs ! i) \<longrightarrow> t = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i))" + {fix i assume i: "i < length qs" + then have "\<exists> t. ?P t i" using Some[OF i] None[OF i] ts' ps(2, 4) GFun(2) rs[OF i] + by (cases "rs ! i") auto} + then obtain ts'' where ts'': "length ts'' = length qs" + "i < length qs \<Longrightarrow> qs ! i |\<in>| ta_der A (term_of_gterm (ts'' ! i))" + "i < length qs \<Longrightarrow> rs ! i = None \<Longrightarrow> groot_sym (ts'' ! i) = None" + "i < length qs \<Longrightarrow> rs ! i = Some (qs ! i) \<Longrightarrow> ts'' ! i = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs i)" + for i using that Ex_list_of_length_P[of "length qs" ?P] by auto + from ts''(1, 3, 4) Some ps(2, 4) GFun(2) rs ts'(2-) + have "map Some ts = (filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse ts''))" + proof (induct ts'' arbitrary: qs rs ps ts rule: rev_induct) + case (snoc a us) + from snoc(2, 7) obtain r rs' where [simp]: "rs = rs' @ [r]" + by (metis append_butlast_last_id append_is_Nil_conv length_0_conv not_Cons_self2) + have l: "length us = length (butlast qs)" "length (butlast qs) = length (butlast rs)" + using snoc(2, 7) by auto + have *: "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = None \<Longrightarrow> groot_sym (us ! i) = None" for i + using snoc(3)[of i] snoc(2, 7) + by (auto simp:nth_append l(1) nth_butlast split!: if_splits) + have **: "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = None \<or> butlast rs ! i = Some (butlast qs ! i)" for i + using snoc(10)[of i] snoc(2, 7) l by (auto simp: nth_append nth_butlast) + have "i < length (butlast qs) \<Longrightarrow> butlast rs ! i = Some (butlast qs ! i) \<Longrightarrow> + us ! i = ts' (filter_rev_nth (\<lambda>q. \<not> Option.is_none q) (butlast rs) i)" for i + using snoc(4)[of i] snoc(2, 7) l + by (auto simp: nth_append nth_butlast filter_rev_nth_def take_butlast) + note IH = snoc(1)[OF l(1) * this _ _ l(2) _ _ **] + show ?case + proof (cases "r = None") + case True + then have "map Some ts = filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse us)" + using snoc(2, 5-) + by (intro IH[of ps ts]) (auto simp: nth_append nth_butlast filter_rev_nth_butlast) + then show ?thesis using True snoc(2, 7) snoc(3)[of "length (butlast rs)"] + by (auto simp: nth_append l(1) last_nthI split!: if_splits) + next + case False + then obtain t' ss where *: "ts = ss @ [t']" using snoc(2, 7, 8, 9) + by (cases ts) (auto, metis append_butlast_last_id list.distinct(1)) + let ?i = "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) rs (length us)" + have "map Some (butlast ts) = filter (\<lambda>q. \<not> Option.is_none q) (map gcollapse us)" + using False snoc(2, 5-) l filter_rev_nth_idx + by (intro IH[of "butlast ps" "butlast ts"]) + (fastforce simp: nth_butlast filter_rev_nth_butlast)+ + moreover have "a = ts' ?i" "?i < length ps" + using False snoc(2, 9) l snoc(4, 6, 10)[of "length us"] + by (auto simp: nth_append) + moreover have "filter_rev_nth (\<lambda>q. \<not> Option.is_none q) (rs' @ [r]) (length rs') = length ss" + using l snoc(2, 7, 8, 9) False unfolding * + by (auto simp: filter_rev_nth_def) + ultimately show ?thesis using l snoc(2, 7, 9) snoc(11-)[of ?i] + by (auto simp: nth_append *) + qed + qed simp + then have "ts = map the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts''))" + by (metis comp_the_Some list.map_id map_map) + then show ?case using ps(1, 2) ts''(1, 2) GFun(3) + by (auto simp: collapse_automaton_def intro!: exI[of _ "GFun (Some f) ts''"] exI[of _ qs] exI[of _ p]) + qed + then have "t \<in> the ` (gcollapse ` gta_lang Q A - {None})" + by (meson Diff_iff gta_langI imageI q(1) singletonD) + } moreover + { fix t assume t: "t \<in> gta_lang Q A" "gcollapse t \<noteq> None" + obtain q where q: "q |\<in>| Q" "q |\<in>| ta_der A (term_of_gterm t)" using t(1) by auto + have "q |\<in>| ta_der (collapse_automaton A) (term_of_gterm (the (gcollapse t)))" using q(2) t(2) + proof (induct t arbitrary: q) + case (GFun f ts) + obtain qs q' where q: "TA_rule f qs q' |\<in>| rules A" "q' = q \<or> (q', q) |\<in>| (eps (collapse_automaton A))|\<^sup>+|" + "length qs = length ts" "\<And>i. i < length ts \<Longrightarrow> qs ! i |\<in>| ta_der A (term_of_gterm (ts ! i))" + using GFun(2) by (auto simp: collapse_automaton_def) + obtain f' where f [simp]: "f = Some f'" using GFun(3) by (cases f) auto + define qs' where + "qs' = map (\<lambda>i. if Option.is_none (gcollapse (ts ! i)) then None else Some (qs ! i)) [0..<length qs]" + have "Option.is_none (gcollapse (ts ! i)) \<Longrightarrow> qs ! i |\<in>| Qn'" if "i < length qs" for i + using q(4)[of i] that + by (cases "ts ! i" rule: gcollapse.cases) + (auto simp: q(3) Qn'_def fmember.rep_eq collapse_Qn_Qs_set_conv, meson notin_fset ta_der_Fun) + moreover have "\<not> Option.is_none (gcollapse (ts ! i)) \<Longrightarrow> qs ! i |\<in>| Qs'" if "i < length qs" for i + using q(4)[of i] that + by (cases "ts ! i" rule: gcollapse.cases) + (auto simp: q(3) Qs'_def fmember.rep_eq collapse_Qn_Qs_set_conv, meson notin_fset ta_der_Fun) + ultimately have "f' (map the (filter (\<lambda>q. \<not> Option.is_none q) qs')) \<rightarrow> q' |\<in>| rules (collapse_automaton A)" + using q(1, 4) unfolding collapse_automaton_def Qn'_def[symmetric] Qs'_def[symmetric] + by (fastforce simp: qs'_def q(3) intro: exI[of _ qs] exI[of _ qs'] split: if_splits) + moreover have ***: "length (filter (\<lambda>i.\<not> Option.is_none (gcollapse (ts ! i))) [0..<length ts]) = + length (filter (\<lambda>t. \<not> Option.is_none (gcollapse t)) ts)" for ts + by (subst length_map[of "(!) ts", symmetric] filter_map[unfolded comp_def, symmetric] map_nth)+ + (rule refl) + note this[of ts] + moreover have "the (filter (\<lambda>q. \<not> Option.is_none q) qs' ! i) |\<in>| ta_der (collapse_automaton A) + (term_of_gterm (the (filter (\<lambda>t. \<not> Option.is_none t) (map gcollapse ts) ! i)))" + if "i < length [x\<leftarrow>ts . \<not> Option.is_none (gcollapse x)]" for i + unfolding qs'_def using that q(3) GFun(1)[OF nth_mem q(4)] + proof (induct ts arbitrary: qs rule: List.rev_induct) + case (snoc t ts) + have x1 [simp]: "i < length xs \<Longrightarrow> (xs @ ys) ! i = xs ! i" for xs ys i by (auto simp: nth_append) + have x2: "i = length xs \<Longrightarrow> (xs @ ys) ! i = ys ! 0" for xs ys i by (auto simp: nth_append) + obtain q qs' where qs [simp]: "qs = qs' @ [q]" using snoc(3) by (cases "rev qs") auto + have [simp]: + "map (\<lambda>x. if Option.is_none (gcollapse ((ts @ [t]) ! x)) then None else Some ((qs' @ [q]) ! x)) [0..<length ts] = + map (\<lambda>x. if Option.is_none (gcollapse (ts ! x)) then None else Some (qs' ! x)) [0..<length ts]" + using snoc(3) by auto + show ?case + proof (cases "Option.is_none (gcollapse t)") + case True then show ?thesis using snoc(1)[of qs'] snoc(2,3) + snoc(4)[unfolded length_append list.size add_0 add_0_right add_Suc_right, OF less_SucI] + by (auto cong: if_cong) + next + case False note False' = this + show ?thesis + proof (cases "i = length [x\<leftarrow>ts . \<not> Option.is_none (gcollapse x)]") + case True + then show ?thesis using snoc(3) snoc(4)[of "length ts"] + unfolding qs length_append list.size add_0 add_0_right add_Suc_right + upt_Suc_append[OF zero_le] filter_append map_append + by (subst (5 6) x2) (auto simp: comp_def *** False' Option.is_none_def[symmetric]) + next + case False + then show ?thesis using snoc(1)[of qs'] snoc(2,3) + snoc(4)[unfolded length_append list.size add_0 add_0_right add_Suc_right, OF less_SucI] + unfolding qs length_append list.size add_0 add_0_right add_Suc_right + upt_Suc_append[OF zero_le] filter_append map_append + by (subst (5 6) x1) (auto simp: comp_def *** False') + qed + qed + qed auto + ultimately show ?case using q(2) by (auto simp: qs'_def comp_def q(3) + intro!: exI[of _ q'] exI[of _ "map the (filter (\<lambda>q. \<not> Option.is_none q) qs')"]) + qed + then have "the (gcollapse t) \<in> gta_lang Q (collapse_automaton A)" + by (metis q(1) gta_langI) + } ultimately show ?thesis by blast +qed + +lemma \<L>_collapse_automaton': + assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" (* cf. ta_trim *) + shows "\<L> (collapse_automaton_reg A) = the ` (gcollapse ` \<L> A - {None})" + using assms by (auto simp: collapse_automaton_reg_def \<L>_def collapse_automaton') + +lemma collapse_automaton: + assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" "RR1_spec A T" + shows "RR1_spec (collapse_automaton_reg A) (the ` (gcollapse ` \<L> A - {None}))" + using collapse_automaton'[OF assms(1)] assms(2) + by (simp add: collapse_automaton_reg_def \<L>_def RR1_spec_def) + + +subsection \<open>Cylindrification\<close> + +(* cylindrification is a product ("pairing") of a RR1 language accepting all terms, and an RRn language, +modulo some fairly trivial renaming of symbols. *) + +definition pad_with_Nones where + "pad_with_Nones n m = (\<lambda>(f, g). case_option (replicate n None) id f @ case_option (replicate m None) id g)" + +lemma gencode_append: + "gencode (ss @ ts) = map_gterm (pad_with_Nones (length ss) (length ts)) (gpair (gencode ss) (gencode ts))" +proof - + have [simp]: "p \<notin> gposs (gunions (map gdomain ts)) \<Longrightarrow> map (\<lambda>t. gfun_at t p) ts = replicate (length ts) None" + for p ts by (intro nth_equalityI) + (fastforce simp: poss_gposs_mem_conv fun_at_def' image_def all_set_conv_all_nth)+ + note [simp] = glabel_map_gterm_conv[of "\<lambda>(_ :: unit option). ()", unfolded comp_def gdomain_id] + show ?thesis by (auto intro!: arg_cong[of _ _ "\<lambda>x. glabel x _"] simp del: gposs_gunions + simp: pad_with_Nones_def gencode_def gunions_append gpair_def map_gterm_glabel comp_def) +qed + +lemma append_automaton: + assumes "RRn_spec n A T" "RRn_spec m B U" + shows "RRn_spec (n + m) (fmap_funs_reg (pad_with_Nones n m) (pair_automaton_reg A B)) {ts @ us |ts us. ts \<in> T \<and> us \<in> U}" + using assms pair_automaton[of A "gencode ` T" B "gencode ` U"] + unfolding RRn_spec_def +proof (intro conjI set_eqI iffI, goal_cases) + case (1 s) + then obtain ts us where "ts \<in> T" "us \<in> U" "s = gencode (ts @ us)" + by (fastforce simp: \<L>_def fmap_funs_reg_def RR1_spec_def RR2_spec_def gencode_append fmap_funs_gta_lang) + then show ?case by blast +qed (fastforce simp: RR1_spec_def RR2_spec_def fmap_funs_reg_def \<L>_def gencode_append fmap_funs_gta_lang)+ + +lemma cons_automaton: + assumes "RR1_spec A T" "RRn_spec m B U" + shows "RRn_spec (Suc m) (fmap_funs_reg (\<lambda>(f, g). pad_with_Nones 1 m (map_option (\<lambda>f. [Some f]) f, g)) + (pair_automaton_reg A B)) {t # us |t us. t \<in> T \<and> us \<in> U}" +proof - + have [simp]: "{ts @ us |ts us. ts \<in> (\<lambda>t. [t]) ` T \<and> us \<in> U} = {t # us |t us. t \<in> T \<and> us \<in> U}" + by (auto intro: exI[of _ "[_]", OF exI]) + show ?thesis using append_automaton[OF RR1_to_RRn_spec, OF assms] + by (auto simp: \<L>_def fmap_funs_reg_def pair_automaton_reg_def comp_def + fmap_funs_gta_lang map_pair_automaton_12 fmap_funs_ta_comp prod.case_distrib + gencode_append[of "[_]", unfolded gencode_singleton List.append.simps]) +qed + +subsection \<open>Projection\<close> + +(* projection is composed from fmap_funs_ta and collapse_automaton, corresponding to gsnd *) + +abbreviation "drop_none_rule m fs \<equiv> if list_all (Option.is_none) (drop m fs) then None else Some (drop m fs)" + +lemma drop_automaton_reg: + assumes "\<Q>\<^sub>r A |\<subseteq>| ta_reachable (ta A)" "m < n" "RRn_spec n A T" + defines "f \<equiv> \<lambda>fs. drop_none_rule m fs" + shows "RRn_spec (n - m) (collapse_automaton_reg (fmap_funs_reg f A)) (drop m ` T)" +proof - + have [simp]: "length ts = n - m ==> p \<in> gposs (gencode ts) \<Longrightarrow> \<exists>f. \<exists>t\<in>set ts. Some f = gfun_at t p" for p ts + proof (cases p, goal_cases Empty PCons) + case Empty + obtain t where "t \<in> set ts" using assms(2) Empty(1) by (cases ts) auto + moreover then obtain f where "Some f = gfun_at t p" using Empty(3) by (cases t rule: gterm.exhaust) auto + ultimately show ?thesis by auto + next + case (PCons i p') + then have "p \<noteq> []" by auto + then show ?thesis using PCons(2) + by (auto 0 3 simp: gencode_def eq_commute[of "gfun_at _ _" "Some _"] elim!: gfun_at_possE) + qed + { fix p ts y assume that: "gfun_at (gencode ts) p = Some y" + have "p \<in> gposs (gencode ts) \<Longrightarrow> gfun_at (gencode ts) p = Some (map (\<lambda>t. gfun_at t p) ts)" + by (auto simp: gencode_def) + moreover have "gfun_at (gencode ts) p = Some y \<Longrightarrow> p \<in> gposs (gencode ts)" + using gfun_at_nongposs by force + ultimately have "y = map (\<lambda>t. gfun_at t p) ts \<and> p \<in> gposs (gencode ts)" by (simp add: that) + } note [dest!] = this + have [simp]: "list_all f (replicate n x) \<longleftrightarrow> n = 0 \<or> f x" for f n x by (induct n) auto + have [dest]: "x \<in> set xs \<Longrightarrow> list_all f xs \<Longrightarrow> f x" for f x xs by (induct xs) auto + have *: "f (pad_with_Nones m' n' z) = snd z" + if "fst z = None \<or> fst z \<noteq> None \<and> length (the (fst z)) = m" + "snd z = None \<or> snd z \<noteq> None \<and> length (the (snd z)) = n - m \<and> (\<exists>y. Some y \<in> set (the (snd z)))" + "m' = m" "n' = n - m" for z m' n' + using that by (auto simp: f_def pad_with_Nones_def split: option.splits prod.splits) + { fix ts assume ts: "ts \<in> T" "length ts = n" + have "gencode (drop m ts) = the (gcollapse (map_gterm f (gencode ts)))" + "gcollapse (map_gterm f (gencode ts)) \<noteq> None" + proof (goal_cases) + case 1 show ?case + using ts assms(2) + apply (subst gsnd_gpair[of "gencode (take m ts)", symmetric]) + apply (subst gencode_append[of "take m ts" "drop m ts", unfolded append_take_drop_id]) + unfolding gsnd_def comp_def gterm.map_comp + apply (intro arg_cong[where f = "\<lambda>x. the (gcollapse x)"] gterm.map_cong refl) + by (subst *) (auto simp: gpair_def set_gterm_gposs_conv image_def) + next + case 2 + have [simp]: "gcollapse t = None \<longleftrightarrow> gfun_at t [] = Some None" for t + by (cases t rule: gcollapse.cases) auto + obtain t where "t \<in> set (drop m ts)" using ts(2) assms(2) by (cases "drop m ts") auto + moreover then have "\<not> Option.is_none (gfun_at t [])" by (cases t rule: gterm.exhaust) auto + ultimately show ?case + by (auto simp: f_def gencode_def list_all_def drop_map) + qed + } + then show ?thesis using assms(3) + by (fastforce simp: \<L>_def collapse_automaton_reg_def fmap_funs_reg_def + RRn_spec_def fmap_funs_gta_lang gsnd_def gpair_def gterm.map_comp comp_def + glabel_map_gterm_conv[unfolded comp_def] assms(1) collapse_automaton') +qed + +lemma gfst_collapse_simp: + "the (gcollapse (map_gterm fst t)) = gfst t" + by (simp add: gfst_def) + +lemma gsnd_collapse_simp: + "the (gcollapse (map_gterm snd t)) = gsnd t" + by (simp add: gsnd_def) + +definition proj_1_reg where + "proj_1_reg A = collapse_automaton_reg (fmap_funs_reg fst (trim_reg A))" +definition proj_2_reg where + "proj_2_reg A = collapse_automaton_reg (fmap_funs_reg snd (trim_reg A))" + +lemmas proj_1_reg_simp = proj_1_reg_def collapse_automaton_reg_def fmap_funs_reg_def trim_reg_def +lemmas proj_2_reg_simp = proj_2_reg_def collapse_automaton_reg_def fmap_funs_reg_def trim_reg_def + +lemma \<L>_proj_1_reg_collapse: + "\<L> (proj_1_reg \<A>) = the ` (gcollapse ` map_gterm fst ` (\<L> \<A>) - {None})" +proof - + have "\<Q>\<^sub>r (fmap_funs_reg fst (trim_reg \<A>)) |\<subseteq>| ta_reachable (ta (fmap_funs_reg fst (trim_reg \<A>)))" + by (auto simp: fmap_funs_reg_def) + note [simp] = \<L>_collapse_automaton'[OF this] + show ?thesis by (auto simp: proj_1_reg_def fmap_funs_\<L> \<L>_trim) +qed + +lemma \<L>_proj_2_reg_collapse: + "\<L> (proj_2_reg \<A>) = the ` (gcollapse ` map_gterm snd ` (\<L> \<A>) - {None})" +proof - + have "\<Q>\<^sub>r (fmap_funs_reg snd (trim_reg \<A>)) |\<subseteq>| ta_reachable (ta (fmap_funs_reg snd (trim_reg \<A>)))" + by (auto simp: fmap_funs_reg_def) + note [simp] = \<L>_collapse_automaton'[OF this] + show ?thesis by (auto simp: proj_2_reg_def fmap_funs_\<L> \<L>_trim) +qed + +lemma proj_1: + assumes "RR2_spec A R" + shows "RR1_spec (proj_1_reg A) (fst ` R)" +proof - + {fix s t assume ass: "(s, t) \<in> R" + from ass have s: "s = the (gcollapse (map_gterm fst (gpair s t)))" + by (auto simp: gfst_gpair gfst_collapse_simp) + then have "Some s = gcollapse (map_gterm fst (gpair s t))" + by (cases s; cases t) (auto simp: gpair_def) + then have "s \<in> \<L> (proj_1_reg A)" using assms ass s + by (auto simp: proj_1_reg_simp \<L>_def trim_ta_reach trim_gta_lang + image_def image_Collect RR2_spec_def fmap_funs_gta_lang + collapse_automaton'[of "fmap_funs_ta fst (trim_ta (fin A) (ta A))"]) + force} + moreover + {fix s assume "s \<in> \<L> (proj_1_reg A)" then have "s \<in> fst ` R" using assms + by (auto simp: gfst_collapse_simp gfst_gpair rev_image_eqI RR2_spec_def trim_ta_reach trim_gta_lang + \<L>_def proj_1_reg_simp fmap_funs_gta_lang collapse_automaton'[of "fmap_funs_ta fst (trim_ta (fin A) (ta A))"])} + ultimately show ?thesis using assms unfolding RR2_spec_def RR1_spec_def \<L>_def proj_1_reg_simp + by auto +qed + +lemma proj_2: + assumes "RR2_spec A R" + shows "RR1_spec (proj_2_reg A) (snd ` R)" +proof - + {fix s t assume ass: "(s, t) \<in> R" + then have s: "t = the (gcollapse (map_gterm snd (gpair s t)))" + by (auto simp: gsnd_gpair gsnd_collapse_simp) + then have "Some t = gcollapse (map_gterm snd (gpair s t))" + by (cases s; cases t) (auto simp: gpair_def) + then have "t \<in> \<L> (proj_2_reg A)" using assms ass s + by (auto simp: \<L>_def trim_ta_reach trim_gta_lang proj_2_reg_simp + image_def image_Collect RR2_spec_def fmap_funs_gta_lang + collapse_automaton'[of "fmap_funs_ta snd (trim_ta (fin A) (ta A))"]) + fastforce} + moreover + {fix s assume "s \<in> \<L> (proj_2_reg A)" then have "s \<in> snd ` R" using assms + by (auto simp: \<L>_def gsnd_collapse_simp gsnd_gpair rev_image_eqI RR2_spec_def + trim_ta_reach trim_gta_lang proj_2_reg_simp + fmap_funs_gta_lang collapse_automaton'[of "fmap_funs_ta snd (trim_ta (fin A) (ta A))"])} + ultimately show ?thesis using assms unfolding RR2_spec_def RR1_spec_def + by auto +qed + +lemma \<L>_proj: + assumes "RR2_spec A R" + shows "\<L> (proj_1_reg A) = gfst ` \<L> A" "\<L> (proj_2_reg A) = gsnd ` \<L> A" +proof - + have [simp]: "gfst ` {gpair t u |t u. (t, u) \<in> R} = fst ` R" + by (force simp: gfst_gpair image_def) + have [simp]: "gsnd ` {gpair t u |t u. (t, u) \<in> R} = snd ` R" + by (force simp: gsnd_gpair image_def) + show "\<L> (proj_1_reg A) = gfst ` \<L> A" "\<L> (proj_2_reg A) = gsnd ` \<L> A" + using proj_1[OF assms] proj_2[OF assms] assms gfst_gpair gsnd_gpair + by (auto simp: RR1_spec_def RR2_spec_def) +qed + +lemmas proj_automaton_gta_lang = proj_1 proj_2 + +subsection \<open>Permutation\<close> + +(* permutations are a direct application of fmap_funs_ta *) + +lemma gencode_permute: + assumes "set ps = {0..<length ts}" + shows "gencode (map ((!) ts) ps) = map_gterm (\<lambda>xs. map ((!) xs) ps) (gencode ts)" +proof - + have *: "(!) ts ` set ps = set ts" using assms by (auto simp: image_def set_conv_nth) + show ?thesis using subsetD[OF equalityD1[OF assms]] + apply (intro eq_gterm_by_gposs_gfun_at) + unfolding gencode_def gposs_glabel gposs_map_gterm gposs_gunions gfun_at_map_gterm gfun_at_glabel + set_map * by auto +qed + +lemma permute_automaton: + assumes "RRn_spec n A T" "set ps = {0..<n}" + shows "RRn_spec (length ps) (fmap_funs_reg (\<lambda>xs. map ((!) xs) ps) A) ((\<lambda>xs. map ((!) xs) ps) ` T)" + using assms by (auto simp: RRn_spec_def gencode_permute fmap_funs_reg_def \<L>_def fmap_funs_gta_lang image_def) + + +subsection \<open>Intersection\<close> + +(* intersection is already defined in IsaFoR *) + +lemma intersect_automaton: + assumes "RRn_spec n A T" "RRn_spec n B U" + shows "RRn_spec n (reg_intersect A B) (T \<inter> U)" using assms + by (simp add: RRn_spec_def \<L>_intersect) + (metis gdecode_gencode image_Int inj_on_def) + +(* +lemma swap_union_automaton: + "fmap_states_ta (case_sum Inr Inl) (union_automaton B A) = union_automaton A B" + by (simp add: fmap_states_ta_def' union_automaton_def image_Un image_comp case_sum_o_inj + ta_rule.map_comp prod.map_comp comp_def id_def ac_simps) +*) + +lemma union_automaton: + assumes "RRn_spec n A T" "RRn_spec n B U" + shows "RRn_spec n (reg_union A B) (T \<union> U)" + using assms by (auto simp: RRn_spec_def \<L>_union) + +subsection \<open>Difference\<close> + +lemma RR1_difference: + assumes "RR1_spec A T" "RR1_spec B U" + shows "RR1_spec (difference_reg A B) (T - U)" + using assms by (auto simp: RR1_spec_def \<L>_difference_reg) + +lemma RR2_difference: + assumes "RR2_spec A T" "RR2_spec B U" + shows "RR2_spec (difference_reg A B) (T - U)" + using assms by (auto simp: RR2_spec_def \<L>_difference_reg) + +lemma RRn_difference: + assumes "RRn_spec n A T" "RRn_spec n B U" + shows "RRn_spec n (difference_reg A B) (T - U)" + using assms by (auto simp: RRn_spec_def \<L>_difference_reg) (metis gdecode_gencode)+ + +subsection \<open>All terms over a signature\<close> + +definition term_automaton :: "('f \<times> nat) fset \<Rightarrow> (unit, 'f) ta" where + "term_automaton \<F> = TA ((\<lambda> (f, n). TA_rule f (replicate n ()) ()) |`| \<F>) {||}" +definition term_reg where + "term_reg \<F> = Reg {|()|} (term_automaton \<F>)" + +lemma term_automaton: + "RR1_spec (term_reg \<F>) (\<T>\<^sub>G (fset \<F>))" + unfolding RR1_spec_def gta_lang_def term_reg_def \<L>_def +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr t) + then have "() |\<in>| ta_der (term_automaton \<F>) (term_of_gterm t)" + by (auto simp: gta_der_def) + then show ?case + by (induct t) (auto simp: term_automaton_def split: if_splits simp flip: fmember.rep_eq) +next + case (rl t) + then have "() |\<in>| ta_der (term_automaton \<F>) (term_of_gterm t)" + proof (induct t rule: \<T>\<^sub>G.induct) + case (const a) then show ?case + by (auto simp: term_automaton_def fimage_iff simp flip: fmember.rep_eq intro: fBexI[of _ "(a, 0)"]) + next + case (ind f n ss) then show ?case + by (auto simp: term_automaton_def fimage_iff simp flip: fmember.rep_eq intro: fBexI[of _ "(f, n)"]) + qed + then show ?case + by (auto simp: gta_der_def) +qed + +fun true_RRn :: "('f \<times> nat) fset \<Rightarrow> nat \<Rightarrow> (nat, 'f option list) reg" where + "true_RRn \<F> 0 = Reg {|0|} (TA {|TA_rule [] [] 0|} {||})" +| "true_RRn \<F> (Suc 0) = relabel_reg (fmap_funs_reg (\<lambda>f. [Some f]) (term_reg \<F>))" +| "true_RRn \<F> (Suc n) = relabel_reg + (trim_reg (fmap_funs_reg (pad_with_Nones 1 n) (pair_automaton_reg (true_RRn \<F> 1) (true_RRn \<F> n))))" + +lemma true_RRn_spec: + "RRn_spec n (true_RRn \<F> n) {ts. length ts = n \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)}" +proof (induct \<F> n rule: true_RRn.induct) + case (1 \<F>) show ?case + by (simp cong: conj_cong add: true_RR0_spec) +next + case (2 \<F>) + moreover have "{ts. length ts = 1 \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)} = (\<lambda>t. [t]) ` \<T>\<^sub>G (fset \<F>)" + apply (intro equalityI subsetI) + subgoal for ts by (cases ts) auto + by auto + ultimately show ?case + using RR1_to_RRn_spec[OF term_automaton, of \<F>] by auto +next + case (3 \<F> n) + have [simp]: "{ts @ us |ts us. length ts = n \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>) \<and> length us = m \<and> + set us \<subseteq> \<T>\<^sub>G (fset \<F>)} = {ss. length ss = n + m \<and> set ss \<subseteq> \<T>\<^sub>G (fset \<F>)}" for n m + by (auto 0 4 intro!: exI[of _ "take n _", OF exI[of _ "drop n _"], of _ xs xs for xs] + dest!: subsetD[OF set_take_subset] subsetD[OF set_drop_subset]) + show ?case using append_automaton[OF 3] + by simp +qed + + +subsection \<open>RR2 composition\<close> + +abbreviation "RR2_to_RRn A \<equiv> fmap_funs_reg (\<lambda>(f, g). [f, g]) A" +abbreviation "RRn_to_RR2 A \<equiv> fmap_funs_reg (\<lambda>f. (f ! 0, f ! 1)) A" +definition rr2_compositon where + "rr2_compositon \<F> A B = + (let A' = RR2_to_RRn A in + let B' = RR2_to_RRn B in + let F = true_RRn \<F> 1 in + let CA = trim_reg (fmap_funs_reg (pad_with_Nones 2 1) (pair_automaton_reg A' F)) in + let CB = trim_reg (fmap_funs_reg (pad_with_Nones 1 2) (pair_automaton_reg F B')) in + let PI = trim_reg (fmap_funs_reg (\<lambda>xs. map ((!) xs) [1, 0, 2]) (reg_intersect CA CB)) in + RRn_to_RR2 (collapse_automaton_reg (fmap_funs_reg (drop_none_rule 1) PI)) + )" + +lemma list_length1E: + assumes "length xs = Suc 0" obtains x where "xs = [x]" using assms + by (cases xs) auto + +lemma rr2_compositon: + assumes "\<R> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" "\<LL> \<subseteq> \<T>\<^sub>G (fset \<F>) \<times> \<T>\<^sub>G (fset \<F>)" + and "RR2_spec A \<R>" and "RR2_spec B \<LL>" + shows "RR2_spec (rr2_compositon \<F> A B) (\<R> O \<LL>)" +proof - + let ?R = "(\<lambda>(t, u). [t, u]) ` \<R>" let ?L = "(\<lambda>(t, u). [t, u]) ` \<LL>" + let ?A = "RR2_to_RRn A" let ?B = "RR2_to_RRn B" let ?F = "true_RRn \<F> 1" + let ?CA = "trim_reg (fmap_funs_reg (pad_with_Nones 2 1) (pair_automaton_reg ?A ?F))" + let ?CB = "trim_reg (fmap_funs_reg (pad_with_Nones 1 2) (pair_automaton_reg ?F ?B))" + let ?PI = "trim_reg (fmap_funs_reg (\<lambda>xs. map ((!) xs) [1, 0, 2]) (reg_intersect ?CA ?CB))" + let ?DR = "collapse_automaton_reg (fmap_funs_reg (drop_none_rule 1) ?PI)" + let ?Rs = "{ts @ us | ts us. ts \<in> ?R \<and> (\<exists>t. us = [t] \<and> t \<in> \<T>\<^sub>G (fset \<F>))}" + let ?Ls = "{us @ ts | ts us. ts \<in> ?L \<and> (\<exists>t. us = [t] \<and> t \<in> \<T>\<^sub>G (fset \<F>))}" + from RR2_to_RRn_spec assms(3, 4) + have rr2: "RRn_spec 2 ?A ?R" "RRn_spec 2 ?B ?L" by auto + have *: "{ts. length ts = 1 \<and> set ts \<subseteq> \<T>\<^sub>G (fset \<F>)} = {[t] | t. t \<in> \<T>\<^sub>G (fset \<F>)}" + by (auto elim!: list_length1E) + have F: "RRn_spec 1 ?F {[t] | t. t \<in> \<T>\<^sub>G (fset \<F>)}" using true_RRn_spec[of 1 \<F>] unfolding * . + have "RRn_spec 3 ?CA ?Rs" "RRn_spec 3 ?CB ?Ls" + using append_automaton[OF rr2(1) F] append_automaton[OF F rr2(2)] + by (auto simp: numeral_3_eq_3) (smt Collect_cong) + from permute_automaton[OF intersect_automaton[OF this], of "[1, 0, 2]"] + have "RRn_spec 3 ?PI ((\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls))" + by (auto simp: atLeast0_lessThan_Suc insert_commute numeral_2_eq_2 numeral_3_eq_3) + from drop_automaton_reg[OF _ _ this, of 1] + have sp: "RRn_spec 2 ?DR (drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls))" + by auto + {fix s assume "s \<in> (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)" + then obtain t u v where comp: "s = [t, u]" "(t, v) \<in> \<R>" "(v, u) \<in> \<LL>" + by (auto simp: image_iff relcomp_unfold split!: prod.split) + then have "[t, v] \<in> ?R" "[v , u] \<in> ?L" "u \<in> \<T>\<^sub>G (fset \<F>)" "v \<in> \<T>\<^sub>G (fset \<F>)" "t \<in> \<T>\<^sub>G (fset \<F>)" using assms(1, 2) + by (auto simp: image_iff relcomp_unfold split!: prod.splits) + then have "[t, v, u] \<in> ?Rs" "[t, v, u] \<in> ?Ls" + apply (simp_all) + subgoal + apply (rule exI[of _ "[t, v]"], rule exI[of _ "[u]"]) + apply simp + done + subgoal + apply (rule exI[of _ "[v, u]"], rule exI[of _ "[t]"]) + apply simp + done + done + then have "s \<in> drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls)" unfolding comp(1) + apply (simp add: image_def Bex_def) + apply (rule exI[of _ "[v, t, u]"]) apply simp + apply (rule exI[of _ "[t, v, u]"]) apply simp + done} + moreover have "drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls) \<subseteq> (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)" + by (auto simp: image_iff relcomp_unfold Bex_def split!: prod.splits) + ultimately have *: "drop 1 ` (\<lambda>xs. map ((!) xs) [1, 0, 2]) ` (?Rs \<inter> ?Ls) = (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)" + by (simp add: subsetI subset_antisym) + have **: "(\<lambda>f. (f ! 0, f ! 1)) ` (\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>) = \<R> O \<LL>" + by (force simp: image_def relcomp_unfold split!: prod.splits) + show ?thesis using sp unfolding * + using RRn_to_RR2_spec[where ?T = "(\<lambda>(t, u). [t, u]) ` (\<R> O \<LL>)" and ?A = ?DR] + unfolding ** by (auto simp: rr2_compositon_def Let_def image_iff) +qed + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Regular_Relation_Abstract_Impl.thy b/thys/Regular_Tree_Relations/Regular_Relation_Abstract_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Regular_Relation_Abstract_Impl.thy @@ -0,0 +1,240 @@ +theory Regular_Relation_Abstract_Impl + imports Pair_Automaton + GTT_Transitive_Closure + RR2_Infinite_Q_infinity + Horn_Fset +begin + +abbreviation TA_of_lists where + "TA_of_lists \<Delta> \<Delta>\<^sub>E \<equiv> TA (fset_of_list \<Delta>) (fset_of_list \<Delta>\<^sub>E)" + +section \<open>Computing the epsilon transitions for the composition of GTT's\<close> + +definition \<Delta>\<^sub>\<epsilon>_rules :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) horn set" where + "\<Delta>\<^sub>\<epsilon>_rules A B = + {zip ps qs \<rightarrow>\<^sub>h (p, q) |f ps p qs q. f ps \<rightarrow> p |\<in>| rules A \<and> f qs \<rightarrow> q |\<in>| rules B \<and> length ps = length qs} \<union> + {[(p, q)] \<rightarrow>\<^sub>h (p', q) |p p' q. (p, p') |\<in>| eps A} \<union> + {[(p, q)] \<rightarrow>\<^sub>h (p, q') |p q q'. (q, q') |\<in>| eps B}" + +locale \<Delta>\<^sub>\<epsilon>_horn = + fixes A :: "('q, 'f) ta" and B :: "('q, 'f) ta" +begin + +sublocale horn "\<Delta>\<^sub>\<epsilon>_rules A B" . + +lemma \<Delta>\<^sub>\<epsilon>_infer0: + "infer0 = {(p, q) |f p q. f [] \<rightarrow> p |\<in>| rules A \<and> f [] \<rightarrow> q |\<in>| rules B}" + unfolding horn.infer0_def \<Delta>\<^sub>\<epsilon>_rules_def + using zip_Nil[of "[]"] + by auto (metis length_greater_0_conv zip_eq_Nil_iff)+ + +lemma \<Delta>\<^sub>\<epsilon>_infer1: + "infer1 pq X = {(p, q) |f ps p qs q. f ps \<rightarrow> p |\<in>| rules A \<and> f qs \<rightarrow> q |\<in>| rules B \<and> length ps = length qs \<and> + (fst pq, snd pq) \<in> set (zip ps qs) \<and> set (zip ps qs) \<subseteq> insert pq X} \<union> + {(p', snd pq) |p p'. (p, p') |\<in>| eps A \<and> p = fst pq} \<union> + {(fst pq, q') |q q'. (q, q') |\<in>| eps B \<and> q = snd pq}" + unfolding \<Delta>\<^sub>\<epsilon>_rules_def horn_infer1_union + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"]) + by (auto simp: horn.infer1_def simp flip: ex_simps(1)) force+ + +lemma \<Delta>\<^sub>\<epsilon>_sound: + "\<Delta>\<^sub>\<epsilon>_set A B = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using lr unfolding x + proof (induct) + case (\<Delta>\<^sub>\<epsilon>_set_cong f ps p qs q) show ?case + apply (intro infer[of "zip ps qs" "(p, q)"]) + subgoal using \<Delta>\<^sub>\<epsilon>_set_cong(1-3) by (auto simp: \<Delta>\<^sub>\<epsilon>_rules_def) + subgoal using \<Delta>\<^sub>\<epsilon>_set_cong(3,5) by (auto simp: zip_nth_conv) + done + next + case (\<Delta>\<^sub>\<epsilon>_set_eps1 p p' q) then show ?case + by (intro infer[of "[(p, q)]" "(p', q)"]) (auto simp: \<Delta>\<^sub>\<epsilon>_rules_def) + next + case (\<Delta>\<^sub>\<epsilon>_set_eps2 q q' p) then show ?case + by (intro infer[of "[(p, q)]" "(p, q')"]) (auto simp: \<Delta>\<^sub>\<epsilon>_rules_def) + qed +next + case (rl x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using rl unfolding x + proof (induct) + case (infer as a) then show ?case + using \<Delta>\<^sub>\<epsilon>_set_cong[of _ "map fst as" "fst a" A "map snd as" "snd a" B] + \<Delta>\<^sub>\<epsilon>_set_eps1[of _ "fst a" A "snd a" B] \<Delta>\<^sub>\<epsilon>_set_eps2[of _ "snd a" B "fst a" A] + by (auto simp: \<Delta>\<^sub>\<epsilon>_rules_def) + qed +qed + +end + +section \<open>Computing the epsilon transitions for the transitive closure of GTT's\<close> + +definition \<Delta>_trancl_rules :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) horn set" where + "\<Delta>_trancl_rules A B = + \<Delta>\<^sub>\<epsilon>_rules A B \<union> {[(p, q), (q, r)] \<rightarrow>\<^sub>h (p, r) |p q r. True}" + +locale \<Delta>_trancl_horn = + fixes A :: "('q, 'f) ta" and B :: "('q, 'f) ta" +begin + +sublocale horn "\<Delta>_trancl_rules A B" . + +lemma \<Delta>_trancl_infer0: + "infer0 = horn.infer0 (\<Delta>\<^sub>\<epsilon>_rules A B)" + by (auto simp: \<Delta>\<^sub>\<epsilon>_rules_def \<Delta>_trancl_rules_def horn.infer0_def) + +lemma \<Delta>_trancl_infer1: + "infer1 pq X = horn.infer1 (\<Delta>\<^sub>\<epsilon>_rules A B) pq X \<union> + {(r, snd pq) |r p'. (r, p') \<in> X \<and> p' = fst pq} \<union> + {(fst pq, r) |q' r. (q', r) \<in> (insert pq X) \<and> q' = snd pq}" + unfolding \<Delta>_trancl_rules_def horn_infer1_union Un_assoc + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"] HOL.refl) + by (auto simp: horn.infer1_def simp flip: ex_simps(1)) force+ + +lemma \<Delta>_trancl_sound: + "\<Delta>_trancl_set A B = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using lr unfolding x + proof (induct) + case (\<Delta>_set_cong f ps p qs q) show ?case + apply (intro infer[of "zip ps qs" "(p, q)"]) + subgoal using \<Delta>_set_cong(1-3) by (auto simp: \<Delta>_trancl_rules_def \<Delta>\<^sub>\<epsilon>_rules_def) + subgoal using \<Delta>_set_cong(3,5) by (auto simp: zip_nth_conv) + done + next + case (\<Delta>_set_eps1 p p' q) then show ?case + by (intro infer[of "[(p, q)]" "(p', q)"]) (auto simp: \<Delta>_trancl_rules_def \<Delta>\<^sub>\<epsilon>_rules_def) + next + case (\<Delta>_set_eps2 q q' p) then show ?case + by (intro infer[of "[(p, q)]" "(p, q')"]) (auto simp: \<Delta>_trancl_rules_def \<Delta>\<^sub>\<epsilon>_rules_def) + next + case (\<Delta>_set_trans p q r) then show ?case + by (intro infer[of "[(p,q), (q,r)]" "(p, r)"]) (auto simp: \<Delta>_trancl_rules_def \<Delta>\<^sub>\<epsilon>_rules_def) + qed +next + case (rl x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using rl unfolding x + proof (induct) + case (infer as a) then show ?case + using \<Delta>_set_cong[of _ "map fst as" "fst a" A "map snd as" "snd a" B] + \<Delta>_set_eps1[of _ "fst a" A "snd a" B] \<Delta>_set_eps2[of _ "snd a" B "fst a" A] + \<Delta>_set_trans[of "fst a" "snd (hd as)" A B "snd a"] + by (auto simp: \<Delta>_trancl_rules_def \<Delta>\<^sub>\<epsilon>_rules_def) + qed +qed + +end + +section \<open>Computing the epsilon transitions for the transitive closure of pair automata\<close> + +definition \<Delta>_Atr_rules :: "('q \<times> 'q) fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q \<times> 'q) horn set" where + "\<Delta>_Atr_rules Q A B = + {[] \<rightarrow>\<^sub>h (p, q) | p q. (p , q) |\<in>| Q} \<union> + {[(p, q),(r, v)] \<rightarrow>\<^sub>h (p, v) |p q r v. (q, r) |\<in>| \<Delta>\<^sub>\<epsilon> B A}" + +locale \<Delta>_Atr_horn = + fixes Q :: "('q \<times> 'q) fset" and A :: "('q, 'f) ta" and B :: "('q, 'f) ta" +begin + +sublocale horn "\<Delta>_Atr_rules Q A B" . + +lemma \<Delta>_Atr_infer0: "infer0 = fset Q" + by (auto simp: horn.infer0_def \<Delta>_Atr_rules_def fmember.rep_eq) + +lemma \<Delta>_Atr_infer1: + "infer1 pq X = {(p, snd pq) | p q. (p, q) \<in> X \<and> (q, fst pq) |\<in>| \<Delta>\<^sub>\<epsilon> B A} \<union> + {(fst pq, v) | q r v. (snd pq, r) |\<in>| \<Delta>\<^sub>\<epsilon> B A \<and> (r, v) \<in> X} \<union> + {(fst pq, snd pq) | q . (snd pq, fst pq) |\<in>| \<Delta>\<^sub>\<epsilon> B A}" + unfolding \<Delta>_Atr_rules_def horn_infer1_union + by (auto simp: horn.infer1_def simp flip: ex_simps(1)) force+ + +lemma \<Delta>_Atr_sound: + "\<Delta>_Atrans_set Q A B = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using lr unfolding x + proof (induct) + case (base p q) + then show ?case + by (intro infer[of "[]" "(p, q)"]) (auto simp: \<Delta>_Atr_rules_def) + next + case (step p q r v) + then show ?case + by (intro infer[of "[(p, q), (r, v)]" "(p, v)"]) (auto simp: \<Delta>_Atr_rules_def) + qed +next + case (rl x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using rl unfolding x + proof (induct) + case (infer as a) then show ?case + using base[of "fst a" "snd a" Q A B] + using \<Delta>_Atrans_set.step[of "fst a" _ Q A B "snd a"] + by (auto simp: \<Delta>_Atr_rules_def) blast + qed +qed + +end + +section \<open>Computing the Q infinity set for the infinity predicate automaton\<close> + +definition Q_inf_rules :: "('q, 'f option \<times> 'g option) ta \<Rightarrow> ('q \<times> 'q) horn set" where + "Q_inf_rules A = + {[] \<rightarrow>\<^sub>h (ps ! i, p) |f ps p i. (None, Some f) ps \<rightarrow> p |\<in>| rules A \<and> i < length ps} \<union> + {[(p, q)] \<rightarrow>\<^sub>h (p, r) |p q r. (q, r) |\<in>| eps A} \<union> + {[(p, q), (q, r)] \<rightarrow>\<^sub>h (p, r) |p q r. True}" + +locale Q_horn = + fixes A :: "('q, 'f option \<times> 'g option) ta" +begin + +sublocale horn "Q_inf_rules A" . + +lemma Q_infer0: + "infer0 = {(ps ! i, p) |f ps p i. (None, Some f) ps \<rightarrow> p |\<in>| rules A \<and> i < length ps}" + unfolding horn.infer0_def Q_inf_rules_def by auto + +lemma Q_infer1: + "infer1 pq X = {(fst pq, r) | q r. (q, r) |\<in>| eps A \<and> q = snd pq} \<union> + {(r, snd pq) |r p'. (r, p') \<in> X \<and> p' = fst pq} \<union> + {(fst pq, r) |q' r. (q', r) \<in> (insert pq X) \<and> q' = snd pq}" + unfolding Q_inf_rules_def horn_infer1_union + by (auto simp: horn.infer1_def simp flip: ex_simps(1)) force+ + +lemma Q_sound: + "Q_inf A = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using lr unfolding x + proof (induct) + case (trans p q r) + then show ?case + by (intro infer[of "[(p,q), (q,r)]" "(p, r)"]) + (auto simp: Q_inf_rules_def) + next + case (rule f qs q i) + then show ?case + by (intro infer[of "[]" "(qs ! i, q)"]) + (auto simp: Q_inf_rules_def) + next + case (eps p q r) + then show ?case + by (intro infer[of "[(p, q)]" "(p, r)"]) + (auto simp: Q_inf_rules_def) + qed +next + case (rl x) obtain p q where x: "x = (p, q)" by (cases x) + show ?case using rl unfolding x + proof (induct) + case (infer as a) then show ?case + using Q_inf.eps[of "fst a" _ A "snd a"] + using Q_inf.trans[of "fst a" "snd (hd as)" A "snd a"] + by (auto simp: Q_inf_rules_def intro: Q_inf.rule) + qed +qed + +end + + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Regular_Relation_Impl.thy b/thys/Regular_Tree_Relations/Regular_Relation_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Regular_Relation_Impl.thy @@ -0,0 +1,301 @@ +theory Regular_Relation_Impl + imports Tree_Automata_Impl + Regular_Relation_Abstract_Impl + Horn_Fset +begin + +section \<open>Computing the epsilon transitions for the composition of GTT's\<close> + +definition \<Delta>\<^sub>\<epsilon>_infer0_cont where + "\<Delta>\<^sub>\<epsilon>_infer0_cont \<Delta>\<^sub>A \<Delta>\<^sub>B = + (let arules = filter (\<lambda> r. r_lhs_states r = []) (sorted_list_of_fset \<Delta>\<^sub>A) in + let brules = filter (\<lambda> r. r_lhs_states r = []) (sorted_list_of_fset \<Delta>\<^sub>B) in + (map (map_prod r_rhs r_rhs) (filter (\<lambda>(ra, rb). r_root ra = r_root rb) (List.product arules brules))))" + +definition \<Delta>\<^sub>\<epsilon>_infer1_cont where + "\<Delta>\<^sub>\<epsilon>_infer1_cont \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = + (let (arules, aeps) = (sorted_list_of_fset \<Delta>\<^sub>A, sorted_list_of_fset \<Delta>\<^sub>A\<^sub>\<epsilon>) in + let (brules, beps) = (sorted_list_of_fset \<Delta>\<^sub>B, sorted_list_of_fset \<Delta>\<^sub>B\<^sub>\<epsilon>) in + let prules = List.product arules brules in + (\<lambda> pq bs. + map (map_prod r_rhs r_rhs) (filter (\<lambda>(ra, rb). case (ra, rb) of (TA_rule f ps p, TA_rule g qs q) \<Rightarrow> + f = g \<and> length ps = length qs \<and> (fst pq, snd pq) \<in> set (zip ps qs) \<and> + set (zip ps qs) \<subseteq> insert (fst pq, snd pq) (fset bs)) prules) @ + map (\<lambda>(p, p'). (p', snd pq)) (filter (\<lambda>(p, p') \<Rightarrow> p = fst pq) aeps) @ + map (\<lambda>(q, q'). (fst pq, q')) (filter (\<lambda>(q, q') \<Rightarrow> q = snd pq) beps)))" + + +locale \<Delta>\<^sub>\<epsilon>_fset = + fixes \<Delta>\<^sub>A :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>A\<^sub>\<epsilon> :: "('q \<times> 'q) fset" + and \<Delta>\<^sub>B :: "('q, 'f) ta_rule fset" and \<Delta>\<^sub>B\<^sub>\<epsilon> :: "('q \<times> 'q) fset" +begin + +abbreviation A where "A \<equiv> TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>" +abbreviation B where "B \<equiv> TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + +sublocale \<Delta>\<^sub>\<epsilon>_horn A B . + +sublocale l: horn_fset "\<Delta>\<^sub>\<epsilon>_rules A B" "\<Delta>\<^sub>\<epsilon>_infer0_cont \<Delta>\<^sub>A \<Delta>\<^sub>B" "\<Delta>\<^sub>\<epsilon>_infer1_cont \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + apply (unfold_locales) + unfolding \<Delta>\<^sub>\<epsilon>_horn.\<Delta>\<^sub>\<epsilon>_infer0 \<Delta>\<^sub>\<epsilon>_horn.\<Delta>\<^sub>\<epsilon>_infer1 \<Delta>\<^sub>\<epsilon>_infer0_cont_def \<Delta>\<^sub>\<epsilon>_infer1_cont_def set_append Un_assoc[symmetric] + unfolding sorted_list_of_fset_simps union_fset + subgoal + apply (auto split!: prod.splits ta_rule.splits simp: comp_def fset_of_list_elem r_rhs_def + map_prod_def fSigma.rep_eq image_def Bex_def simp flip: fmember.rep_eq) + apply (metis ta_rule.exhaust_sel) + done + unfolding Let_def prod.case set_append Un_assoc + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"]) + subgoal + apply (auto split!: prod.splits ta_rule.splits simp flip: fmember.rep_eq ) + apply (smt (verit, del_insts) Pair_inject map_prod_imageI mem_Collect_eq ta_rule.inject ta_rule.sel(3)) + done +by (force simp add: image_def fmember.rep_eq split!: prod.splits)+ + +lemmas infer = l.infer0 l.infer1 +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition \<Delta>\<^sub>\<epsilon>_impl where + "\<Delta>\<^sub>\<epsilon>_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = horn_fset_impl.saturate_impl (\<Delta>\<^sub>\<epsilon>_infer0_cont \<Delta>\<^sub>A \<Delta>\<^sub>B) (\<Delta>\<^sub>\<epsilon>_infer1_cont \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + +lemma \<Delta>\<^sub>\<epsilon>_impl_sound: + assumes "\<Delta>\<^sub>\<epsilon>_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = Some xs" + shows "xs = \<Delta>\<^sub>\<epsilon> (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + using \<Delta>\<^sub>\<epsilon>_fset.saturate_impl_sound[OF assms[unfolded \<Delta>\<^sub>\<epsilon>_impl_def]] + unfolding \<Delta>\<^sub>\<epsilon>_horn.\<Delta>\<^sub>\<epsilon>_sound[symmetric] + by (auto simp flip: \<Delta>\<^sub>\<epsilon>.rep_eq simp: fmember.rep_eq) + +lemma \<Delta>\<^sub>\<epsilon>_impl_complete: + fixes \<Delta>\<^sub>A :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>B :: "('q, 'f) ta_rule fset" + and \<Delta>\<^sub>\<epsilon>\<^sub>A :: "('q \<times> 'q) fset" and \<Delta>\<^sub>\<epsilon>\<^sub>B :: "('q \<times> 'q) fset" + shows "\<Delta>\<^sub>\<epsilon>_impl \<Delta>\<^sub>A \<Delta>\<^sub>\<epsilon>\<^sub>A \<Delta>\<^sub>B \<Delta>\<^sub>\<epsilon>\<^sub>B \<noteq> None" unfolding \<Delta>\<^sub>\<epsilon>_impl_def + by (intro \<Delta>\<^sub>\<epsilon>_fset.saturate_impl_complete) + (auto simp flip: \<Delta>\<^sub>\<epsilon>_horn.\<Delta>\<^sub>\<epsilon>_sound) + +lemma \<Delta>\<^sub>\<epsilon>_impl [code]: + "\<Delta>\<^sub>\<epsilon> (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>) = the (\<Delta>\<^sub>\<epsilon>_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + using \<Delta>\<^sub>\<epsilon>_impl_complete[of \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] \<Delta>\<^sub>\<epsilon>_impl_sound[of \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] + by force + +section \<open>Computing the epsilon transitions for the transitive closure of GTT's\<close> + +definition \<Delta>_trancl_infer0 where + "\<Delta>_trancl_infer0 \<Delta>\<^sub>A \<Delta>\<^sub>B = \<Delta>\<^sub>\<epsilon>_infer0_cont \<Delta>\<^sub>A \<Delta>\<^sub>B" + +definition \<Delta>_trancl_infer1 :: "('q :: linorder , 'f :: linorder) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> ('q, 'f) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset + \<Rightarrow> 'q \<times> 'q \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> ('q \<times> 'q) list" where + "\<Delta>_trancl_infer1 \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> pq bs = + \<Delta>\<^sub>\<epsilon>_infer1_cont \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> pq bs @ + sorted_list_of_fset ( + (\<lambda>(r, p'). (r, snd pq)) |`| (ffilter (\<lambda>(r, p') \<Rightarrow> p' = fst pq) bs) |\<union>| + (\<lambda>(q', r). (fst pq, r)) |`| (ffilter (\<lambda>(q', r) \<Rightarrow> q' = snd pq) (finsert pq bs)))" + +locale \<Delta>_trancl_list = + fixes \<Delta>\<^sub>A :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>A\<^sub>\<epsilon> :: "('q \<times> 'q) fset" + and \<Delta>\<^sub>B :: "('q, 'f) ta_rule fset" and \<Delta>\<^sub>B\<^sub>\<epsilon> :: "('q \<times> 'q) fset" +begin + +abbreviation A where "A \<equiv> TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>" +abbreviation B where "B \<equiv> TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + +sublocale \<Delta>_trancl_horn A B . + +sublocale l: horn_fset "\<Delta>_trancl_rules A B" + "\<Delta>_trancl_infer0 \<Delta>\<^sub>A \<Delta>\<^sub>B" "\<Delta>_trancl_infer1 \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + apply (unfold_locales) + unfolding \<Delta>_trancl_rules_def horn_infer0_union horn_infer1_union + \<Delta>_trancl_infer0_def \<Delta>_trancl_infer1_def \<Delta>\<^sub>\<epsilon>_fset.infer set_append + by (auto simp flip: ex_simps(1) simp: horn.infer0_def horn.infer1_def intro!: arg_cong2[of _ _ _ _ "(\<union>)"]) + +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition "\<Delta>_trancl_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = + horn_fset_impl.saturate_impl (\<Delta>_trancl_infer0 \<Delta>\<^sub>A \<Delta>\<^sub>B) (\<Delta>_trancl_infer1 \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + +lemma \<Delta>_trancl_impl_sound: + assumes "\<Delta>_trancl_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = Some xs" + shows "xs = \<Delta>_trancl (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + using \<Delta>_trancl_list.saturate_impl_sound[OF assms[unfolded \<Delta>_trancl_impl_def]] + unfolding \<Delta>_trancl_horn.\<Delta>_trancl_sound[symmetric] \<Delta>_trancl.rep_eq[symmetric] + by (auto simp: fmember.rep_eq) + +lemma \<Delta>_trancl_impl_complete: + fixes \<Delta>\<^sub>A :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>B :: "('q, 'f) ta_rule fset" + and \<Delta>\<^sub>A\<^sub>\<epsilon> :: "('q \<times> 'q) fset" and \<Delta>\<^sub>B\<^sub>\<epsilon> :: "('q \<times> 'q) fset" + shows "\<Delta>_trancl_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> \<noteq> None" + unfolding \<Delta>_trancl_impl_def + by (intro \<Delta>_trancl_list.saturate_impl_complete) + (auto simp flip: \<Delta>_trancl_horn.\<Delta>_trancl_sound) + +lemma \<Delta>_trancl_impl [code]: + "\<Delta>_trancl (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>) = (the (\<Delta>_trancl_impl \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>))" + using \<Delta>_trancl_impl_complete[of \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] + using \<Delta>_trancl_impl_sound[of \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] + by force + +section \<open>Computing the epsilon transitions for the transitive closure of pair automata\<close> + +definition \<Delta>_Atr_infer1_cont :: "('q :: linorder \<times> 'q) fset \<Rightarrow> ('q, 'f :: linorder) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> + ('q, 'f) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> 'q \<times> 'q \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> ('q \<times> 'q) list" where + "\<Delta>_Atr_infer1_cont Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = + (let G = sorted_list_of_fset (the (\<Delta>\<^sub>\<epsilon>_impl \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>)) in + (\<lambda> pq bs. + (let bs_list = sorted_list_of_fset bs in + map (\<lambda> (p, q). (fst p, snd pq)) (filter (\<lambda> (p, q). snd p = fst q \<and> snd q = fst pq) (List.product bs_list G)) @ + map (\<lambda> (p, q). (fst pq, snd q)) (filter (\<lambda> (p, q). snd p = fst q \<and> fst p = snd pq) (List.product G bs_list)) @ + map (\<lambda> (p, q). (fst pq, snd pq)) (filter (\<lambda> (p, q). snd pq = p \<and> fst pq = q) G))))" + +locale \<Delta>_Atr_fset = + fixes Q :: "('q :: linorder \<times> 'q) fset" and \<Delta>\<^sub>A :: "('q, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>A\<^sub>\<epsilon> :: "('q \<times> 'q) fset" + and \<Delta>\<^sub>B :: "('q, 'f) ta_rule fset" and \<Delta>\<^sub>B\<^sub>\<epsilon> :: "('q \<times> 'q) fset" +begin + +abbreviation A where "A \<equiv> TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>" +abbreviation B where "B \<equiv> TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + +sublocale \<Delta>_Atr_horn Q A B . + +lemma infer1: + "infer1 pq (fset bs) = set (\<Delta>_Atr_infer1_cont Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> pq bs)" +proof - + have "{(p, snd pq) | p q. (p, q) \<in> (fset bs) \<and> (q, fst pq) |\<in>| \<Delta>\<^sub>\<epsilon> B A} \<union> + {(fst pq, v) | q r v. (snd pq, r) |\<in>| \<Delta>\<^sub>\<epsilon> B A \<and> (r, v) \<in> (fset bs)} \<union> + {(fst pq, snd pq) | q . (snd pq, fst pq) |\<in>| \<Delta>\<^sub>\<epsilon> B A} = set (\<Delta>_Atr_infer1_cont Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> pq bs)" + unfolding \<Delta>_Atr_infer1_cont_def set_append Un_assoc[symmetric] Let_def + unfolding sorted_list_of_fset_simps union_fset + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"]) + apply (simp_all add: fSigma_repeq fmember.rep_eq flip: \<Delta>\<^sub>\<epsilon>_impl fset_of_list_elem) + apply force+ + done + then show ?thesis + using \<Delta>_Atr_horn.\<Delta>_Atr_infer1[of Q A B pq "fset bs"] + by simp +qed + +sublocale l: horn_fset "\<Delta>_Atr_rules Q A B" "sorted_list_of_fset Q" "\<Delta>_Atr_infer1_cont Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>" + apply (unfold_locales) + unfolding \<Delta>_Atr_horn.\<Delta>_Atr_infer0 fset_of_list.rep_eq + using infer1 + by auto + +lemmas infer = l.infer0 l.infer1 +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition "\<Delta>_Atr_impl Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = + horn_fset_impl.saturate_impl (sorted_list_of_fset Q) (\<Delta>_Atr_infer1_cont Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + +lemma \<Delta>_Atr_impl_sound: + assumes "\<Delta>_Atr_impl Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> = Some xs" + shows "xs = \<Delta>_Atrans Q (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>)" + using \<Delta>_Atr_fset.saturate_impl_sound[OF assms[unfolded \<Delta>_Atr_impl_def]] + unfolding \<Delta>_Atr_horn.\<Delta>_Atr_sound[symmetric] \<Delta>_Atrans.rep_eq[symmetric] + by (simp add: fset_inject) + +lemma \<Delta>_Atr_impl_complete: + shows "\<Delta>_Atr_impl Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon> \<noteq> None" unfolding \<Delta>_Atr_impl_def + by (intro \<Delta>_Atr_fset.saturate_impl_complete) + (auto simp: finite_\<Delta>_Atrans_set simp flip: \<Delta>_Atr_horn.\<Delta>_Atr_sound) + +lemma \<Delta>_Atr_impl [code]: + "\<Delta>_Atrans Q (TA \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon>) (TA \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>) = (the (\<Delta>_Atr_impl Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>))" + using \<Delta>_Atr_impl_complete[of Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] \<Delta>_Atr_impl_sound[of Q \<Delta>\<^sub>A \<Delta>\<^sub>A\<^sub>\<epsilon> \<Delta>\<^sub>B \<Delta>\<^sub>B\<^sub>\<epsilon>] + by force + +section \<open>Computing the Q infinity set for the infinity predicate automaton\<close> + +definition Q_infer0_cont :: "('q :: linorder, 'f :: linorder option \<times> 'g :: linorder option) ta_rule fset \<Rightarrow> ('q \<times> 'q) list" where + "Q_infer0_cont \<Delta> = concat (sorted_list_of_fset ( + (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> map (\<lambda> x. Pair x p) ps) |`| + (ffilter (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> fst f = None \<and> snd f \<noteq> None \<and> ps \<noteq> []) \<Delta>)))" + +definition Q_infer1_cont :: "('q ::linorder \<times> 'q) fset \<Rightarrow> 'q \<times> 'q \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> ('q \<times> 'q) list" where + "Q_infer1_cont \<Delta>\<epsilon> = + (let eps = sorted_list_of_fset \<Delta>\<epsilon> in + (\<lambda> pq bs. + let bs_list = sorted_list_of_fset bs in + map (\<lambda> (q, r). (fst pq, r)) (filter (\<lambda> (q, r) \<Rightarrow> q = snd pq) eps) @ + map (\<lambda>(r, p'). (r, snd pq)) (filter (\<lambda>(r, p') \<Rightarrow> p' = fst pq) bs_list) @ + map (\<lambda>(q', r). (fst pq, r)) (filter (\<lambda>(q', r) \<Rightarrow> q' = snd pq) (pq # bs_list))))" + +locale Q_fset = + fixes \<Delta> :: "('q :: linorder, 'f :: linorder option \<times> 'g :: linorder option) ta_rule fset" and \<Delta>\<epsilon> :: "('q \<times> 'q) fset" +begin + +abbreviation A where "A \<equiv> TA \<Delta> \<Delta>\<epsilon>" +sublocale Q_horn A . + +sublocale l: horn_fset "Q_inf_rules A" "Q_infer0_cont \<Delta>" "Q_infer1_cont \<Delta>\<epsilon>" + apply (unfold_locales) + unfolding Q_horn.Q_infer0 Q_horn.Q_infer1 Q_infer0_cont_def Q_infer1_cont_def set_append Un_assoc[symmetric] + unfolding sorted_list_of_fset_simps union_fset + subgoal + apply (auto simp add: Bex_def fmember.rep_eq split!: ta_rule.splits) + apply (rule_tac x = "TA_rule (lift_None_Some f) ps p" in exI) + apply (force dest: in_set_idx)+ + done + unfolding Let_def set_append Un_assoc + by (intro arg_cong2[of _ _ _ _ "(\<union>)"]) (auto simp add: fmember.rep_eq) + +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition Q_impl where + "Q_impl \<Delta> \<Delta>\<epsilon> = horn_fset_impl.saturate_impl (Q_infer0_cont \<Delta>) (Q_infer1_cont \<Delta>\<epsilon>)" + +lemma Q_impl_sound: + "Q_impl \<Delta> \<Delta>\<epsilon> = Some xs \<Longrightarrow> fset xs = Q_inf (TA \<Delta> \<Delta>\<epsilon>)" + using Q_fset.saturate_impl_sound unfolding Q_impl_def Q_horn.Q_sound . + +lemma Q_impl_complete: + "Q_impl \<Delta> \<Delta>\<epsilon> \<noteq> None" +proof - + let ?A = "TA \<Delta> \<Delta>\<epsilon>" + have *: "Q_inf ?A \<subseteq> fset (\<Q> ?A |\<times>| \<Q> ?A)" + by (auto simp add: Q_inf_states_ta_states(1, 2) subrelI simp flip: fmember.rep_eq) + have "finite (Q_inf ?A)" + by (intro finite_subset[OF *]) simp + then show ?thesis unfolding Q_impl_def + by (intro Q_fset.saturate_impl_complete) (auto simp: Q_horn.Q_sound) +qed + + +definition "Q_infinity_impl \<Delta> \<Delta>\<epsilon> = (let Q = the (Q_impl \<Delta> \<Delta>\<epsilon>) in + snd |`| ((ffilter (\<lambda> (p, q). p = q) Q) |O| Q))" + +lemma Q_infinity_impl_fmember: + "q |\<in>| Q_infinity_impl \<Delta> \<Delta>\<epsilon> \<longleftrightarrow> (\<exists> p. (p, p) |\<in>| the (Q_impl \<Delta> \<Delta>\<epsilon>) \<and> + (p, q) |\<in>| the (Q_impl \<Delta> \<Delta>\<epsilon>))" + unfolding Q_infinity_impl_def + by (auto simp: Let_def fimage_iff fBex_def) fastforce + +lemma loop_sound_correct [simp]: + "fset (Q_infinity_impl \<Delta> \<Delta>\<epsilon>) = Q_inf_e (TA \<Delta> \<Delta>\<epsilon>)" +proof - + obtain Q where [simp]: "Q_impl \<Delta> \<Delta>\<epsilon> = Some Q" using Q_impl_complete[of \<Delta> \<Delta>\<epsilon>] + by blast + have "fset Q = (Q_inf (TA \<Delta> \<Delta>\<epsilon>))" + using Q_impl_sound[of \<Delta> \<Delta>\<epsilon>] + by (auto simp: fset_of_list.rep_eq) + then show ?thesis + by (force simp: Q_infinity_impl_fmember Let_def fset_of_list_elem + fset_of_list.rep_eq simp flip: fmember.rep_eq) +qed + +lemma fQ_inf_e_code [code]: + "fQ_inf_e (TA \<Delta> \<Delta>\<epsilon>) = Q_infinity_impl \<Delta> \<Delta>\<epsilon>" + using loop_sound_correct + by (auto simp add: fQ_inf_e.rep_eq fmember.rep_eq) + + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Myhill_Nerode.thy b/thys/Regular_Tree_Relations/Tree_Automata/Myhill_Nerode.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Myhill_Nerode.thy @@ -0,0 +1,80 @@ +theory Myhill_Nerode + imports Tree_Automata Ground_Ctxt +begin + +subsection \<open>Myhill Nerode characterization for regular tree languages\<close> + +lemma ground_ctxt_apply_pres_der: + assumes "ta_der \<A> (term_of_gterm s) = ta_der \<A> (term_of_gterm t)" + shows "ta_der \<A> (term_of_gterm C\<langle>s\<rangle>\<^sub>G) = ta_der \<A> (term_of_gterm C\<langle>t\<rangle>\<^sub>G)" using assms + by (induct C) (auto, (metis append_Cons_nth_not_middle nth_append_length)+) + +locale myhill_nerode = + fixes \<F> \<L> assumes term_subset: "\<L> \<subseteq> \<T>\<^sub>G \<F>" +begin + +definition myhill ("_ \<equiv>\<^sub>\<L> _") where + "myhill s t \<equiv> s \<in> \<T>\<^sub>G \<F> \<and> t \<in> \<T>\<^sub>G \<F> \<and> (\<forall> C. C\<langle>s\<rangle>\<^sub>G \<in> \<L> \<and> C\<langle>t\<rangle>\<^sub>G \<in> \<L> \<or> C\<langle>s\<rangle>\<^sub>G \<notin> \<L> \<and> C\<langle>t\<rangle>\<^sub>G \<notin> \<L>)" + +lemma myhill_sound: "s \<equiv>\<^sub>\<L> t \<Longrightarrow> s \<in> \<T>\<^sub>G \<F>" "s \<equiv>\<^sub>\<L> t \<Longrightarrow> t \<in> \<T>\<^sub>G \<F>" + unfolding myhill_def by auto + +lemma myhill_refl [simp]: "s \<in> \<T>\<^sub>G \<F> \<Longrightarrow> s \<equiv>\<^sub>\<L> s" + unfolding myhill_def by auto + +lemma myhill_symmetric: "s \<equiv>\<^sub>\<L> t \<Longrightarrow> t \<equiv>\<^sub>\<L> s" + unfolding myhill_def by auto + +lemma myhill_trans [trans]: + "s \<equiv>\<^sub>\<L> t \<Longrightarrow> t \<equiv>\<^sub>\<L> u \<Longrightarrow> s \<equiv>\<^sub>\<L> u" + unfolding myhill_def by auto + +abbreviation myhill_r ("MN\<^sub>\<L>") where + "myhill_r \<equiv> {(s, t) | s t. s \<equiv>\<^sub>\<L> t}" + +lemma myhill_equiv: + "equiv (\<T>\<^sub>G \<F>) MN\<^sub>\<L>" + apply (intro equivI) apply (auto simp: myhill_sound myhill_symmetric sym_def trans_def refl_on_def) + using myhill_trans by blast + +lemma rtl_der_image_on_myhill_inj: + assumes "gta_lang Q\<^sub>f \<A> = \<L>" + shows "inj_on (\<lambda> X. gta_der \<A> ` X) (\<T>\<^sub>G \<F> // MN\<^sub>\<L>)" (is "inj_on ?D ?R") +proof - + {fix S T assume eq_rel: "S \<in> ?R" "T \<in> ?R" "?D S = ?D T" + have "\<And> s t. s \<in> S \<Longrightarrow> t \<in> T \<Longrightarrow> s \<equiv>\<^sub>\<L> t" + proof - + fix s t assume mem: "s \<in> S" "t \<in> T" + then obtain t' where res: "t' \<in> T" "gta_der \<A> s = gta_der \<A> t'" using eq_rel(3) + by (metis image_iff) + from res(1) mem have "s \<in> \<T>\<^sub>G \<F>" "t \<in> \<T>\<^sub>G \<F>" "t' \<in> \<T>\<^sub>G \<F>" using eq_rel(1, 2) + using in_quotient_imp_subset myhill_equiv by blast+ + then have "s \<equiv>\<^sub>\<L> t'" using assms res ground_ctxt_apply_pres_der[of \<A> s] + by (auto simp: myhill_def gta_der_def simp flip: ctxt_of_gctxt_apply + elim!: gta_langE intro: gta_langI) + moreover have "t' \<equiv>\<^sub>\<L> t" using quotient_eq_iff[OF myhill_equiv eq_rel(2) eq_rel(2) res(1) mem(2)] + by simp + ultimately show "s \<equiv>\<^sub>\<L> t" using myhill_trans by blast + qed + then have "\<And> s t. s \<in> S \<Longrightarrow> t \<in> T \<Longrightarrow> (s, t) \<in> MN\<^sub>\<L>" by blast + then have "S = T" using quotient_eq_iff[OF myhill_equiv eq_rel(1, 2)] + using eq_rel(3) by fastforce} + then show inj: "inj_on ?D ?R" by (meson inj_onI) +qed + +lemma rtl_implies_finite_indexed_myhill_relation: + assumes "gta_lang Q\<^sub>f \<A> = \<L>" + shows "finite (\<T>\<^sub>G \<F> // MN\<^sub>\<L>)" (is "finite ?R") +proof - + let ?D = "\<lambda> X. gta_der \<A> ` X" + have image: "?D ` ?R \<subseteq> Pow (fset (fPow (\<Q> \<A>)))" unfolding gta_der_def + by (meson PowI fPowI ground_ta_der_states ground_term_of_gterm image_subsetI notin_fset) + then have "finite (Pow (fset (fPow (\<Q> \<A>))))" by simp + then have "finite (?D ` ?R)" using finite_subset[OF image] by fastforce + then show ?thesis using finite_image_iff[OF rtl_der_image_on_myhill_inj[OF assms]] + by blast +qed + +end + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata.thy @@ -0,0 +1,2184 @@ +section \<open>Tree automaton\<close> + +theory Tree_Automata + imports FSet_Utils + "HOL-Library.Product_Lexorder" + "HOL-Library.Option_ord" +begin + +subsection \<open>Tree automaton definition and functionality\<close> + +datatype ('q, 'f) ta_rule = TA_rule (r_root: 'f) (r_lhs_states: "'q list") (r_rhs: 'q) ("_ _ \<rightarrow> _" [51, 51, 51] 52) +datatype ('q, 'f) ta = TA (rules: "('q, 'f) ta_rule fset") (eps: "('q \<times> 'q) fset") + +text \<open>In many application we are interested in specific subset of all terms. If these + can be captured by a tree automaton (identified by a state) then we say the set is regular. + This gives the motivation for the following definition\<close> +datatype ('q, 'f) reg = Reg (fin: "'q fset") (ta: "('q, 'f) ta") + + +text \<open>The state set induced by a tree automaton is implicit in our representation. + We compute it based on the rules and epsilon transitions of a given tree automaton\<close> + +abbreviation rule_arg_states where "rule_arg_states \<Delta> \<equiv> |\<Union>| ((fset_of_list \<circ> r_lhs_states) |`| \<Delta>)" +abbreviation rule_target_states where "rule_target_states \<Delta> \<equiv> (r_rhs |`| \<Delta>)" +definition rule_states where "rule_states \<Delta> \<equiv> rule_arg_states \<Delta> |\<union>| rule_target_states \<Delta>" + +definition eps_states where "eps_states \<Delta>\<^sub>\<epsilon> \<equiv> (fst |`| \<Delta>\<^sub>\<epsilon>) |\<union>| (snd |`| \<Delta>\<^sub>\<epsilon>)" +definition "\<Q> \<A> = rule_states (rules \<A>) |\<union>| eps_states (eps \<A>)" +abbreviation "\<Q>\<^sub>r \<A> \<equiv> \<Q> (ta \<A>)" + +definition ta_rhs_states :: "('q, 'f) ta \<Rightarrow> 'q fset" where + "ta_rhs_states \<A> \<equiv> {| q | p q. (p |\<in>| rule_target_states (rules \<A>)) \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)|}" + +definition "ta_sig \<A> = (\<lambda> r. (r_root r, length (r_lhs_states r))) |`| (rules \<A>)" + +subsubsection \<open>Rechability of a term induced by a tree automaton\<close> +(* The reachable states of some term. *) +fun ta_der :: "('q, 'f) ta \<Rightarrow> ('f, 'q) term \<Rightarrow> 'q fset" where + "ta_der \<A> (Var q) = {|q' | q'. q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+| |}" +| "ta_der \<A> (Fun f ts) = {|q' | q' q qs. + TA_rule f qs q |\<in>| (rules \<A>) \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|) \<and> length qs = length ts \<and> + (\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i))|}" + +(* The reachable mixed terms of some term. *) +fun ta_der' :: "('q,'f) ta \<Rightarrow> ('f,'q) term \<Rightarrow> ('f,'q) term fset" where + "ta_der' \<A> (Var p) = {|Var q | q. p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+| |}" +| "ta_der' \<A> (Fun f ts) = {|Var q | q. q |\<in>| ta_der \<A> (Fun f ts)|} |\<union>| + {|Fun f ss | ss. length ss = length ts \<and> + (\<forall>i < length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i))|}" + +text \<open>Sometimes it is useful to analyse a concrete computation done by a tree automaton. + To do this we introduce the notion of run which keeps track which states are computed in each + subterm to reach a certain state.\<close> + +abbreviation "ex_rule_state \<equiv> fst \<circ> groot_sym" +abbreviation "ex_comp_state \<equiv> snd \<circ> groot_sym" + +inductive run for \<A> where + step: "length qs = length ts \<Longrightarrow> (\<forall> i < length ts. run \<A> (qs ! i) (ts ! i)) \<Longrightarrow> + TA_rule f (map ex_comp_state qs) q |\<in>| (rules \<A>) \<Longrightarrow> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|) \<Longrightarrow> + run \<A> (GFun (q, q') qs) (GFun f ts)" + + +subsubsection \<open>Language acceptance\<close> + +definition ta_lang :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('f, 'v) terms" where + [code del]: "ta_lang Q \<A> = {adapt_vars t | t. ground t \<and> Q |\<inter>| ta_der \<A> t \<noteq> {||}}" + +definition gta_der where + "gta_der \<A> t = ta_der \<A> (term_of_gterm t)" + +definition gta_lang where + "gta_lang Q \<A> = {t. Q |\<inter>| gta_der \<A> t \<noteq> {||}}" + +definition \<L> where + "\<L> \<A> = gta_lang (fin \<A>) (ta \<A>)" + +definition reg_Restr_Q\<^sub>f where + "reg_Restr_Q\<^sub>f R = Reg (fin R |\<inter>| \<Q>\<^sub>r R) (ta R)" + +subsubsection \<open>Trimming\<close> + +definition ta_restrict where + "ta_restrict \<A> Q = TA {| TA_rule f qs q| f qs q. TA_rule f qs q |\<in>| rules \<A> \<and> fset_of_list qs |\<subseteq>| Q \<and> q |\<in>| Q |} (fRestr (eps \<A>) Q)" + +definition ta_reachable :: "('q, 'f) ta \<Rightarrow> 'q fset" where + "ta_reachable \<A> = {|q| q. \<exists> t. ground t \<and> q |\<in>| ta_der \<A> t |}" + +definition ta_productive :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> 'q fset" where + "ta_productive P \<A> \<equiv> {|q| q q' C. q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| P |}" + +text \<open>An automaton is trim if all its states are reachable and productive.\<close> +definition ta_is_trim :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> bool" where + "ta_is_trim P \<A> \<equiv> \<forall> q. q |\<in>| \<Q> \<A> \<longrightarrow> q |\<in>| ta_reachable \<A> \<and> q |\<in>| ta_productive P \<A>" + +definition reg_is_trim :: "('q, 'f) reg \<Rightarrow> bool" where + "reg_is_trim R \<equiv> ta_is_trim (fin R) (ta R)" + +text \<open>We obtain a trim automaton by restriction it to reachable and productive states.\<close> +abbreviation ta_only_reach :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where + "ta_only_reach \<A> \<equiv> ta_restrict \<A> (ta_reachable \<A>)" + +abbreviation ta_only_prod :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> ('q,'f) ta" where + "ta_only_prod P \<A> \<equiv> ta_restrict \<A> (ta_productive P \<A>)" + +definition reg_reach where + "reg_reach R = Reg (fin R) (ta_only_reach (ta R))" + +definition reg_prod where + "reg_prod R = Reg (fin R) (ta_only_prod (fin R) (ta R))" + +definition trim_ta :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where + "trim_ta P \<A> = ta_only_prod P (ta_only_reach \<A>)" + +definition trim_reg where + "trim_reg R = Reg (fin R) (trim_ta (fin R) (ta R))" + +subsubsection \<open>Mapping over tree automata\<close> + +definition fmap_states_ta :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'f) ta \<Rightarrow> ('b, 'f) ta" where + "fmap_states_ta f \<A> = TA (map_ta_rule f id |`| rules \<A>) (map_both f |`| eps \<A>)" + +definition fmap_funs_ta :: "('f \<Rightarrow> 'g) \<Rightarrow> ('a, 'f) ta \<Rightarrow> ('a, 'g) ta" where + "fmap_funs_ta f \<A> = TA (map_ta_rule id f |`| rules \<A>) (eps \<A>)" + +definition fmap_states_reg :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a, 'f) reg \<Rightarrow> ('b, 'f) reg" where + "fmap_states_reg f R = Reg (f |`| fin R) (fmap_states_ta f (ta R))" + +definition fmap_funs_reg :: "('f \<Rightarrow> 'g) \<Rightarrow> ('a, 'f) reg \<Rightarrow> ('a, 'g) reg" where + "fmap_funs_reg f R = Reg (fin R) (fmap_funs_ta f (ta R))" + +subsubsection \<open>Product construction (language intersection)\<close> + +definition prod_ta_rules :: "('q1,'f) ta \<Rightarrow> ('q2,'f) ta \<Rightarrow> ('q1 \<times> 'q2, 'f) ta_rule fset" where + "prod_ta_rules \<A> \ = {| TA_rule f qs q | f qs q. TA_rule f (map fst qs) (fst q) |\<in>| rules \<A> \<and> + TA_rule f (map snd qs) (snd q) |\<in>| rules \|}" +declare prod_ta_rules_def [simp] + + +definition prod_epsLp where + "prod_epsLp \<A> \ = (\<lambda> (p, q). (fst p, fst q) |\<in>| eps \<A> \<and> snd p = snd q \<and> snd q |\<in>| \<Q> \)" +definition prod_epsRp where + "prod_epsRp \<A> \ = (\<lambda> (p, q). (snd p, snd q) |\<in>| eps \ \<and> fst p = fst q \<and> fst q |\<in>| \<Q> \<A>)" + +definition prod_ta :: "('q1,'f) ta \<Rightarrow> ('q2,'f) ta \<Rightarrow> ('q1 \<times> 'q2, 'f) ta" where + "prod_ta \<A> \ = TA (prod_ta_rules \<A> \) + (fCollect (prod_epsLp \<A> \) |\<union>| fCollect (prod_epsRp \<A> \))" + +definition reg_intersect where + "reg_intersect R L = Reg (fin R |\<times>| fin L) (prod_ta (ta R) (ta L))" + +subsubsection \<open>Union construction (language union)\<close> + +definition ta_union where + "ta_union \<A> \ = TA (rules \<A> |\<union>| rules \) (eps \<A> |\<union>| eps \)" + +definition reg_union where + "reg_union R L = Reg (Inl |`| (fin R |\<inter>| \<Q>\<^sub>r R) |\<union>| Inr |`| (fin L |\<inter>| \<Q>\<^sub>r L)) + (ta_union (fmap_states_ta Inl (ta R)) (fmap_states_ta Inr (ta L)))" + + +subsubsection \<open>Epsilon free and tree automaton accepting empty language\<close> + +definition eps_free_rulep where + "eps_free_rulep \<A> = (\<lambda> r. \<exists> f qs q q'. r = TA_rule f qs q' \<and> TA_rule f qs q |\<in>| rules \<A> \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|))" + +definition eps_free :: "('q, 'f) ta \<Rightarrow> ('q, 'f) ta" where + "eps_free \<A> = TA (fCollect (eps_free_rulep \<A>)) {||}" + +definition is_ta_eps_free :: "('q, 'f) ta \<Rightarrow> bool" where + "is_ta_eps_free \<A> \<longleftrightarrow> eps \<A> = {||}" + +definition ta_empty :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> bool" where + "ta_empty Q \<A> \<longleftrightarrow> ta_reachable \<A> |\<inter>| Q |\<subseteq>| {||}" + +definition eps_free_reg where + "eps_free_reg R = Reg (fin R) (eps_free (ta R))" + +definition reg_empty where + "reg_empty R = ta_empty (fin R) (ta R)" + + +subsubsection \<open>Relabeling tree automaton states to natural numbers\<close> + +definition map_fset_to_nat :: "('a :: linorder) fset \<Rightarrow> 'a \<Rightarrow> nat" where + "map_fset_to_nat X = (\<lambda>x. the (mem_idx x (sorted_list_of_fset X)))" + +definition map_fset_fset_to_nat :: "('a :: linorder) fset fset \<Rightarrow> 'a fset \<Rightarrow> nat" where + "map_fset_fset_to_nat X = (\<lambda>x. the (mem_idx (sorted_list_of_fset x) (sorted_list_of_fset (sorted_list_of_fset |`| X))))" + +definition relabel_ta :: "('q :: linorder, 'f) ta \<Rightarrow> (nat, 'f) ta" where + "relabel_ta \<A> = fmap_states_ta (map_fset_to_nat (\<Q> \<A>)) \<A>" + +definition relabel_Q\<^sub>f :: "('q :: linorder) fset \<Rightarrow> ('q :: linorder, 'f) ta \<Rightarrow> nat fset" where + "relabel_Q\<^sub>f Q \<A> = map_fset_to_nat (\<Q> \<A>) |`| (Q |\<inter>| \<Q> \<A>)" +definition relabel_reg :: "('q :: linorder, 'f) reg \<Rightarrow> (nat, 'f) reg" where + "relabel_reg R = Reg (relabel_Q\<^sub>f (fin R) (ta R)) (relabel_ta (ta R))" + +\<comment> \<open>The instantiation of $<$ and $\leq$ for finite sets are $\mid \subset \mid$ and $\mid \subseteq \mid$ + which don't give rise to a total order and therefore it cannot be an instance of the type class linorder. + However taking the lexographic order of the sorted list of each finite set gives rise + to a total order. Therefore we provide a relabeling for tree automata where the states + are finite sets. This allows us to relabel the well known power set construction.\<close> + +definition relabel_fset_ta :: "(('q :: linorder) fset, 'f) ta \<Rightarrow> (nat, 'f) ta" where + "relabel_fset_ta \<A> = fmap_states_ta (map_fset_fset_to_nat (\<Q> \<A>)) \<A>" + +definition relabel_fset_Q\<^sub>f :: "('q :: linorder) fset fset \<Rightarrow> (('q :: linorder) fset, 'f) ta \<Rightarrow> nat fset" where + "relabel_fset_Q\<^sub>f Q \<A> = map_fset_fset_to_nat (\<Q> \<A>) |`| (Q |\<inter>| \<Q> \<A>)" + +definition relable_fset_reg :: "(('q :: linorder) fset, 'f) reg \<Rightarrow> (nat, 'f) reg" where + "relable_fset_reg R = Reg (relabel_fset_Q\<^sub>f (fin R) (ta R)) (relabel_fset_ta (ta R))" + + +definition "srules \<A> = fset (rules \<A>)" +definition "seps \<A> = fset (eps \<A>)" + +lemma rules_transfer [transfer_rule]: + "rel_fun (=) (pcr_fset (=)) srules rules" unfolding rel_fun_def + by (auto simp add: cr_fset_def fset.pcr_cr_eq srules_def) + +lemma eps_transfer [transfer_rule]: + "rel_fun (=) (pcr_fset (=)) seps eps" unfolding rel_fun_def + by (auto simp add: cr_fset_def fset.pcr_cr_eq seps_def) + +lemma TA_equalityI: + "rules \<A> = rules \ \<Longrightarrow> eps \<A> = eps \ \<Longrightarrow> \<A> = \" + using ta.expand by blast + +lemma rule_states_code [code]: + "rule_states \<Delta> = |\<Union>| ((\<lambda> r. finsert (r_rhs r) (fset_of_list (r_lhs_states r))) |`| \<Delta>)" + unfolding rule_states_def + by fastforce + +lemma eps_states_code [code]: + "eps_states \<Delta>\<^sub>\<epsilon> = |\<Union>| ((\<lambda> (q,q'). {|q,q'|}) |`| \<Delta>\<^sub>\<epsilon>)" (is "?Ls = ?Rs") + unfolding eps_states_def + by (force simp add: case_prod_beta') + +lemma rule_states_empty [simp]: + "rule_states {||} = {||}" + by (auto simp: rule_states_def) + +lemma eps_states_empty [simp]: + "eps_states {||} = {||}" + by (auto simp: eps_states_def) + +lemma rule_states_union [simp]: + "rule_states (\<Delta> |\<union>| \<Gamma>) = rule_states \<Delta> |\<union>| rule_states \<Gamma>" + unfolding rule_states_def + by fastforce + +lemma rule_states_mono: + "\<Delta> |\<subseteq>| \<Gamma> \<Longrightarrow> rule_states \<Delta> |\<subseteq>| rule_states \<Gamma>" + unfolding rule_states_def + by force + +lemma eps_states_union [simp]: + "eps_states (\<Delta> |\<union>| \<Gamma>) = eps_states \<Delta> |\<union>| eps_states \<Gamma>" + unfolding eps_states_def + by auto + +lemma eps_states_image [simp]: + "eps_states (map_both f |`| \<Delta>\<^sub>\<epsilon>) = f |`| eps_states \<Delta>\<^sub>\<epsilon>" + unfolding eps_states_def map_prod_def + by (force simp: fimage_iff) + +lemma eps_states_mono: + "\<Delta> |\<subseteq>| \<Gamma> \<Longrightarrow> eps_states \<Delta> |\<subseteq>| eps_states \<Gamma>" + unfolding eps_states_def + by transfer auto + +lemma eps_statesI [intro]: + "(p, q) |\<in>| \<Delta> \<Longrightarrow> p |\<in>| eps_states \<Delta>" + "(p, q) |\<in>| \<Delta> \<Longrightarrow> q |\<in>| eps_states \<Delta>" + unfolding eps_states_def + by (auto simp add: rev_fimage_eqI) + +lemma eps_statesE [elim]: + assumes "p |\<in>| eps_states \<Delta>" + obtains q where "(p, q) |\<in>| \<Delta> \<or> (q, p) |\<in>| \<Delta>" using assms + unfolding eps_states_def + by (transfer, auto)+ + +lemma rule_statesE [elim]: + assumes "q |\<in>| rule_states \<Delta>" + obtains f ps p where "TA_rule f ps p |\<in>| \<Delta>" "q |\<in>| (fset_of_list ps) \<or> q = p" using assms +proof - + assume ass: "(\<And>f ps p. f ps \<rightarrow> p |\<in>| \<Delta> \<Longrightarrow> q |\<in>| fset_of_list ps \<or> q = p \<Longrightarrow> thesis)" + from assms obtain r where "r |\<in>| \<Delta>" "q |\<in>| fset_of_list (r_lhs_states r) \<or> q = r_rhs r" + by (auto simp: rule_states_def) + then show thesis using ass + by (cases r) auto +qed + +lemma rule_statesI [intro]: + assumes "r |\<in>| \<Delta>" "q |\<in>| finsert (r_rhs r) (fset_of_list (r_lhs_states r))" + shows "q |\<in>| rule_states \<Delta>" using assms + by (auto simp: rule_states_def) + + +text \<open>Destruction rule for states\<close> + +lemma rule_statesD: + "r |\<in>| (rules \<A>) \<Longrightarrow> r_rhs r |\<in>| \<Q> \<A>" "f qs \<rightarrow> q |\<in>| (rules \<A>) \<Longrightarrow> q |\<in>| \<Q> \<A>" + "r |\<in>| (rules \<A>) \<Longrightarrow> p |\<in>| fset_of_list (r_lhs_states r) \<Longrightarrow> p |\<in>| \<Q> \<A>" + "f qs \<rightarrow> q |\<in>| (rules \<A>) \<Longrightarrow> p |\<in>| fset_of_list qs \<Longrightarrow> p |\<in>| \<Q> \<A>" + by (force simp: \<Q>_def rule_states_def fimage_iff)+ + +lemma eps_states [simp]: "(eps \<A>) |\<subseteq>| \<Q> \<A> |\<times>| \<Q> \<A>" + unfolding \<Q>_def eps_states_def rule_states_def + by (auto simp add: rev_fimage_eqI) + +lemma eps_statesD: "(p, q) |\<in>| (eps \<A>) \<Longrightarrow> p |\<in>| \<Q> \<A> \<and> q |\<in>| \<Q> \<A>" + using eps_states by (auto simp add: \<Q>_def) + +lemma eps_trancl_statesD: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> p |\<in>| \<Q> \<A> \<and> q |\<in>| \<Q> \<A>" + by (induct rule: ftrancl_induct) (auto dest: eps_statesD) + +lemmas eps_dest_all = eps_statesD eps_trancl_statesD + +text \<open>Mapping over function symbols/states\<close> + +lemma finite_Collect_ta_rule: + "finite {TA_rule f qs q | f qs q. TA_rule f qs q |\<in>| rules \<A>}" (is "finite ?S") +proof - + have "{f qs \<rightarrow> q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>} \<subseteq> fset (rules \<A>)" + by (auto simp flip: fmember.rep_eq) + from finite_subset[OF this] show ?thesis by simp +qed + +lemma map_ta_rule_finite: + "finite \<Delta> \<Longrightarrow> finite {TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q \<in> \<Delta>}" +proof (induct rule: finite.induct) + case (insertI A a) + have union: "{TA_rule (g h) (map f qs) (f q) |h qs q. TA_rule h qs q \<in> insert a A} = + {TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q = a} \<union> {TA_rule (g h) (map f qs) (f q) |h qs q. TA_rule h qs q \<in> A}" + by auto + have "finite {g h map f qs \<rightarrow> f q |h qs q. h qs \<rightarrow> q = a}" + by (cases a) auto + from finite_UnI[OF this insertI(2)] show ?case unfolding union . +qed auto + +lemmas map_ta_rule_fset_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" for \<Delta>, simplified, unfolded fmember.rep_eq[symmetric]] +lemmas map_ta_rule_states_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" id for \<Delta>, simplified, unfolded fmember.rep_eq[symmetric]] +lemmas map_ta_rule_funsym_finite [simp] = map_ta_rule_finite[of "fset \<Delta>" _ id for \<Delta>, simplified, unfolded fmember.rep_eq[symmetric]] + +lemma map_ta_rule_comp: + "map_ta_rule f g \<circ> map_ta_rule f' g' = map_ta_rule (f \<circ> f') (g \<circ> g')" + using ta_rule.map_comp[of f g] + by (auto simp: comp_def) + +lemma map_ta_rule_cases: + "map_ta_rule f g r = TA_rule (g (r_root r)) (map f (r_lhs_states r)) (f (r_rhs r))" + by (cases r) auto + +lemma map_ta_rule_prod_swap_id [simp]: + "map_ta_rule prod.swap prod.swap (map_ta_rule prod.swap prod.swap r) = r" + by (auto simp: map_ta_rule_cases) + + +lemma rule_states_image [simp]: + "rule_states (map_ta_rule f g |`| \<Delta>) = f |`| rule_states \<Delta>" (is "?Ls = ?Rs") +proof - + {fix q assume "q |\<in>| ?Ls" + then obtain r where "r |\<in>| \<Delta>" + "q |\<in>| finsert (r_rhs (map_ta_rule f g r)) (fset_of_list (r_lhs_states (map_ta_rule f g r)))" + by (auto simp: rule_states_def) + then have "q |\<in>| ?Rs" by (cases r) (force simp: fimage_iff)} + moreover + {fix q assume "q |\<in>| ?Rs" + then obtain r p where "r |\<in>| \<Delta>" "f p = q" + "p |\<in>| finsert (r_rhs r) (fset_of_list (r_lhs_states r))" + by (auto simp: rule_states_def) + then have "q |\<in>| ?Ls" by (cases r) (force simp: fimage_iff)} + ultimately show ?thesis by blast +qed + +lemma \<Q>_mono: + "(rules \<A>) |\<subseteq>| (rules \) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \) \<Longrightarrow> \<Q> \<A> |\<subseteq>| \<Q> \" + using rule_states_mono eps_states_mono unfolding \<Q>_def + by blast + +lemma \<Q>_subseteq_I: + assumes "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> r_rhs r |\<in>| S" + and "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> fset_of_list (r_lhs_states r) |\<subseteq>| S" + and "\<And> e. e |\<in>| eps \<A> \<Longrightarrow> fst e |\<in>| S \<and> snd e |\<in>| S" + shows "\<Q> \<A> |\<subseteq>| S" using assms unfolding \<Q>_def + by (auto simp: rule_states_def) blast + +lemma finite_states: + "finite {q. \<exists> f p ps. f ps \<rightarrow> p |\<in>| rules \<A> \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?set") +proof - + have "?set \<subseteq> fset (\<Q> \<A>)" + by (intro subsetI, drule CollectD) + (metis eps_trancl_statesD notin_fset rule_statesD(2)) + from finite_subset[OF this] show ?thesis by auto +qed + +text \<open>Collecting all states reachable from target of rules\<close> + +lemma finite_ta_rhs_states [simp]: + "finite {q. \<exists>p. p |\<in>| rule_target_states (rules \<A>) \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?Set") +proof - + have "?Set \<subseteq> fset (\<Q> \<A>)" + by (auto dest: rule_statesD) + (metis eps_trancl_statesD notin_fset rule_statesD(1))+ + from finite_subset[OF this] show ?thesis + by auto +qed + +text \<open>Computing the signature induced by the rule set of given tree automaton\<close> + + + +lemma ta_sigI [intro]: + "TA_rule f qs q |\<in>| (rules \<A>) \<Longrightarrow> length qs = n \<Longrightarrow> (f, n) |\<in>| ta_sig \<A>" unfolding ta_sig_def + using mk_disjoint_finsert by fastforce + +lemma ta_sig_mono: + "(rules \<A>) |\<subseteq>| (rules \) \<Longrightarrow> ta_sig \<A> |\<subseteq>| ta_sig \" + by (auto simp: ta_sig_def) + +lemma finite_eps: + "finite {q. \<exists> f ps p. f ps \<rightarrow> p |\<in>| rules \<A> \<and> (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)}" (is "finite ?S") + by (intro finite_subset[OF _ finite_ta_rhs_states[of \<A>]]) auto + +lemma collect_snd_trancl_fset: + "{p. (q, p) |\<in>| (eps \<A>)|\<^sup>+|} = fset (snd |`| (ffilter (\<lambda> x. fst x = q) ((eps \<A>)|\<^sup>+|)))" + by (auto simp: image_iff fmember.rep_eq) force + +lemma ta_der_Var: + "q |\<in>| ta_der \<A> (Var x) \<longleftrightarrow> x = q \<or> (x, q) |\<in>| (eps \<A>)|\<^sup>+|" + by (auto simp: collect_snd_trancl_fset) + +lemma ta_der_Fun: + "q |\<in>| ta_der \<A> (Fun f ts) \<longleftrightarrow> (\<exists> ps p. TA_rule f ps p |\<in>| (rules \<A>) \<and> + (p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|) \<and> length ps = length ts \<and> + (\<forall> i < length ts. ps ! i |\<in>| ta_der \<A> (ts ! i)))" (is "?Ls \<longleftrightarrow> ?Rs") + unfolding ta_der.simps + by (intro iffI fCollect_memberI finite_Collect_less_eq[OF _ finite_eps[of \<A>]]) auto + +declare ta_der.simps[simp del] +declare ta_der.simps[code del] +lemmas ta_der_simps [simp] = ta_der_Var ta_der_Fun + +lemma ta_der'_Var: + "Var q |\<in>| ta_der' \<A> (Var x) \<longleftrightarrow> x = q \<or> (x, q) |\<in>| (eps \<A>)|\<^sup>+|" + by (auto simp: collect_snd_trancl_fset) + +lemma ta_der'_Fun: + "Var q |\<in>| ta_der' \<A> (Fun f ts) \<longleftrightarrow> q |\<in>| ta_der \<A> (Fun f ts)" + unfolding ta_der'.simps + by (intro iffI funionI1 fCollect_memberI) + (auto simp del: ta_der_Fun ta_der_Var simp: fset_image_conv) + +lemma ta_der'_Fun2: + "Fun f ps |\<in>| ta_der' \<A> (Fun g ts) \<longleftrightarrow> f = g \<and> length ps = length ts \<and> (\<forall>i<length ts. ps ! i |\<in>| ta_der' \<A> (ts ! i))" +proof - + have f: "finite {ss. set ss \<subseteq> fset ( |\<Union>| (fset_of_list (map (ta_der' \<A>) ts))) \<and> length ss = length ts}" + by (intro finite_lists_length_eq) auto + have "finite {ss. length ss = length ts \<and> (\<forall>i<length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i))}" + by (intro finite_subset[OF _ f]) + (force simp: in_fset_conv_nth simp flip: fset_of_list_elem fmember.rep_eq) + then show ?thesis unfolding ta_der'.simps + by (intro iffI funionI2 fCollect_memberI) + (auto simp del: ta_der_Fun ta_der_Var) +qed + +declare ta_der'.simps[simp del] +declare ta_der'.simps[code del] +lemmas ta_der'_simps [simp] = ta_der'_Var ta_der'_Fun ta_der'_Fun2 + +text \<open>Induction schemes for the most used cases\<close> + +lemma ta_der_induct[consumes 1, case_names Var Fun]: + assumes reach: "q |\<in>| ta_der \<A> t" + and VarI: "\<And> q v. v = q \<or> (v, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> P (Var v) q" + and FunI: "\<And>f ts ps p q. f ps \<rightarrow> p |\<in>| rules \<A> \<Longrightarrow> length ts = length ps \<Longrightarrow> p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> + (\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (ts ! i)) \<Longrightarrow> + (\<And>i. i < length ts \<Longrightarrow> P (ts ! i) (ps ! i)) \<Longrightarrow> P (Fun f ts) q" + shows "P t q" using assms(1) + by (induct t arbitrary: q) (auto simp: VarI FunI) + +lemma ta_der_gterm_induct[consumes 1, case_names GFun]: + assumes reach: "q |\<in>| ta_der \<A> (term_of_gterm t)" + and Fun: "\<And>f ts ps p q. TA_rule f ps p |\<in>| rules \<A> \<Longrightarrow> length ts = length ps \<Longrightarrow> p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> + (\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (term_of_gterm (ts ! i))) \<Longrightarrow> + (\<And>i. i < length ts \<Longrightarrow> P (ts ! i) (ps ! i)) \<Longrightarrow> P (GFun f ts) q" + shows "P t q" using assms(1) + by (induct t arbitrary: q) (auto simp: Fun) + +lemma ta_der_rule_empty: + assumes "q |\<in>| ta_der (TA {||} \<Delta>\<^sub>\<epsilon>) t" + obtains p where "t = Var p" "p = q \<or> (p, q) |\<in>| \<Delta>\<^sub>\<epsilon>|\<^sup>+|" + using assms by (cases t) auto + +lemma ta_der_eps: + assumes "(p, q) |\<in>| (eps \<A>)" and "p |\<in>| ta_der \<A> t" + shows "q |\<in>| ta_der \<A> t" using assms + by (cases t) (auto intro: ftrancl_into_trancl) + +lemma ta_der_trancl_eps: + assumes "(p, q) |\<in>| (eps \<A>)|\<^sup>+|" and "p |\<in>| ta_der \<A> t" + shows "q |\<in>| ta_der \<A> t" using assms + by (induct rule: ftrancl_induct) (auto intro: ftrancl_into_trancl ta_der_eps) + +lemma ta_der_mono: + "(rules \<A>) |\<subseteq>| (rules \) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \) \<Longrightarrow> ta_der \<A> t |\<subseteq>| ta_der \ t" +proof (induct t) + case (Var x) then show ?case + by (auto dest: ftrancl_mono[of _ "eps \<A>" "eps \"]) +next + case (Fun f ts) + show ?case using Fun(1)[OF nth_mem Fun(2, 3)] + by (auto dest!: fsubsetD[OF Fun(2)] ftrancl_mono[OF _ Fun(3)]) blast+ +qed + +lemma ta_der_el_mono: + "(rules \<A>) |\<subseteq>| (rules \) \<Longrightarrow> (eps \<A>) |\<subseteq>| (eps \) \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| ta_der \ t" + using ta_der_mono by blast + +lemma ta_der'_ta_der: + assumes "t |\<in>| ta_der' \<A> s" "p |\<in>| ta_der \<A> t" + shows "p |\<in>| ta_der \<A> s" using assms +proof (induction arbitrary: p t rule: ta_der'.induct) + case (2 \<A> f ts) show ?case using 2(2-) + proof (induction t) + case (Var x) then show ?case + by auto (meson ftrancl_trans) + next + case (Fun g ss) + have ss_props: "g = f" "length ss = length ts" "\<forall>i < length ts. ss ! i |\<in>| ta_der' \<A> (ts ! i)" + using Fun(2) by auto + then show ?thesis using Fun(1)[OF nth_mem] Fun(2-) + by (auto simp: ss_props) + (metis (no_types, lifting) "2.IH" ss_props(3))+ + qed +qed (auto dest: ftrancl_trans simp: ta_der'.simps) + +lemma ta_der'_empty: + assumes "t |\<in>| ta_der' (TA {||} {||}) s" + shows "t = s" using assms + by (induct s arbitrary: t) (auto simp add: ta_der'.simps nth_equalityI) + +lemma ta_der'_to_ta_der: + "Var q |\<in>| ta_der' \<A> s \<Longrightarrow> q |\<in>| ta_der \<A> s" + using ta_der'_ta_der by fastforce + +lemma ta_der_to_ta_der': + "q |\<in>| ta_der \<A> s \<longleftrightarrow> Var q |\<in>| ta_der' \<A> s " + by (induct s arbitrary: q) auto + +lemma ta_der'_poss: + assumes "t |\<in>| ta_der' \<A> s" + shows "poss t \<subseteq> poss s" using assms +proof (induct s arbitrary: t) + case (Fun f ts) + show ?case using Fun(2) Fun(1)[OF nth_mem, of i "args t ! i" for i] + by (cases t) auto +qed (auto simp: ta_der'.simps) + +lemma ta_der'_refl[simp]: "t |\<in>| ta_der' \<A> t" + by (induction t) fastforce+ + +lemma ta_der'_eps: + assumes "Var p |\<in>| ta_der' \<A> s" and "(p, q) |\<in>| (eps \<A>)|\<^sup>+|" + shows "Var q |\<in>| ta_der' \<A> s" using assms + by (cases s, auto dest: ftrancl_trans) (meson ftrancl_trans) + +lemma ta_der'_trans: + assumes "t |\<in>| ta_der' \<A> s" and "u |\<in>| ta_der' \<A> t" + shows "u |\<in>| ta_der' \<A> s" using assms +proof (induct t arbitrary: u s) + case (Fun f ts) note IS = Fun(2-) note IH = Fun(1)[OF nth_mem, of i "args s ! i" for i] + show ?case + proof (cases s) + case (Var x1) + then show ?thesis using IS by (auto simp: ta_der'.simps) + next + case [simp]: (Fun g ss) + show ?thesis using IS IH + by (cases u, auto) (metis ta_der_to_ta_der')+ + qed +qed (auto simp: ta_der'.simps ta_der'_eps) + +text \<open>Connecting contexts to derivation definition\<close> + +lemma ta_der_ctxt: + assumes p: "p |\<in>| ta_der \<A> t" "q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" + shows "q |\<in>| ta_der \<A> C\<langle>t\<rangle>" using assms(2) +proof (induct C arbitrary: q) + case Hole then show ?case using assms + by (auto simp: ta_der_trancl_eps) +next + case (More f ss C ts) + from More(2) obtain qs r where + rule: "f qs \<rightarrow> r |\<in>| rules \<A>" "length qs = Suc (length ss + length ts)" and + reach: "\<forall> i < Suc (length ss + length ts). qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>Var p\<rangle> # ts) ! i)" "r = q \<or> (r, q) |\<in>| (eps \<A>)|\<^sup>+|" + by auto + have "i < Suc (length ss + length ts) \<Longrightarrow> qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>t\<rangle> # ts) ! i)" for i + using More(1)[of "qs ! length ss"] assms rule(2) reach(1) + unfolding nth_append_Cons by presburger + then show ?case using rule reach(2) by auto +qed + +lemma ta_der_eps_ctxt: + assumes "p |\<in>| ta_der A C\<langle>Var q'\<rangle>" and "(q, q') |\<in>| (eps A)|\<^sup>+|" + shows "p |\<in>| ta_der A C\<langle>Var q\<rangle>" + using assms by (meson ta_der_Var ta_der_ctxt) + +lemma rule_reachable_ctxt_exist: + assumes rule: "f qs \<rightarrow> q |\<in>| rules \<A>" and "i < length qs" + shows "\<exists> C. q |\<in>| ta_der \<A> (C \<langle>Var (qs ! i)\<rangle>)" using assms + by (intro exI[of _ "More f (map Var (take i qs)) \<box> (map Var (drop (Suc i) qs))"]) + (auto simp: min_def nth_append_Cons intro!: exI[of _ q] exI[of _ qs]) + +lemma ta_der_ctxt_decompose: + assumes "q |\<in>| ta_der \<A> C\<langle>t\<rangle>" + shows "\<exists> p . p |\<in>| ta_der \<A> t \<and> q |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" using assms +proof (induct C arbitrary: q) + case (More f ss C ts) + from More(2) obtain qs r where + rule: "f qs \<rightarrow> r |\<in>| rules \<A>" "length qs = Suc (length ss + length ts)" and + reach: "\<forall> i < Suc (length ss + length ts). qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>t\<rangle> # ts) ! i)" + "r = q \<or> (r, q) |\<in>| (eps \<A>)|\<^sup>+|" + by auto + obtain p where p: "p |\<in>| ta_der \<A> t" "qs ! length ss |\<in>| ta_der \<A> C\<langle>Var p\<rangle>" + using More(1)[of "qs ! length ss"] reach(1) rule(2) + by (metis less_add_Suc1 nth_append_length) + have "i < Suc (length ss + length ts) \<Longrightarrow> qs ! i |\<in>| ta_der \<A> ((ss @ C\<langle>Var p\<rangle> # ts) ! i)" for i + using reach rule(2) p by (auto simp: p(2) nth_append_Cons) + then have "q |\<in>| ta_der \<A> (More f ss C ts)\<langle>Var p\<rangle>" using rule reach + by auto + then show ?case using p(1) by (intro exI[of _ p]) blast +qed auto + +\<comment> \<open>Relation between reachable states and states of a tree automaton\<close> + +lemma ta_der_states: + "ta_der \<A> t |\<subseteq>| \<Q> \<A> |\<union>| fvars_term t" +proof (induct t) + case (Var x) then show ?case + by (auto simp: eq_onp_same_args fmember.abs_eq) + (metis eps_trancl_statesD) + case (Fun f ts) then show ?case + by (auto simp: rule_statesD(2) eps_trancl_statesD) +qed + +lemma ground_ta_der_states: + "ground t \<Longrightarrow> ta_der \<A> t |\<subseteq>| \<Q> \<A>" + using ta_der_states[of \<A> t] by auto + +lemmas ground_ta_der_statesD = fsubsetD[OF ground_ta_der_states] + +lemma gterm_ta_der_states [simp]: + "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> q |\<in>| \<Q> \<A>" + by (intro ground_ta_der_states[THEN fsubsetD, of "term_of_gterm t"]) simp + +lemma ta_der_states': + "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| \<Q> \<A> \<Longrightarrow> fvars_term t |\<subseteq>| \<Q> \<A>" +proof (induct rule: ta_der_induct) + case (Fun f ts ps p r) + then have "i < length ts \<Longrightarrow> fvars_term (ts ! i) |\<subseteq>| \<Q> \<A>" for i + by (auto simp: in_fset_conv_nth dest!: rule_statesD(3)) + then show ?case by (force simp: in_fset_conv_nth) +qed (auto simp: eps_trancl_statesD) + +lemma ta_der_not_stateD: + "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<notin>| \<Q> \<A> \<Longrightarrow> t = Var q" + using fsubsetD[OF ta_der_states, of q \<A> t] + by (cases t) (auto dest: rule_statesD eps_trancl_statesD) + +lemma ta_der_is_fun_stateD: + "is_Fun t \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| \<Q> \<A>" + using ta_der_not_stateD[of q \<A> t] + by (cases t) auto + +lemma ta_der_is_fun_fvars_stateD: + "is_Fun t \<Longrightarrow> q |\<in>| ta_der \<A> t \<Longrightarrow> fvars_term t |\<subseteq>| \<Q> \<A>" + using ta_der_is_fun_stateD[of t q \<A>] + using ta_der_states'[of q \<A> t] + by (cases t) auto + +lemma ta_der_not_reach: + assumes "\<And> r. r |\<in>| rules \<A> \<Longrightarrow> r_rhs r \<noteq> q" + and "\<And> e. e |\<in>| eps \<A> \<Longrightarrow> snd e \<noteq> q" + shows "q |\<notin>| ta_der \<A> (term_of_gterm t)" using assms + by (cases t) (fastforce dest!: assms(1) ftranclD2[of _ q]) + + +lemma ta_rhs_states_subset_states: "ta_rhs_states \<A> |\<subseteq>| \<Q> \<A>" + by (auto simp: ta_rhs_states_def dest: rtranclD rule_statesD eps_trancl_statesD) + +(* a resulting state is always some rhs of a rule (or epsilon transition) *) +lemma ta_rhs_states_res: assumes "is_Fun t" + shows "ta_der \<A> t |\<subseteq>| ta_rhs_states \<A>" +proof + fix q assume q: "q |\<in>| ta_der \<A> t" + from \<open>is_Fun t\<close> obtain f ts where t: "t = Fun f ts" by (cases t, auto) + from q[unfolded t] obtain q' qs where "TA_rule f qs q' |\<in>| rules \<A>" + and q: "q' = q \<or> (q', q) |\<in>| (eps \<A>)|\<^sup>+|" by auto + then show "q |\<in>| ta_rhs_states \<A>" unfolding ta_rhs_states_def + by auto +qed + +text \<open>Reachable states of ground terms are preserved over the @{const adapt_vars} function\<close> + +lemma ta_der_adapt_vars_ground [simp]: + "ground t \<Longrightarrow> ta_der A (adapt_vars t) = ta_der A t" + by (induct t) auto + +lemma gterm_of_term_inv': + "ground t \<Longrightarrow> term_of_gterm (gterm_of_term t) = adapt_vars t" + by (induct t) (auto 0 0 intro!: nth_equalityI) + +lemma map_vars_term_term_of_gterm: + "map_vars_term f (term_of_gterm t) = term_of_gterm t" + by (induct t) auto + +lemma adapt_vars_term_of_gterm: + "adapt_vars (term_of_gterm t) = term_of_gterm t" + by (induct t) auto + +(* a term can be reduced to a state, only if all symbols appear in the automaton *) +lemma ta_der_term_sig: + "q |\<in>| ta_der \<A> t \<Longrightarrow> ffunas_term t |\<subseteq>| ta_sig \<A>" +proof (induct rule: ta_der_induct) + case (Fun f ts ps p q) + show ?case using Fun(1 - 4) Fun(5)[THEN fsubsetD] + by (auto simp: in_fset_conv_nth) +qed auto + +lemma ta_der_gterm_sig: + "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> ffunas_gterm t |\<subseteq>| ta_sig \<A>" + using ta_der_term_sig ffunas_term_of_gterm_conv + by fastforce + +text \<open>@{const ta_lang} for terms with arbitrary variable type\<close> + +lemma ta_langE: assumes "t \<in> ta_lang Q \<A>" + obtains t' q where "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'" + using assms unfolding ta_lang_def by blast + +lemma ta_langI: assumes "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'" + shows "t \<in> ta_lang Q \<A>" + using assms unfolding ta_lang_def by blast + +lemma ta_lang_def2: "(ta_lang Q (\<A> :: ('q,'f)ta) :: ('f,'v)terms) = {t. ground t \<and> Q |\<inter>| ta_der \<A> (adapt_vars t) \<noteq> {||}}" + by (auto elim!: ta_langE) (metis adapt_vars_adapt_vars ground_adapt_vars ta_langI) + +text \<open>@{const ta_lang} for @{const gterms}\<close> + +lemma ta_lang_to_gta_lang [simp]: + "ta_lang Q \<A> = term_of_gterm ` gta_lang Q \<A>" (is "?Ls = ?Rs") +proof - + {fix t assume "t \<in> ?Ls" + from ta_langE[OF this] obtain q t' where "ground t'" "q |\<in>| Q" "q |\<in>| ta_der \<A> t'" "t = adapt_vars t'" + by blast + then have "t \<in> ?Rs" unfolding gta_lang_def gta_der_def + by (auto simp: image_iff gterm_of_term_inv' intro!: exI[of _ "gterm_of_term t'"])} + moreover + {fix t assume "t \<in> ?Rs" then have "t \<in> ?Ls" + using ta_langI[OF ground_term_of_gterm _ _ gterm_of_term_inv'[OF ground_term_of_gterm]] + by (force simp: gta_lang_def gta_der_def)} + ultimately show ?thesis by blast +qed + +lemma term_of_gterm_in_ta_lang_conv: + "term_of_gterm t \<in> ta_lang Q \<A> \<longleftrightarrow> t \<in> gta_lang Q \<A>" + by (metis (mono_tags, lifting) image_iff ta_lang_to_gta_lang term_of_gterm_inv) + +lemma gta_lang_def_sym: + "gterm_of_term ` ta_lang Q \<A> = gta_lang Q \<A>" + (* this is nontrivial because the lhs has a more general type than the rhs of gta_lang_def *) + unfolding gta_lang_def image_def + by (intro Collect_cong) (simp add: gta_lang_def) + +lemma gta_langI [intro]: + assumes "q |\<in>| Q" and "q |\<in>| ta_der \<A> (term_of_gterm t)" + shows "t \<in> gta_lang Q \<A>" using assms + by (metis adapt_vars_term_of_gterm ground_term_of_gterm ta_langI term_of_gterm_in_ta_lang_conv) + +lemma gta_langE [elim]: + assumes "t \<in> gta_lang Q \<A>" + obtains q where "q |\<in>| Q" and "q |\<in>| ta_der \<A> (term_of_gterm t)" using assms + by (metis adapt_vars_adapt_vars adapt_vars_term_of_gterm ta_langE term_of_gterm_in_ta_lang_conv) + +lemma gta_lang_mono: + assumes "\<And> t. ta_der \<A> t |\<subseteq>| ta_der \<BB> t" and "Q\<^sub>\<A> |\<subseteq>| Q\<^sub>\<BB>" + shows "gta_lang Q\<^sub>\<A> \<A> \<subseteq> gta_lang Q\<^sub>\<BB> \<BB>" + using assms by (auto elim!: gta_langE intro!: gta_langI) + +lemma gta_lang_term_of_gterm [simp]: + "term_of_gterm t \<in> term_of_gterm ` gta_lang Q \<A> \<longleftrightarrow> t \<in> gta_lang Q \<A>" + by (auto elim!: gta_langE intro!: gta_langI) (metis term_of_gterm_inv) + +(* terms can be accepted, only if all their symbols appear in the automaton *) +lemma gta_lang_subset_rules_funas: + "gta_lang Q \<A> \<subseteq> \<T>\<^sub>G (fset (ta_sig \<A>))" + using ta_der_gterm_sig[THEN fsubsetD] + by (force simp: \<T>\<^sub>G_equivalent_def simp flip: fmember.rep_eq ffunas_gterm.rep_eq) + +lemma reg_funas: + "\<L> \<A> \<subseteq> \<T>\<^sub>G (fset (ta_sig (ta \<A>)))" using gta_lang_subset_rules_funas + by (auto simp: \<L>_def) + +lemma ta_syms_lang: "t \<in> ta_lang Q \<A> \<Longrightarrow> ffunas_term t |\<subseteq>| ta_sig \<A>" + using gta_lang_subset_rules_funas ffunas_gterm_gterm_of_term ta_der_gterm_sig ta_lang_def2 + by fastforce + +lemma gta_lang_Rest_states_conv: + "gta_lang Q \<A> = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>" + by (auto elim!: gta_langE) + +lemma reg_Rest_fin_states [simp]: + "\<L> (reg_Restr_Q\<^sub>f \<A>) = \<L> \<A>" + using gta_lang_Rest_states_conv + by (auto simp: \<L>_def reg_Restr_Q\<^sub>f_def) + +text \<open>Deterministic tree automatons\<close> + +definition ta_det :: "('q,'f) ta \<Rightarrow> bool" where + "ta_det \<A> \<longleftrightarrow> eps \<A> = {||} \<and> + (\<forall> f qs q q'. TA_rule f qs q |\<in>| rules \<A> \<longrightarrow> TA_rule f qs q' |\<in>| rules \<A> \<longrightarrow> q = q')" + +definition "ta_subset \<A> \ \<longleftrightarrow> rules \<A> |\<subseteq>| rules \ \<and> eps \<A> |\<subseteq>| eps \" + +(* determinism implies unique results *) +lemma ta_detE[elim, consumes 1]: assumes det: "ta_det \<A>" + shows "q |\<in>| ta_der \<A> t \<Longrightarrow> q' |\<in>| ta_der \<A> t \<Longrightarrow> q = q'" using assms + by (induct t arbitrary: q q') (auto simp: ta_det_def, metis nth_equalityI nth_mem) + + +lemma ta_subset_states: "ta_subset \<A> \ \<Longrightarrow> \<Q> \<A> |\<subseteq>| \<Q> \" + using \<Q>_mono by (auto simp: ta_subset_def) + +lemma ta_subset_refl[simp]: "ta_subset \<A> \<A>" + unfolding ta_subset_def by auto + +lemma ta_subset_trans: "ta_subset \<A> \ \<Longrightarrow> ta_subset \ \<CC> \<Longrightarrow> ta_subset \<A> \<CC>" + unfolding ta_subset_def by auto + +lemma ta_subset_det: "ta_subset \<A> \ \<Longrightarrow> ta_det \ \<Longrightarrow> ta_det \<A>" + unfolding ta_det_def ta_subset_def by blast + +lemma ta_der_mono': "ta_subset \<A> \ \<Longrightarrow> ta_der \<A> t |\<subseteq>| ta_der \ t" + using ta_der_mono unfolding ta_subset_def by auto + +lemma ta_lang_mono': "ta_subset \<A> \ \<Longrightarrow> Q\<^sub>\<A> |\<subseteq>| Q\<^sub>\ \<Longrightarrow> ta_lang Q\<^sub>\<A> \<A> \<subseteq> ta_lang Q\<^sub>\ \" + using gta_lang_mono[of \<A> \] ta_der_mono'[of \<A> \] + by auto blast + +(* the restriction of an automaton to a given set of states *) +lemma ta_restrict_subset: "ta_subset (ta_restrict \<A> Q) \<A>" + unfolding ta_subset_def ta_restrict_def + by auto + +lemma ta_restrict_states_Q: "\<Q> (ta_restrict \<A> Q) |\<subseteq>| Q" + by (auto simp: \<Q>_def ta_restrict_def rule_states_def eps_states_def dest!: fsubsetD) + +lemma ta_restrict_states: "\<Q> (ta_restrict \<A> Q) |\<subseteq>| \<Q> \<A>" + using ta_subset_states[OF ta_restrict_subset] by fastforce + +lemma ta_restrict_states_eq_imp_eq [simp]: + assumes eq: "\<Q> (ta_restrict \<A> Q) = \<Q> \<A>" + shows "ta_restrict \<A> Q = \<A>" using assms + apply (auto simp: ta_restrict_def + intro!: ta.expand finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>]) + apply (metis (no_types, lifting) eq fsubsetD fsubsetI rule_statesD(1) rule_statesD(4) ta_restrict_states_Q ta_rule.collapse) + apply (metis eps_statesD eq fin_mono ta_restrict_states_Q) + by (metis eps_statesD eq fsubsetD ta_restrict_states_Q) + +lemma ta_der_ta_derict_states: + "fvars_term t |\<subseteq>| Q \<Longrightarrow> q |\<in>| ta_der (ta_restrict \<A> Q) t \<Longrightarrow> q |\<in>| Q" + by (induct t arbitrary: q) (auto simp: ta_restrict_def elim: ftranclE) + +lemma ta_derict_ruleI [intro]: + "TA_rule f qs q |\<in>| rules \<A> \<Longrightarrow> fset_of_list qs |\<subseteq>| Q \<Longrightarrow> q |\<in>| Q \<Longrightarrow> TA_rule f qs q |\<in>| rules (ta_restrict \<A> Q)" + by (auto simp: ta_restrict_def intro!: ta.expand finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>]) + +text \<open>Reachable and productive states: There always is a trim automaton\<close> + +lemma finite_ta_reachable [simp]: + "finite {q. \<exists>t. ground t \<and> q |\<in>| ta_der \<A> t}" +proof - + have "{q. \<exists>t. ground t \<and> q |\<in>| ta_der \<A> t} \<subseteq> fset (\<Q> \<A>)" + using ground_ta_der_states[of _ \<A>] + by auto (metis fsubsetD notin_fset) + from finite_subset[OF this] show ?thesis by auto +qed + +lemma ta_reachable_states: + "ta_reachable \<A> |\<subseteq>| \<Q> \<A>" + unfolding ta_reachable_def using ground_ta_der_states + by force + +lemma ta_reachableE: + assumes "q |\<in>| ta_reachable \<A>" + obtains t where "ground t" "q |\<in>| ta_der \<A> t" + using assms[unfolded ta_reachable_def] by auto + +lemma ta_reachable_gtermE [elim]: + assumes "q |\<in>| ta_reachable \<A>" + obtains t where "q |\<in>| ta_der \<A> (term_of_gterm t)" + using ta_reachableE[OF assms] + by (metis ground_term_to_gtermD) + +lemma ta_reachableI [intro]: + assumes "ground t" and "q |\<in>| ta_der \<A> t" + shows "q |\<in>| ta_reachable \<A>" + using assms finite_ta_reachable + by (auto simp: ta_reachable_def) + +lemma ta_reachable_gtermI [intro]: + "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> q |\<in>| ta_reachable \<A>" + by (intro ta_reachableI[of "term_of_gterm t"]) simp + +lemma ta_reachableI_rule: + assumes sub: "fset_of_list qs |\<subseteq>| ta_reachable \<A>" + and rule: "TA_rule f qs q |\<in>| rules \<A>" + shows "q |\<in>| ta_reachable \<A>" + "\<exists> ts. length qs = length ts \<and> (\<forall> i < length ts. ground (ts ! i)) \<and> + (\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i))" (is "?G") +proof - + { + fix i + assume i: "i < length qs" + then have "qs ! i |\<in>| fset_of_list qs" by auto + with sub have "qs ! i |\<in>| ta_reachable \<A>" by auto + from ta_reachableE[OF this] have "\<exists> t. ground t \<and> qs ! i |\<in>| ta_der \<A> t" by auto + } + then have "\<forall> i. \<exists> t. i < length qs \<longrightarrow> ground t \<and> qs ! i |\<in>| ta_der \<A> t" by auto + from choice[OF this] obtain ts where ts: "\<And> i. i < length qs \<Longrightarrow> ground (ts i) \<and> qs ! i |\<in>| ta_der \<A> (ts i)" by blast + let ?t = "Fun f (map ts [0 ..< length qs])" + have gt: "ground ?t" using ts by auto + have r: "q |\<in>| ta_der \<A> ?t" unfolding ta_der_Fun using rule ts + by (intro exI[of _ qs] exI[of _ q]) simp + with gt show "q |\<in>| ta_reachable \<A>" by blast + from gt ts show ?G by (intro exI[of _ "map ts [0..<length qs]"]) simp +qed + +lemma ta_reachable_rule_gtermE: + assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" + and "TA_rule f qs q |\<in>| rules \<A>" + obtains t where "groot t = (f, length qs)" "q |\<in>| ta_der \<A> (term_of_gterm t)" +proof - + assume *: "\<And>t. groot t = (f, length qs) \<Longrightarrow> q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> thesis" + from assms have "fset_of_list qs |\<subseteq>| ta_reachable \<A>" + by (auto dest: rule_statesD(3)) + from ta_reachableI_rule[OF this assms(2)] obtain ts where args: "length qs = length ts" + "\<forall> i < length ts. ground (ts ! i)" "\<forall> i < length ts. qs ! i |\<in>| ta_der \<A> (ts ! i)" + using assms by force + then show ?thesis using assms(2) + by (intro *[of "GFun f (map gterm_of_term ts)"]) auto +qed + +lemma ta_reachableI_eps': + assumes reach: "q |\<in>| ta_reachable \<A>" + and eps: "(q, q') |\<in>| (eps \<A>)|\<^sup>+|" + shows "q' |\<in>| ta_reachable \<A>" +proof - + from ta_reachableE[OF reach] obtain t where g: "ground t" and res: "q |\<in>| ta_der \<A> t" by auto + from ta_der_trancl_eps[OF eps res] g show ?thesis by blast +qed + +lemma ta_reachableI_eps: + assumes reach: "q |\<in>| ta_reachable \<A>" + and eps: "(q, q') |\<in>| eps \<A>" + shows "q' |\<in>| ta_reachable \<A>" + by (rule ta_reachableI_eps'[OF reach], insert eps, auto) + +\<comment> \<open>Automata are productive on a set P if all states can reach a state in P\<close> + + +lemma finite_ta_productive: + "finite {p. \<exists>q q' C. p = q \<and> q' |\<in>| ta_der \<A> C\<langle>Var q\<rangle> \<and> q' |\<in>| P}" +proof - + {fix x q C assume ass: "x \<notin> fset P" "q |\<in>| P" "q |\<in>| ta_der \<A> C\<langle>Var x\<rangle>" + then have "x \<in> fset (\<Q> \<A>)" + proof (cases "is_Fun C\<langle>Var x\<rangle>") + case True + then show ?thesis using ta_der_is_fun_fvars_stateD[OF _ ass(3)] + by auto (metis notin_fset) + next + case False + then show ?thesis using ass + by (cases C, auto, (metis eps_trancl_statesD notin_fset)+) + qed} + then have "{q | q q' C. q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| P} \<subseteq> fset (\<Q> \<A>) \<union> fset P" by auto + from finite_subset[OF this] show ?thesis by auto +qed + +lemma ta_productiveE: assumes "q |\<in>| ta_productive P \<A>" + obtains q' C where "q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>)" "q' |\<in>| P" + using assms[unfolded ta_productive_def] by auto + +lemma ta_productiveI: + assumes "q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>)" "q' |\<in>| P" + shows "q |\<in>| ta_productive P \<A>" + using assms unfolding ta_productive_def + using finite_ta_productive + by auto + +lemma ta_productiveI': + assumes "q |\<in>| ta_der \<A> (C\<langle>Var p\<rangle>)" "q |\<in>| ta_productive P \<A>" + shows "p |\<in>| ta_productive P \<A>" + using assms unfolding ta_productive_def + by auto (metis (mono_tags, lifting) ctxt_ctxt_compose ta_der_ctxt) + +lemma ta_productive_setI: + "q |\<in>| P \<Longrightarrow> q |\<in>| ta_productive P \<A>" + using ta_productiveI[of q \<A> \<box> q] + by simp + + +lemma ta_reachable_empty_rules [simp]: + "rules \<A> = {||} \<Longrightarrow> ta_reachable \<A> = {||}" + by (auto simp: ta_reachable_def) + (metis ground.simps(1) ta.exhaust_sel ta_der_rule_empty) + +lemma ta_reachable_mono: + "ta_subset \<A> \ \<Longrightarrow> ta_reachable \<A> |\<subseteq>| ta_reachable \" using ta_der_mono' + by (auto simp: ta_reachable_def) blast + +lemma ta_reachabe_rhs_states: + "ta_reachable \<A> |\<subseteq>| ta_rhs_states \<A>" +proof - + {fix q assume "q |\<in>| ta_reachable \<A>" + then obtain t where "ground t" "q |\<in>| ta_der \<A> t" + by (auto simp: ta_reachable_def) + then have "q |\<in>| ta_rhs_states \<A>" + by (cases t) (auto simp: ta_rhs_states_def)} + then show ?thesis by blast +qed + +lemma ta_reachable_eps: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> p |\<in>| ta_reachable \<A> \<Longrightarrow> (p, q) |\<in>| (fRestr (eps \<A>) (ta_reachable \<A>))|\<^sup>+|" +proof (induct rule: ftrancl_induct) + case (Base a b) + then show ?case + by (metis fSigmaI finterI fr_into_trancl ta_reachableI_eps) +next + case (Step p q r) + then have "q |\<in>| ta_reachable \<A>" "r |\<in>| ta_reachable \<A>" + by (metis ta_reachableI_eps ta_reachableI_eps')+ + then show ?case using Step + by (metis fSigmaI finterI ftrancl_into_trancl) +qed + +(* major lemma to show that one can restrict to reachable states *) +lemma ta_der_only_reach: + assumes "fvars_term t |\<subseteq>| ta_reachable \<A>" + shows "ta_der \<A> t = ta_der (ta_only_reach \<A>) t" (is "?LS = ?RS") +proof - + have "?RS |\<subseteq>| ?LS" using ta_der_mono'[OF ta_restrict_subset] + by fastforce + moreover + {fix q assume "q |\<in>| ?LS" + then have "q |\<in>| ?RS" using assms + proof (induct rule: ta_der_induct) + case (Fun f ts ps p q) + from Fun(2, 6) have ta_reach [simp]: "i < length ps \<Longrightarrow> fvars_term (ts ! i) |\<subseteq>| ta_reachable \<A>" for i + by auto (metis ffUnionI fimage_fset fnth_mem funionI2 length_map nth_map sup.orderE) + from Fun have r: "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der (ta_only_reach \<A>) (ts ! i)" + "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_reachable \<A>" for i + by (auto) (metis ta_reach ta_der_ta_derict_states)+ + then have "f ps \<rightarrow> p |\<in>| rules (ta_only_reach \<A>)" + using Fun(1, 2) + by (intro ta_derict_ruleI) + (fastforce simp: in_fset_conv_nth intro!: ta_reachableI_rule[OF _ Fun(1)])+ + then show ?case using ta_reachable_eps[of p q] ta_reachableI_rule[OF _ Fun(1)] r Fun(2, 3) + by (auto simp: ta_restrict_def intro!: exI[of _ p] exI[of _ ps]) + qed (auto simp: ta_restrict_def intro: ta_reachable_eps)} + ultimately show ?thesis by blast +qed + +lemma ta_der_gterm_only_reach: + "ta_der \<A> (term_of_gterm t) = ta_der (ta_only_reach \<A>) (term_of_gterm t)" + using ta_der_only_reach[of "term_of_gterm t" \<A>] + by simp + +lemma ta_reachable_ta_only_reach [simp]: + "ta_reachable (ta_only_reach \<A>) = ta_reachable \<A>" (is "?LS = ?RS") +proof - + have "?LS |\<subseteq>| ?RS" using ta_der_mono'[OF ta_restrict_subset] + by (auto simp: ta_reachable_def) fastforce + moreover + {fix t assume "ground (t :: ('b, 'a) term)" + then have "ta_der \<A> t = ta_der (ta_only_reach \<A>) t" using ta_der_only_reach[of t \<A>] + by simp} + ultimately show ?thesis unfolding ta_reachable_def + by auto +qed + +lemma ta_only_reach_reachable: + "\<Q> (ta_only_reach \<A>) |\<subseteq>| ta_reachable (ta_only_reach \<A>)" + using ta_restrict_states_Q[of \<A> "ta_reachable \<A>"] + by auto + +(* It is sound to restrict to reachable states. *) +lemma gta_only_reach_lang: + "gta_lang Q (ta_only_reach \<A>) = gta_lang Q \<A>" + using ta_der_gterm_only_reach + by (auto elim!: gta_langE intro!: gta_langI) force+ + + +lemma \<L>_only_reach: "\<L> (reg_reach R) = \<L> R" + using gta_only_reach_lang + by (auto simp: \<L>_def reg_reach_def) + +lemma ta_only_reach_lang: + "ta_lang Q (ta_only_reach \<A>) = ta_lang Q \<A>" + using gta_only_reach_lang + by (metis ta_lang_to_gta_lang) + + +lemma ta_prod_epsD: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> p |\<in>| ta_productive P \<A>" + using ta_der_ctxt[of q \<A> "\<box>\<langle>Var p\<rangle>"] + by (auto simp: ta_productive_def ta_der_trancl_eps) + +lemma ta_only_prod_eps: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> (p, q) |\<in>| (eps (ta_only_prod P \<A>))|\<^sup>+|" +proof (induct rule: ftrancl_induct) + case (Base p q) + then show ?case + by (metis (no_types, lifting) fSigmaI finterI fr_into_trancl ta.sel(2) ta_prod_epsD ta_restrict_def) +next + case (Step p q r) note IS = this + show ?case using IS(2 - 4) ta_prod_epsD[OF fr_into_trancl[OF IS(3)] IS(4)] + by (auto simp: ta_restrict_def) (simp add: ftrancl_into_trancl) +qed + +(* Major lemma to show that it is sound to restrict to productive states. *) +lemma ta_der_only_prod: + "q |\<in>| ta_der \<A> t \<Longrightarrow> q |\<in>| ta_productive P \<A> \<Longrightarrow> q |\<in>| ta_der (ta_only_prod P \<A>) t" +proof (induct rule: ta_der_induct) + case (Fun f ts ps p q) + let ?\<A> = "ta_only_prod P \<A>" + have pr: "p |\<in>| ta_productive P \<A>" "i < length ts \<Longrightarrow> ps ! i |\<in>| ta_productive P \<A>" for i + using Fun(2) ta_prod_epsD[of p q] Fun(3, 6) rule_reachable_ctxt_exist[OF Fun(1)] + using ta_productiveI'[of p \<A> _ "ps ! i" P] + by auto + then have "f ps \<rightarrow> p |\<in>| rules ?\<A>" using Fun(1, 2) unfolding ta_restrict_def + by (auto simp: in_fset_conv_nth intro: finite_subset[OF _ finite_Collect_ta_rule, of _ \<A>]) + then show ?case using pr Fun ta_only_prod_eps[of p q \<A> P] Fun(3, 6) + by auto +qed (auto intro: ta_only_prod_eps) + +lemma ta_der_ta_only_prod_ta_der: + "q |\<in>| ta_der (ta_only_prod P \<A>) t \<Longrightarrow> q |\<in>| ta_der \<A> t" + by (meson ta_der_el_mono ta_restrict_subset ta_subset_def) + + +(* It is sound to restrict to productive states. *) +lemma gta_only_prod_lang: + "gta_lang Q (ta_only_prod Q \<A>) = gta_lang Q \<A>" (is "gta_lang Q ?\<A> = _") +proof + show "gta_lang Q ?\<A> \<subseteq> gta_lang Q \<A>" + using gta_lang_mono[OF ta_der_mono'[OF ta_restrict_subset]] + by blast +next + {fix t assume "t \<in> gta_lang Q \<A>" + from gta_langE[OF this] obtain q where + reach: "q |\<in>| ta_der \<A> (term_of_gterm t)" "q |\<in>| Q" . + from ta_der_only_prod[OF reach(1) ta_productive_setI[OF reach(2)]] reach(2) + have "t \<in> gta_lang Q ?\<A>" by (auto intro: gta_langI)} + then show "gta_lang Q \<A> \<subseteq> gta_lang Q ?\<A>" by blast +qed + +lemma \<L>_only_prod: "\<L> (reg_prod R) = \<L> R" + using gta_only_prod_lang + by (auto simp: \<L>_def reg_prod_def) + +lemma ta_only_prod_lang: + "ta_lang Q (ta_only_prod Q \<A>) = ta_lang Q \<A>" + using gta_only_prod_lang + by (metis ta_lang_to_gta_lang) + +(* the productive states are also productive w.r.t. the new automaton *) +lemma ta_prodictive_ta_only_prod [simp]: + "ta_productive P (ta_only_prod P \<A>) = ta_productive P \<A>" (is "?LS = ?RS") +proof - + have "?LS |\<subseteq>| ?RS" using ta_der_mono'[OF ta_restrict_subset] + using finite_ta_productive[of \<A> P] + by (auto simp: ta_productive_def) fastforce + moreover have "?RS |\<subseteq>| ?LS" using ta_der_only_prod + by (auto elim!: ta_productiveE) + (smt (z3) ta_der_only_prod ta_productiveI ta_productive_setI) + ultimately show ?thesis by blast +qed + +lemma ta_only_prod_productive: + "\<Q> (ta_only_prod P \<A>) |\<subseteq>| ta_productive P (ta_only_prod P \<A>)" + using ta_restrict_states_Q by force + +lemma ta_only_prod_reachable: + assumes all_reach: "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" + shows "\<Q> (ta_only_prod P \<A>) |\<subseteq>| ta_reachable (ta_only_prod P \<A>)" (is "?Ls |\<subseteq>| ?Rs") +proof - + {fix q assume "q |\<in>| ?Ls" + then obtain t where "ground t" "q |\<in>| ta_der \<A> t" "q |\<in>| ta_productive P \<A>" + using fsubsetD[OF ta_only_prod_productive[of \<A> P]] + using fsubsetD[OF fsubset_trans[OF ta_restrict_states all_reach, of "ta_productive P \<A>"]] + by (auto elim!: ta_reachableE) + then have "q |\<in>| ?Rs" + by (intro ta_reachableI[where ?\<A> = "ta_only_prod P \<A>" and ?t = t]) (auto simp: ta_der_only_prod)} + then show ?thesis by blast +qed + +lemma ta_prod_reach_subset: + "ta_subset (ta_only_prod P (ta_only_reach \<A>)) \<A>" + by (rule ta_subset_trans, (rule ta_restrict_subset)+) + +lemma ta_prod_reach_states: + "\<Q> (ta_only_prod P (ta_only_reach \<A>)) |\<subseteq>| \<Q> \<A>" + by (rule ta_subset_states[OF ta_prod_reach_subset]) + +(* If all states are reachable then there exists a ground context for all productive states *) +lemma ta_productive_aux: + assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" "q |\<in>| ta_der \<A> (C\<langle>t\<rangle>)" + shows "\<exists>C'. ground_ctxt C' \<and> q |\<in>| ta_der \<A> (C'\<langle>t\<rangle>)" using assms(2) +proof (induct C arbitrary: q) + case Hole then show ?case by (intro exI[of _ "\<box>"]) auto +next + case (More f ts1 C ts2) + from More(2) obtain qs q' where q': "f qs \<rightarrow> q' |\<in>| rules \<A>" "q' = q \<or> (q', q) |\<in>| (eps \<A>)|\<^sup>+|" + "qs ! length ts1 |\<in>| ta_der \<A> (C\<langle>t\<rangle>)" "length qs = Suc (length ts1 + length ts2)" + by simp (metis less_add_Suc1 nth_append_length) + { fix i assume "i < length qs" + then have "qs ! i |\<in>| \<Q> \<A>" using q'(1) + by (auto dest!: rule_statesD(4)) + then have "\<exists>t. ground t \<and> qs ! i |\<in>| ta_der \<A> t" using assms(1) + by (simp add: ta_reachable_def) force} + then obtain ts where ts: "i < length qs \<Longrightarrow> ground (ts i) \<and> qs ! i |\<in>| ta_der \<A> (ts i)" for i by metis + obtain C' where C: "ground_ctxt C'" "qs ! length ts1 |\<in>| ta_der \<A> C'\<langle>t\<rangle>" using More(1)[OF q'(3)] by blast + define D where "D \<equiv> More f (map ts [0..<length ts1]) C' (map ts [Suc (length ts1)..<Suc (length ts1 + length ts2)])" + have "ground_ctxt D" unfolding D_def using ts C(1) q'(4) by auto + moreover have "q |\<in>| ta_der \<A> D\<langle>t\<rangle>" using ts C(2) q' unfolding D_def + by (auto simp: nth_append_Cons not_le not_less le_less_Suc_eq Suc_le_eq intro!: exI[of _ qs] exI[of _ q']) + ultimately show ?case by blast +qed + +lemma ta_productive_def': + assumes "\<Q> \<A> |\<subseteq>| ta_reachable \<A>" + shows "ta_productive Q \<A> = {| q| q q' C. ground_ctxt C \<and> q' |\<in>| ta_der \<A> (C\<langle>Var q\<rangle>) \<and> q' |\<in>| Q |}" + using ta_productive_aux[OF assms] + by (auto simp: ta_productive_def intro!: finite_subset[OF _ finite_ta_productive, of _ \<A> Q]) force+ + +(* turn a finite automaton into a trim one, by removing + first all unreachable and then all non-productive states *) + +lemma trim_gta_lang: "gta_lang Q (trim_ta Q \<A>) = gta_lang Q \<A>" + unfolding trim_ta_def gta_only_reach_lang gta_only_prod_lang .. + +lemma trim_ta_subset: "ta_subset (trim_ta Q \<A>) \<A>" + unfolding trim_ta_def by (rule ta_prod_reach_subset) + +theorem trim_ta: "ta_is_trim Q (trim_ta Q \<A>)" unfolding ta_is_trim_def + by (metis fin_mono ta_only_prod_reachable ta_only_reach_reachable + ta_prodictive_ta_only_prod ta_restrict_states_Q trim_ta_def) + + +lemma reg_is_trim_trim_reg [simp]: "reg_is_trim (trim_reg R)" + unfolding reg_is_trim_def trim_reg_def + by (simp add: trim_ta) + +lemma trim_reg_reach [simp]: + "\<Q>\<^sub>r (trim_reg A) |\<subseteq>| ta_reachable (ta (trim_reg A))" + by (auto simp: trim_reg_def) (meson ta_is_trim_def trim_ta) + +lemma trim_reg_prod [simp]: + "\<Q>\<^sub>r (trim_reg A) |\<subseteq>| ta_productive (fin (trim_reg A)) (ta (trim_reg A))" + by (auto simp: trim_reg_def) (meson ta_is_trim_def trim_ta) + +(* Proposition 7: every tree automaton can be turned into an equivalent trim one *) +lemmas obtain_trimmed_ta = trim_ta trim_gta_lang ta_subset_det[OF trim_ta_subset] + +(* Trim tree automaton signature *) +lemma \<L>_trim_ta_sig: + assumes "reg_is_trim R" "\<L> R \<subseteq> \<T>\<^sub>G (fset \<F>)" + shows "ta_sig (ta R) |\<subseteq>| \<F>" +proof - + {fix r assume r: "r |\<in>| rules (ta R)" + then obtain f ps p where [simp]: "r = f ps \<rightarrow> p" by (cases r) auto + from r assms(1) have "fset_of_list ps |\<subseteq>| ta_reachable (ta R)" + by (auto simp add: rule_statesD(4) reg_is_trim_def ta_is_trim_def) + from ta_reachableI_rule[OF this, of f p] r + obtain ts where ts: "length ts = length ps" "\<forall> i < length ps. ground (ts ! i)" + "\<forall> i < length ps. ps ! i |\<in>| ta_der (ta R) (ts ! i)" + by auto + obtain C q where ctxt: "ground_ctxt C" "q |\<in>| ta_der (ta R) (C\<langle>Var p\<rangle>)" "q |\<in>| fin R" + using assms(1) unfolding reg_is_trim_def + by (metis \<open>r = f ps \<rightarrow> p\<close> fsubsetI r rule_statesD(2) ta_productiveE ta_productive_aux ta_is_trim_def) + from ts ctxt r have reach: "q |\<in>| ta_der (ta R) C\<langle>Fun f ts\<rangle>" + by auto (metis ta_der_Fun ta_der_ctxt) + have gr: "ground C\<langle>Fun f ts\<rangle>" using ts(1, 2) ctxt(1) + by (auto simp: in_set_conv_nth) + then have "C\<langle>Fun f ts\<rangle> \<in> ta_lang (fin R) (ta R)" using ctxt(1, 3) ts(1, 2) + apply (intro ta_langI[OF _ _ reach, of "fin R" "C\<langle>Fun f ts\<rangle>"]) + apply (auto simp del: adapt_vars_ctxt) + by (metis gr adapt_vars2 adapt_vars_adapt_vars) + then have *: "gterm_of_term C\<langle>Fun f ts\<rangle> \<in> \<L> R" using gr + by (auto simp: \<L>_def) + then have "funas_gterm (gterm_of_term C\<langle>Fun f ts\<rangle>) \<subseteq> fset \<F>" using assms(2) gr + by (auto simp: \<T>\<^sub>G_equivalent_def) + moreover have "(f, length ps) \<in> funas_gterm (gterm_of_term C\<langle>Fun f ts\<rangle>)" + using ts(1) by (auto simp: funas_gterm_gterm_of_term[OF gr]) + ultimately have "(r_root r, length (r_lhs_states r)) |\<in>| \<F>" + by (auto simp: fmember.rep_eq)} + then show ?thesis + by (auto simp: ta_sig_def) +qed + +text \<open>Map function over TA rules which change states/signature\<close> + +lemma map_ta_rule_iff: + "map_ta_rule f g |`| \<Delta> = {|TA_rule (g h) (map f qs) (f q) | h qs q. TA_rule h qs q |\<in>| \<Delta>|}" + apply (intro fequalityI fsubsetI) + apply (auto simp add: rev_fimage_eqI) + apply (metis map_ta_rule_cases ta_rule.collapse) + done + +lemma \<L>_trim: "\<L> (trim_reg R) = \<L> R" + by (auto simp: trim_gta_lang \<L>_def trim_reg_def) + + +lemma fmap_funs_ta_def': + "fmap_funs_ta h \<A> = TA {|(h f) qs \<rightarrow> q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>|} (eps \<A>)" + unfolding fmap_funs_ta_def map_ta_rule_iff by auto + +lemma fmap_states_ta_def': + "fmap_states_ta h \<A> = TA {|f (map h qs) \<rightarrow> h q |f qs q. f qs \<rightarrow> q |\<in>| rules \<A>|} (map_both h |`| eps \<A>)" + unfolding fmap_states_ta_def map_ta_rule_iff by auto + +lemma fmap_states [simp]: + "\<Q> (fmap_states_ta h \<A>) = h |`| \<Q> \<A>" + unfolding fmap_states_ta_def \<Q>_def + by auto + +lemma fmap_states_ta_sig [simp]: + "ta_sig (fmap_states_ta f \<A>) = ta_sig \<A>" + by (auto simp: fBex_def fmap_states_ta_def ta_sig_def fimage_iff) + (metis id_def length_map ta_rule.map_sel(1, 2))+ + +lemma fmap_states_ta_eps_wit: + assumes "(h p, q) |\<in>| (map_both h |`| eps \<A>)|\<^sup>+|" "finj_on h (\<Q> \<A>)" "p |\<in>| \<Q> \<A>" + obtains q' where "q = h q'" "(p, q') |\<in>| (eps \<A>)|\<^sup>+|" "q' |\<in>| \<Q> \<A>" using assms + by (auto simp: fimage_iff finj_on_def' ftrancl_map_both_fsubset[OF assms(2), of "eps \<A>"]) + (metis (mono_tags, lifting) assms(2) eps_trancl_statesD finj_on_eq_iff) + +lemma ta_der_fmap_states_inv_superset: + assumes "\<Q> \<A> |\<subseteq>| \" "finj_on h \" + and "q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)" + shows "the_finv_into \ h q |\<in>| ta_der \<A> (term_of_gterm t)" using assms(3) +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + from assms(1, 2) have inj: "finj_on h (\<Q> \<A>)" using fsubset_finj_on by blast + have "x |\<in>| \<Q> \<A> \<Longrightarrow> the_finv_into (\<Q> \<A>) h (h x) = the_finv_into \ h (h x)" for x + using assms(1, 2) by (metis fsubsetD inj the_finv_into_f_f) + then show ?case using GFun the_finv_into_f_f[OF inj] assms(1) + by (auto simp: fmap_states_ta_def' finj_on_def' rule_statesD eps_statesD + elim!: fmap_states_ta_eps_wit[OF _ inj] + intro!: exI[of _ "the_finv_into \ h p"]) +qed + +lemma ta_der_fmap_states_inv: + assumes "finj_on h (\<Q> \<A>)" "q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)" + shows "the_finv_into (\<Q> \<A>) h q |\<in>| ta_der \<A> (term_of_gterm t)" + by (simp add: ta_der_fmap_states_inv_superset assms) + +lemma ta_der_to_fmap_states_der: + assumes "q |\<in>| ta_der \<A> (term_of_gterm t)" + shows "h q |\<in>| ta_der (fmap_states_ta h \<A>) (term_of_gterm t)" using assms +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then show ?case + using ftrancl_map_prod_mono[of h "eps \<A>"] + by (auto simp: fmap_states_ta_def' intro!: exI[of _ "h p"] exI[of _ "map h ps"]) +qed + +lemma ta_der_fmap_states_conv: + assumes "finj_on h (\<Q> \<A>)" + shows "ta_der (fmap_states_ta h \<A>) (term_of_gterm t) = h |`| ta_der \<A> (term_of_gterm t)" + using ta_der_to_fmap_states_der[of _ \<A> t] ta_der_fmap_states_inv[OF assms] + using f_the_finv_into_f[OF assms] finj_on_the_finv_into[OF assms] + using gterm_ta_der_states + by (auto intro!: rev_fimage_eqI) fastforce + +lemma fmap_states_ta_det: + assumes "finj_on f (\<Q> \<A>)" + shows "ta_det (fmap_states_ta f \<A>) = ta_det \<A>" (is "?Ls = ?Rs") +proof + {fix g ps p q assume ass: "?Ls" "TA_rule g ps p |\<in>| rules \<A>" "TA_rule g ps q |\<in>| rules \<A>" + then have "TA_rule g (map f ps) (f p) |\<in>| rules (fmap_states_ta f \<A>)" + "TA_rule g (map f ps) (f q) |\<in>| rules (fmap_states_ta f \<A>)" + by (force simp: fmap_states_ta_def)+ + then have "p = q" using ass finj_on_eq_iff[OF assms] + by (auto simp: ta_det_def) (meson rule_statesD(2))} + then show "?Ls \<Longrightarrow> ?Rs" + by (auto simp: ta_det_def fmap_states_ta_def') +next + {fix g ps qs p q assume ass: "?Rs" "TA_rule g ps p |\<in>| rules \<A>" "TA_rule g qs q |\<in>| rules \<A>" + then have "map f ps = map f qs \<Longrightarrow> ps = qs" using finj_on_eq_iff[OF assms] + by (auto simp: map_eq_nth_conv in_fset_conv_nth dest!: rule_statesD(4) intro!: nth_equalityI)} + then show "?Rs \<Longrightarrow> ?Ls" using finj_on_eq_iff[OF assms] + by (auto simp: ta_det_def fmap_states_ta_def') blast +qed + +lemma fmap_states_ta_lang: + "finj_on f (\<Q> \<A>) \<Longrightarrow> Q |\<subseteq>| \<Q> \<A> \<Longrightarrow> gta_lang (f |`| Q) (fmap_states_ta f \<A>) = gta_lang Q \<A>" + using ta_der_fmap_states_conv[of f \<A>] + by (auto simp: finj_on_def' finj_on_eq_iff fsubsetD elim!: gta_langE intro!: gta_langI) + +lemma fmap_states_ta_lang2: + "finj_on f (\<Q> \<A> |\<union>| Q) \<Longrightarrow> gta_lang (f |`| Q) (fmap_states_ta f \<A>) = gta_lang Q \<A>" + using ta_der_fmap_states_conv[OF fsubset_finj_on[of f "\<Q> \<A> |\<union>| Q" "\<Q> \<A>"]] + by (auto simp: finj_on_def' elim!: gta_langE intro!: gta_langI) fastforce + + +definition funs_ta :: "('q, 'f) ta \<Rightarrow> 'f fset" where + "funs_ta \<A> = {|f |f qs q. TA_rule f qs q |\<in>| rules \<A>|}" + +lemma funs_ta[code]: + "funs_ta \<A> = (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> f) |`| (rules \<A>)" (is "?Ls = ?Rs") + by (force simp: funs_ta_def rev_fimage_eqI simp flip: fset.set_map fmember.rep_eq + split!: ta_rule.splits intro!: finite_subset[of "{f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}" "fset ?Rs"]) + +lemma finite_funs_ta [simp]: + "finite {f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}" + by (intro finite_subset[of "{f. \<exists>qs q. TA_rule f qs q |\<in>| rules \<A>}" "fset (funs_ta \<A>)"]) + (auto simp: funs_ta rev_fimage_eqI simp flip: fset.set_map fmember.rep_eq split!: ta_rule.splits) + +lemma funs_taE [elim]: + assumes "f |\<in>| funs_ta \<A>" + obtains ps p where "TA_rule f ps p |\<in>| rules \<A>" using assms + by (auto simp: funs_ta_def) + +lemma funs_taI [intro]: + "TA_rule f ps p |\<in>| rules \<A> \<Longrightarrow> f |\<in>| funs_ta \<A>" + by (auto simp: funs_ta_def) + +lemma fmap_funs_ta_cong: + "(\<And>x. x |\<in>| funs_ta \<A> \<Longrightarrow> h x = k x) \<Longrightarrow> \<A> = \ \<Longrightarrow> fmap_funs_ta h \<A> = fmap_funs_ta k \" + by (force simp: fmap_funs_ta_def') + +lemma [simp]: "{|TA_rule f qs q |f qs q. TA_rule f qs q |\<in>| X|} = X" + by (intro fset_eqI; case_tac x) auto + +lemma fmap_funs_ta_id [simp]: + "fmap_funs_ta id \<A> = \<A>" by (simp add: fmap_funs_ta_def') + +lemma fmap_states_ta_id [simp]: + "fmap_states_ta id \<A> = \<A>" + by (auto simp: fmap_states_ta_def map_ta_rule_iff prod.map_id0) + +lemmas fmap_funs_ta_id' [simp] = fmap_funs_ta_id[unfolded id_def] + +lemma fmap_funs_ta_comp: + "fmap_funs_ta h (fmap_funs_ta k A) = fmap_funs_ta (h \<circ> k) A" +proof - + have "r |\<in>| rules A \<Longrightarrow> map_ta_rule id h (map_ta_rule id k r) = map_ta_rule id (\<lambda>x. h (k x)) r" for r + by (cases r) (auto) + then show ?thesis + by (force simp: fmap_funs_ta_def fimage_iff cong: fmap_funs_ta_cong) +qed + +lemma fmap_funs_reg_comp: + "fmap_funs_reg h (fmap_funs_reg k A) = fmap_funs_reg (h \<circ> k) A" + using fmap_funs_ta_comp unfolding fmap_funs_reg_def + by auto + +lemma fmap_states_ta_comp: + "fmap_states_ta h (fmap_states_ta k A) = fmap_states_ta (h \<circ> k) A" + by (auto simp: fmap_states_ta_def ta_rule.map_comp comp_def id_def prod.map_comp) + +lemma funs_ta_fmap_funs_ta [simp]: + "funs_ta (fmap_funs_ta f A) = f |`| funs_ta A" + by (auto simp: funs_ta fmap_funs_ta_def' comp_def fimage_iff + split!: ta_rule.splits) force+ + +lemma ta_der_funs_ta: + "q |\<in>| ta_der A t \<Longrightarrow> ffuns_term t |\<subseteq>| funs_ta A" +proof (induct t arbitrary: q) + case (Fun f ts) + then have "f |\<in>| funs_ta A" by (auto simp: funs_ta_def) + then show ?case using Fun(1)[OF nth_mem, THEN fsubsetD] Fun(2) + by (auto simp: in_fset_conv_nth) blast+ +qed auto + +lemma ta_der_fmap_funs_ta: + "q |\<in>| ta_der A t \<Longrightarrow> q |\<in>| ta_der (fmap_funs_ta f A) (map_funs_term f t)" + by (induct t arbitrary: q) (auto 0 4 simp: fmap_funs_ta_def') + +lemma ta_der_fmap_states_ta: + assumes "q |\<in>| ta_der A t" + shows "h q |\<in>| ta_der (fmap_states_ta h A) (map_vars_term h t)" +proof - + have [intro]: "(q, q') |\<in>| (eps A)|\<^sup>+| \<Longrightarrow> (h q, h q') |\<in>| (eps (fmap_states_ta h A))|\<^sup>+|" for q q' + by (force intro!: ftrancl_map[of "eps A"] simp: fmap_states_ta_def) + show ?thesis using assms + proof (induct rule: ta_der_induct) + case (Fun f ts ps p q) + have "f (map h ps) \<rightarrow> h p |\<in>| rules (fmap_states_ta h A)" + using Fun(1) by (force simp: fmap_states_ta_def') + then show ?case using Fun by (auto 0 4) + qed auto +qed + +lemma ta_der_fmap_states_ta_mono: + shows "f |`| ta_der A (term_of_gterm s) |\<subseteq>| ta_der (fmap_states_ta f A) (term_of_gterm s)" + using ta_der_fmap_states_ta[of _ A "term_of_gterm s" f] + by (simp add: fimage_fsubsetI ta_der_to_fmap_states_der) + +lemma ta_der_fmap_states_ta_mono2: + assumes "finj_on f (\<Q> A)" + shows "ta_der (fmap_states_ta f A) (term_of_gterm s) |\<subseteq>| f |`| ta_der A (term_of_gterm s)" + using ta_der_fmap_states_conv[OF assms] by auto + +lemma fmap_funs_ta_der': + "q |\<in>| ta_der (fmap_funs_ta h A) t \<Longrightarrow> \<exists>t'. q |\<in>| ta_der A t' \<and> map_funs_term h t' = t" +proof (induct rule: ta_der_induct) + case (Var q v) + then show ?case by (auto simp: fmap_funs_ta_def intro!: exI[of _ "Var v"]) +next + case (Fun f ts ps p q) + obtain f' ts' where root: "f = h f'" "f' ps \<rightarrow> p |\<in>| rules A" and + "\<And>i. i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der A (ts' i) \<and> map_funs_term h (ts' i) = ts ! i" + using Fun(1, 5) unfolding fmap_funs_ta_def' + by auto metis + note [simp] = conjunct1[OF this(3)] conjunct2[OF this(3), unfolded id_def] + have [simp]: "p = q \<Longrightarrow> f' ps \<rightarrow> q |\<in>| rules A" using root(2) by auto + show ?case using Fun(3) + by (auto simp: comp_def Fun root fmap_funs_ta_def' + intro!: exI[of _ "Fun f' (map ts' [0..<length ts])"] exI[of _ ps] exI[of _ p] nth_equalityI) +qed + +lemma fmap_funs_gta_lang: + "gta_lang Q (fmap_funs_ta h \<A>) = map_gterm h ` gta_lang Q \<A>" (is "?Ls = ?Rs") +proof - + {fix s assume "s \<in> ?Ls" then obtain q where + lang: "q |\<in>| Q" "q |\<in>| ta_der (fmap_funs_ta h \<A>) (term_of_gterm s)" + by auto + from fmap_funs_ta_der'[OF this(2)] obtain t where + t: "q |\<in>| ta_der \<A> t" "map_funs_term h t = term_of_gterm s" "ground t" + by (metis ground_map_term ground_term_of_gterm) + then have "s \<in> ?Rs" using map_gterm_of_term[OF t(3), of h id] lang + by (auto simp: gta_lang_def gta_der_def image_iff) + (metis fempty_iff finterI ground_term_to_gtermD map_term_of_gterm term_of_gterm_inv)} + moreover have "?Rs \<subseteq> ?Ls" using ta_der_fmap_funs_ta[of _ \<A> _ h] + by (auto elim!: gta_langE intro!: gta_langI) fastforce + ultimately show ?thesis by blast +qed + +lemma fmap_funs_\<L>: + "\<L> (fmap_funs_reg h R) = map_gterm h ` \<L> R" + using fmap_funs_gta_lang[of "fin R" h] + by (auto simp: fmap_funs_reg_def \<L>_def) + +lemma ta_states_fmap_funs_ta [simp]: "\<Q> (fmap_funs_ta f A) = \<Q> A" + by (auto simp: fmap_funs_ta_def \<Q>_def) + +lemma ta_reachable_fmap_funs_ta [simp]: + "ta_reachable (fmap_funs_ta f A) = ta_reachable A" unfolding ta_reachable_def + by (metis (mono_tags, lifting) fmap_funs_ta_der' ta_der_fmap_funs_ta ground_map_term) + + +lemma fin_in_states: + "fin (reg_Restr_Q\<^sub>f R) |\<subseteq>| \<Q>\<^sub>r (reg_Restr_Q\<^sub>f R)" + by (auto simp: reg_Restr_Q\<^sub>f_def) + +lemma fmap_states_reg_Restr_Q\<^sub>f_fin: + "finj_on f (\<Q> \<A>) \<Longrightarrow> fin (fmap_states_reg f (reg_Restr_Q\<^sub>f R)) |\<subseteq>| \<Q>\<^sub>r (fmap_states_reg f (reg_Restr_Q\<^sub>f R))" + by (auto simp: fmap_states_reg_def reg_Restr_Q\<^sub>f_def) + +lemma \<L>_fmap_states_reg_Inl_Inr [simp]: + "\<L> (fmap_states_reg Inl R) = \<L> R" + "\<L> (fmap_states_reg Inr R) = \<L> R" + unfolding \<L>_def fmap_states_reg_def + by (auto simp: finj_Inl_Inr intro!: fmap_states_ta_lang2) + +lemma finite_Collect_prod_ta_rules: + "finite {f qs \<rightarrow> (a, b) |f qs a b. f map fst qs \<rightarrow> a |\<in>| rules \<A> \<and> f map snd qs \<rightarrow> b |\<in>| rules \<BB>}" (is "finite ?set") +proof - + have "?set \<subseteq> (\<lambda> (ra, rb). case ra of f ps \<rightarrow> p \<Rightarrow> case rb of g qs \<rightarrow> q \<Rightarrow> f (zip ps qs) \<rightarrow> (p, q)) ` (srules \<A> \<times> srules \<BB>)" + by (auto simp: srules_def image_iff fmember.rep_eq split!: ta_rule.splits) + (metis ta_rule.inject zip_map_fst_snd) + from finite_imageI[of "srules \<A> \<times> srules \<BB>", THEN finite_subset[OF this]] + show ?thesis by (auto simp: srules_def) +qed + +\<comment> \<open>The product automaton of the automata A and B is constructed + by applying the rules on pairs of states\<close> + +lemmas prod_eps_def = prod_epsLp_def prod_epsRp_def + +lemma finite_prod_epsLp: + "finite (Collect (prod_epsLp \<A> \))" + by (intro finite_subset[of "Collect (prod_epsLp \<A> \)" "fset ((\<Q> \<A> |\<times>| \<Q> \) |\<times>| \<Q> \<A> |\<times>| \<Q> \)"]) + (auto simp: prod_epsLp_def simp flip: fmember.rep_eq dest: eps_statesD) + +lemma finite_prod_epsRp: + "finite (Collect (prod_epsRp \<A> \))" + by (intro finite_subset[of "Collect (prod_epsRp \<A> \)" "fset ((\<Q> \<A> |\<times>| \<Q> \) |\<times>| \<Q> \<A> |\<times>| \<Q> \)"]) + (auto simp: prod_epsRp_def simp flip: fmember.rep_eq dest: eps_statesD) +lemmas finite_prod_eps [simp] = finite_prod_epsLp[unfolded prod_epsLp_def] finite_prod_epsRp[unfolded prod_epsRp_def] + +lemma [simp]: "f qs \<rightarrow> q |\<in>| rules (prod_ta \<A> \) \<longleftrightarrow> f qs \<rightarrow> q |\<in>| prod_ta_rules \<A> \" + "r |\<in>| rules (prod_ta \<A> \) \<longleftrightarrow> r |\<in>| prod_ta_rules \<A> \" + by (auto simp: prod_ta_def) + +lemma prod_ta_states: + "\<Q> (prod_ta \<A> \) |\<subseteq>| \<Q> \<A> |\<times>| \<Q> \" +proof - + {fix q assume "q |\<in>| rule_states (rules (prod_ta \<A> \))" + then obtain f ps p where "f ps \<rightarrow> p |\<in>| rules (prod_ta \<A> \)" and "q |\<in>| fset_of_list ps \<or> p = q" + by (metis rule_statesE) + then have "fst q |\<in>| \<Q> \<A> \<and> snd q |\<in>| \<Q> \" + using rule_statesD(2, 4)[of f "map fst ps" "fst p" \<A>] + using rule_statesD(2, 4)[of f "map snd ps" "snd p" \] + by auto} + moreover + {fix q assume "q |\<in>| eps_states (eps (prod_ta \<A> \))" then have "fst q |\<in>| \<Q> \<A> \<and> snd q |\<in>| \<Q> \" + by (auto simp: eps_states_def prod_ta_def prod_eps_def dest: eps_statesD)} + ultimately show ?thesis + by (auto simp: \<Q>_def) blast+ +qed + +lemma prod_ta_det: + assumes "ta_det \<A>" and "ta_det \" + shows "ta_det (prod_ta \<A> \)" + using assms unfolding ta_det_def prod_ta_def prod_eps_def + by auto + +lemma prod_ta_sig: + "ta_sig (prod_ta \<A> \) |\<subseteq>| ta_sig \<A> |\<union>| ta_sig \" + by (auto simp add: ta_sig_def fimage_iff fBall_def)+ + +lemma from_prod_eps: + "(p, q) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+| \<Longrightarrow> (snd p, snd q) |\<notin>| (eps \)|\<^sup>+| \<Longrightarrow> snd p = snd q \<and> (fst p, fst q) |\<in>| (eps \<A>)|\<^sup>+|" + "(p, q) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+| \<Longrightarrow> (fst p, fst q) |\<notin>| (eps \<A>)|\<^sup>+| \<Longrightarrow> fst p = fst q \<and> (snd p, snd q) |\<in>| (eps \)|\<^sup>+|" + apply (induct rule: ftrancl_induct) + apply (auto simp: prod_ta_def prod_eps_def intro: ftrancl_into_trancl ) + apply (simp add: fr_into_trancl not_ftrancl_into)+ + done + +lemma to_prod_eps\<A>: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> r |\<in>| \<Q> \ \<Longrightarrow> ((p, r), (q, r)) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" + by (induct rule: ftrancl_induct) + (auto simp: prod_ta_def prod_eps_def intro: fr_into_trancl ftrancl_into_trancl) + +lemma to_prod_eps\: + "(p, q) |\<in>| (eps \)|\<^sup>+| \<Longrightarrow> r |\<in>| \<Q> \<A> \<Longrightarrow> ((r, p), (r, q)) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" + by (induct rule: ftrancl_induct) + (auto simp: prod_ta_def prod_eps_def intro: fr_into_trancl ftrancl_into_trancl) + +lemma to_prod_eps: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> (p', q') |\<in>| (eps \)|\<^sup>+| \<Longrightarrow> ((p, p'), (q, q')) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" +proof (induct rule: ftrancl_induct) + case (Base a b) + show ?case using Base(2, 1) + proof (induct rule: ftrancl_induct) + case (Base c d) + then have "((a, c), b, c) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" using finite_prod_eps + by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl ftrancl_into_trancl) + moreover have "((b, c), b, d) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" using finite_prod_eps Base + by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl ftrancl_into_trancl) + ultimately show ?case + by (auto intro: ftrancl_trans) + next + case (Step p q r) + then have "((b, q), b, r) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" using finite_prod_eps + by (auto simp: prod_ta_def prod_eps_def dest: eps_statesD intro!: fr_into_trancl) + then show ?case using Step + by (auto intro: ftrancl_trans) + qed +next + case (Step a b c) + from Step have "q' |\<in>| \<Q> \" + by (auto dest: eps_trancl_statesD) + then have "((b, q'), (c,q')) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" + using Step(3) finite_prod_eps + by (auto simp: prod_ta_def prod_eps_def intro!: fr_into_trancl) + then show ?case using ftrancl_trans Step + by auto +qed + +lemma prod_ta_der_to_\<A>_\_der1: + assumes "q |\<in>| ta_der (prod_ta \<A> \) (term_of_gterm t)" + shows "fst q |\<in>| ta_der \<A> (term_of_gterm t)" using assms +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then show ?case + by (auto dest: from_prod_eps intro!: exI[of _ "map fst ps"] exI[of _ "fst p"]) +qed + +lemma prod_ta_der_to_\<A>_\_der2: + assumes "q |\<in>| ta_der (prod_ta \<A> \) (term_of_gterm t)" + shows "snd q |\<in>| ta_der \ (term_of_gterm t)" using assms +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then show ?case + by (auto dest: from_prod_eps intro!: exI[of _ "map snd ps"] exI[of _ "snd p"]) +qed + +lemma \<A>_\_der_to_prod_ta: + assumes "fst q |\<in>| ta_der \<A> (term_of_gterm t)" "snd q |\<in>| ta_der \ (term_of_gterm t)" + shows "q |\<in>| ta_der (prod_ta \<A> \) (term_of_gterm t)" using assms +proof (induct t arbitrary: q) + case (GFun f ts) + from GFun(2, 3) obtain ps qs p q' where + rules: "f ps \<rightarrow> p |\<in>| rules \<A>" "f qs \<rightarrow> q' |\<in>| rules \" "length ps = length ts" "length ps = length qs" and + eps: "p = fst q \<or> (p, fst q) |\<in>| (eps \<A>)|\<^sup>+|" "q' = snd q \<or> (q', snd q) |\<in>| (eps \)|\<^sup>+|" and + steps: "\<forall> i < length qs. ps ! i |\<in>| ta_der \<A> (term_of_gterm (ts ! i))" + "\<forall> i < length qs. qs ! i |\<in>| ta_der \ (term_of_gterm (ts ! i))" + by auto + from rules have st: "p |\<in>| \<Q> \<A>" "q' |\<in>| \<Q> \" by (auto dest: rule_statesD) + have "(p, snd q) = q \<or> ((p, q'), q) |\<in>| (eps (prod_ta \<A> \))|\<^sup>+|" using eps st + using to_prod_eps\[of q' "snd q" \ "fst q" \<A>] + using to_prod_eps\<A>[of p "fst q" \<A> "snd q" \] + using to_prod_eps[of p "fst q" \<A> q' "snd q" \] + by (cases "p = fst q"; cases "q' = snd q") (auto simp: prod_ta_def) + then show ?case using rules eps steps GFun(1) st + by (cases "(p, snd q) = q") + (auto simp: finite_Collect_prod_ta_rules dest: to_prod_eps\ intro!: exI[of _ p] exI[of _ q'] exI[of _ "zip ps qs"]) +qed + +lemma prod_ta_der: + "q |\<in>| ta_der (prod_ta \<A> \) (term_of_gterm t) \<longleftrightarrow> + fst q |\<in>| ta_der \<A> (term_of_gterm t) \<and> snd q |\<in>| ta_der \ (term_of_gterm t)" + using prod_ta_der_to_\<A>_\_der1 prod_ta_der_to_\<A>_\_der2 \<A>_\_der_to_prod_ta + by blast + +lemma intersect_ta_gta_lang: + "gta_lang (Q\<^sub>\<A> |\<times>| Q\<^sub>\) (prod_ta \<A> \) = gta_lang Q\<^sub>\<A> \<A> \<inter> gta_lang Q\<^sub>\ \" + by (auto simp: prod_ta_der elim!: gta_langE intro: gta_langI) + + +lemma \<L>_intersect: "\<L> (reg_intersect R L) = \<L> R \<inter> \<L> L" + by (auto simp: intersect_ta_gta_lang \<L>_def reg_intersect_def) + +lemma intersect_ta_ta_lang: + "ta_lang (Q\<^sub>\<A> |\<times>| Q\<^sub>\) (prod_ta \<A> \) = ta_lang Q\<^sub>\<A> \<A> \<inter> ta_lang Q\<^sub>\ \" + using intersect_ta_gta_lang[of Q\<^sub>\<A> Q\<^sub>\ \<A> \] + by auto (metis IntI imageI term_of_gterm_inv) + +\<comment> \<open>Union of tree automata\<close> + +lemma ta_union_ta_subset: + "ta_subset \<A> (ta_union \<A> \)" "ta_subset \ (ta_union \<A> \)" + unfolding ta_subset_def ta_union_def + by auto + +lemma ta_union_states [simp]: + "\<Q> (ta_union \<A> \) = \<Q> \<A> |\<union>| \<Q> \" + by (auto simp: ta_union_def \<Q>_def) + +lemma ta_union_sig [simp]: + "ta_sig (ta_union \<A> \) = ta_sig \<A> |\<union>| ta_sig \" + by (auto simp: ta_union_def ta_sig_def) + +lemma ta_union_eps_disj_states: + assumes "\<Q> \<A> |\<inter>| \<Q> \ = {||}" and "(p, q) |\<in>| (eps (ta_union \<A> \))|\<^sup>+|" + shows "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<or> (p, q) |\<in>| (eps \)|\<^sup>+|" using assms(2, 1) + by (induct rule: ftrancl_induct) + (auto simp: ta_union_def ftrancl_into_trancl dest: eps_statesD eps_trancl_statesD) + +lemma eps_ta_union_eps [simp]: + "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> (p, q) |\<in>| (eps (ta_union \<A> \))|\<^sup>+|" + "(p, q) |\<in>| (eps \)|\<^sup>+| \<Longrightarrow> (p, q) |\<in>| (eps (ta_union \<A> \))|\<^sup>+|" + by (auto simp add: in_ftrancl_UnI ta_union_def) + + +lemma disj_states_eps [simp]: + "\<Q> \<A> |\<inter>| \<Q> \ = {||} \<Longrightarrow> f ps \<rightarrow> p |\<in>| rules \<A> \<Longrightarrow> (p, q) |\<in>| (eps \)|\<^sup>+| \<longleftrightarrow> False" + "\<Q> \<A> |\<inter>| \<Q> \ = {||} \<Longrightarrow> f ps \<rightarrow> p |\<in>| rules \ \<Longrightarrow> (p, q) |\<in>| (eps \<A>)|\<^sup>+| \<longleftrightarrow> False" + by (auto simp: rtrancl_eq_or_trancl dest: rule_statesD eps_trancl_statesD) + +lemma ta_union_der_disj_states: + assumes "\<Q> \<A> |\<inter>| \<Q> \ = {||}" and "q |\<in>| ta_der (ta_union \<A> \) t" + shows "q |\<in>| ta_der \<A> t \<or> q |\<in>| ta_der \ t" using assms(2) +proof (induct rule: ta_der_induct) + case (Var q v) + then show ?case using ta_union_eps_disj_states[OF assms(1)] + by auto +next + case (Fun f ts ps p q) + have dist: "fset_of_list ps |\<subseteq>| \<Q> \<A> \<Longrightarrow> i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \<A> (ts ! i)" + "fset_of_list ps |\<subseteq>| \<Q> \ \<Longrightarrow> i < length ts \<Longrightarrow> ps ! i |\<in>| ta_der \ (ts ! i)" for i + using Fun(2) Fun(5)[of i] assms(1) + by (auto dest!: ta_der_not_stateD fsubsetD) + from Fun(1) consider (a) "fset_of_list ps |\<subseteq>| \<Q> \<A>" | (b) "fset_of_list ps |\<subseteq>| \<Q> \" + by (auto simp: ta_union_def dest: rule_statesD) + then show ?case using dist Fun(1, 2) assms(1) ta_union_eps_disj_states[OF assms(1), of p q] Fun(3) + by (cases) (auto simp: fsubsetI rule_statesD ta_union_def intro!: exI[of _ p] exI[of _ ps]) +qed + +lemma ta_union_der_disj_states': + assumes "\<Q> \<A> |\<inter>| \<Q> \ = {||}" + shows "ta_der (ta_union \<A> \) t = ta_der \<A> t |\<union>| ta_der \ t" + using ta_union_der_disj_states[OF assms] ta_der_mono' ta_union_ta_subset + by (auto, fastforce) blast + +lemma ta_union_gta_lang: + assumes "\<Q> \<A> |\<inter>| \<Q> \ = {||}" and "Q\<^sub>\<A> |\<subseteq>| \<Q> \<A>" and "Q\<^sub>\ |\<subseteq>| \<Q> \" + shows"gta_lang (Q\<^sub>\<A> |\<union>| Q\<^sub>\) (ta_union \<A> \) = gta_lang Q\<^sub>\<A> \<A> \<union> gta_lang Q\<^sub>\ \" (is "?Ls = ?Rs") +proof - + {fix s assume "s \<in> ?Ls" then obtain q + where w: "q |\<in>| Q\<^sub>\<A> |\<union>| Q\<^sub>\" "q |\<in>| ta_der (ta_union \<A> \) (term_of_gterm s)" + by (auto elim: gta_langE) + from ta_union_der_disj_states[OF assms(1) w(2)] consider + (a) "q |\<in>| ta_der \<A> (term_of_gterm s)" | "q |\<in>| ta_der \ (term_of_gterm s)" by blast + then have "s \<in> ?Rs" using w(1) assms + by (cases, auto simp: gta_langI) + (metis fempty_iff finterI funion_iff gterm_ta_der_states sup.orderE)} + moreover have "?Rs \<subseteq> ?Ls" using ta_union_der_disj_states'[OF assms(1)] + by (auto elim!: gta_langE intro!: gta_langI) + ultimately show ?thesis by blast +qed + + +lemma \<L>_union: "\<L> (reg_union R L) = \<L> R \<union> \<L> L" +proof - + let ?inl = "Inl :: 'b \<Rightarrow> 'b + 'c" let ?inr = "Inr :: 'c \<Rightarrow> 'b + 'c" + let ?fr = "?inl |`| (fin R |\<inter>| \<Q>\<^sub>r R)" let ?fl = "?inr |`| (fin L |\<inter>| \<Q>\<^sub>r L)" + have [simp]:"gta_lang (?fr |\<union>| ?fl) (ta_union (fmap_states_ta ?inl (ta R)) (fmap_states_ta ?inr (ta L))) = + gta_lang ?fr (fmap_states_ta ?inl (ta R)) \<union> gta_lang ?fl (fmap_states_ta ?inr (ta L))" + by (intro ta_union_gta_lang) (auto simp: fimage_iff) + have [simp]: "gta_lang ?fr (fmap_states_ta ?inl (ta R)) = gta_lang (fin R |\<inter>| \<Q>\<^sub>r R) (ta R)" + by (intro fmap_states_ta_lang) (auto simp: finj_Inl_Inr) + have [simp]: "gta_lang ?fl (fmap_states_ta ?inr (ta L)) = gta_lang (fin L |\<inter>| \<Q>\<^sub>r L) (ta L)" + by (intro fmap_states_ta_lang) (auto simp: finj_Inl_Inr) + show ?thesis + using gta_lang_Rest_states_conv + by (auto simp: \<L>_def reg_union_def ta_union_gta_lang) fastforce +qed + +lemma reg_union_states: + "\<Q>\<^sub>r (reg_union A B) = (Inl |`| \<Q>\<^sub>r A) |\<union>| (Inr |`| \<Q>\<^sub>r B)" + by (auto simp: reg_union_def) + +\<comment> \<open>Deciding emptiness\<close> + +lemma ta_empty [simp]: + "ta_empty Q \<A> = (gta_lang Q \<A> = {})" + by (auto simp: ta_empty_def elim!: gta_langE ta_reachable_gtermE + intro: ta_reachable_gtermI gta_langI) + + +lemma reg_empty [simp]: + "reg_empty R = (\<L> R = {})" + by (simp add: \<L>_def reg_empty_def) + +text \<open>Epsilon free automaton\<close> + +lemma finite_eps_free_rulep [simp]: + "finite (Collect (eps_free_rulep \<A>))" +proof - + let ?par = "(\<lambda> r. case r of f qs \<rightarrow> q \<Rightarrow> (f, qs)) |`| (rules \<A>)" + let ?st = "(\<lambda> (r, q). case r of (f, qs) \<Rightarrow> TA_rule f qs q) |`| (?par |\<times>| \<Q> \<A>)" + show ?thesis using rule_statesD eps_trancl_statesD + by (intro finite_subset[of "Collect (eps_free_rulep \<A>)" "fset ?st"]) + (auto simp: eps_free_rulep_def fimage_iff + simp flip: fset.set_map fmember.rep_eq + split!: ta_rule.splits, fastforce+) +qed + +lemmas finite_eps_free_rule [simp] = finite_eps_free_rulep[unfolded eps_free_rulep_def] + +lemma ta_res_eps_free: + "ta_der (eps_free \<A>) (term_of_gterm t) = ta_der \<A> (term_of_gterm t)" (is "?Ls = ?Rs") +proof - + {fix q assume "q |\<in>| ?Ls" then have "q |\<in>| ?Rs" + by (induct rule: ta_der_gterm_induct) + (auto simp: eps_free_def eps_free_rulep_def)} + moreover + {fix q assume "q |\<in>| ?Rs" then have "q |\<in>| ?Ls" + proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then show ?case + by (auto simp: eps_free_def eps_free_rulep_def intro!: exI[of _ ps]) + qed} + ultimately show ?thesis by blast +qed + +lemma ta_lang_eps_free [simp]: + "gta_lang Q (eps_free \<A>) = gta_lang Q \<A>" + by (auto simp add: ta_res_eps_free elim!: gta_langE intro: gta_langI) + +lemma \<L>_eps_free: "\<L> (eps_free_reg R) = \<L> R" + by (auto simp: \<L>_def eps_free_reg_def) + +text \<open>Sufficient criterion for containment\<close> + (* sufficient criterion to check whether automaton accepts at least T_g(F) where F is a subset of + the signature *) + +definition ta_contains_aux :: "('f \<times> nat) set \<Rightarrow> 'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> 'q fset \<Rightarrow> bool" where + "ta_contains_aux \<F> Q\<^sub>1 \<A> Q\<^sub>2 \<equiv> (\<forall> f qs. (f, length qs) \<in> \<F> \<and> fset_of_list qs |\<subseteq>| Q\<^sub>1 \<longrightarrow> + (\<exists> q q'. TA_rule f qs q |\<in>| rules \<A> \<and> q' |\<in>| Q\<^sub>2 \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|)))" + +lemma ta_contains_aux_state_set: + assumes "ta_contains_aux \<F> Q \<A> Q" "t \<in> \<T>\<^sub>G \<F>" + shows "\<exists> q. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm t)" using assms(2) +proof (induct rule: \<T>\<^sub>G.induct) + case (const a) + then show ?case using assms(1) + by (force simp: ta_contains_aux_def) +next + case (ind f n ss) + obtain qs where "fset_of_list qs |\<subseteq>| Q" "length ss = length qs" + "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i))" + using ind(4) Ex_list_of_length_P[of "length ss" "\<lambda> q i. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"] + by (auto simp: fset_list_fsubset_eq_nth_conv) metis + then show ?case using ind(1 - 3) assms(1) + by (auto simp: ta_contains_aux_def) blast +qed + +lemma ta_contains_aux_mono: + assumes "ta_subset \<A> \" and "Q\<^sub>2 |\<subseteq>| Q\<^sub>2'" + shows "ta_contains_aux \<F> Q\<^sub>1 \<A> Q\<^sub>2 \<Longrightarrow> ta_contains_aux \<F> Q\<^sub>1 \ Q\<^sub>2'" + using assms unfolding ta_contains_aux_def ta_subset_def + by (meson fin_mono ftrancl_mono) + +definition ta_contains :: "('f \<times> nat) set \<Rightarrow> ('f \<times> nat) set \<Rightarrow> ('q, 'f) ta \<Rightarrow> 'q fset \<Rightarrow> 'q fset \<Rightarrow> bool" + where "ta_contains \<F> \<G> \<A> Q Q\<^sub>f \<equiv> ta_contains_aux \<F> Q \<A> Q \<and> ta_contains_aux \<G> Q \<A> Q\<^sub>f" + +lemma ta_contains_mono: + assumes "ta_subset \<A> \" and "Q\<^sub>f |\<subseteq>| Q\<^sub>f'" + shows "ta_contains \<F> \<G> \<A> Q Q\<^sub>f \<Longrightarrow> ta_contains \<F> \<G> \ Q Q\<^sub>f'" + unfolding ta_contains_def + using ta_contains_aux_mono[OF assms(1) fsubset_refl] + using ta_contains_aux_mono[OF assms] + by blast + +lemma ta_contains_both: + assumes contain: "ta_contains \<F> \<G> \<A> Q Q\<^sub>f" + shows "\<And> t. groot t \<in> \<G> \<Longrightarrow> \<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F> \<Longrightarrow> t \<in> gta_lang Q\<^sub>f \<A>" +proof - + fix t :: "'a gterm" + assume F: "\<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F>" and G: "groot t \<in> \<G>" + obtain g ss where t[simp]: "t = GFun g ss" by (cases t, auto) + then have "\<exists> qs. length qs = length ss \<and> (\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i)) \<and> qs ! i |\<in>| Q)" + using contain ta_contains_aux_state_set[of \<F> Q \<A> "ss ! i" for i] F + unfolding ta_contains_def \<T>\<^sub>G_funas_gterm_conv + using Ex_list_of_length_P[of "length ss" "\<lambda> q i. q |\<in>| Q \<and> q |\<in>| ta_der \<A> (term_of_gterm (ss ! i))"] + by auto (metis SUP_le_iff nth_mem) + then obtain qs where " length qs = length ss" + "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (term_of_gterm (ss ! i))" + "\<forall> i < length qs. qs ! i |\<in>| Q" + by blast + then obtain q where "q |\<in>| Q\<^sub>f" "q |\<in>| ta_der \<A> (term_of_gterm t)" + using conjunct2[OF contain[unfolded ta_contains_def]] G + by (auto simp: ta_contains_def ta_contains_aux_def fset_list_fsubset_eq_nth_conv) metis + then show "t \<in> gta_lang Q\<^sub>f \<A>" + by (intro gta_langI) simp +qed + +lemma ta_contains: + assumes contain: "ta_contains \<F> \<F> \<A> Q Q\<^sub>f" + shows "\<T>\<^sub>G \<F> \<subseteq> gta_lang Q\<^sub>f \<A>" (is "?A \<subseteq> _") +proof - + have [simp]: "funas_gterm t \<subseteq> \<F> \<Longrightarrow> groot t \<in> \<F>" for t by (cases t) auto + have [simp]: "funas_gterm t \<subseteq> \<F> \<Longrightarrow> \<Union> (funas_gterm ` set (gargs t)) \<subseteq> \<F>" for t + by (cases t) auto + show ?thesis using ta_contains_both[OF contain] + by (auto simp: \<T>\<^sub>G_equivalent_def) +qed + +text \<open>Relabeling, map finite set to natural numbers\<close> + + +lemma map_fset_to_nat_inj: + assumes "Y |\<subseteq>| X" + shows "finj_on (map_fset_to_nat X) Y" +proof - + { fix x y assume "x |\<in>| X" "y |\<in>| X" + then have "x |\<in>| fset_of_list (sorted_list_of_fset X)" "y |\<in>| fset_of_list (sorted_list_of_fset X)" + by simp_all + note this[unfolded mem_idx_fset_sound] + then have "x = y" if "map_fset_to_nat X x = map_fset_to_nat X y" + using that nth_eq_iff_index_eq[OF distinct_sorted_list_of_fset[of X]] + by (force dest: mem_idx_sound_output simp: map_fset_to_nat_def) } + then show ?thesis using assms + by (auto simp add: finj_on_def' fBall_def) +qed + +lemma map_fset_fset_to_nat_inj: + assumes "Y |\<subseteq>| X" + shows "finj_on (map_fset_fset_to_nat X) Y" using assms +proof - + let ?f = "map_fset_fset_to_nat X" + { fix x y assume "x |\<in>| X" "y |\<in>| X" + then have "sorted_list_of_fset x |\<in>| fset_of_list (sorted_list_of_fset (sorted_list_of_fset |`| X))" + "sorted_list_of_fset y |\<in>| fset_of_list (sorted_list_of_fset (sorted_list_of_fset |`| X))" + unfolding map_fset_fset_to_nat_def by auto + note this[unfolded mem_idx_fset_sound] + then have "x = y" if "?f x = ?f y" + using that nth_eq_iff_index_eq[OF distinct_sorted_list_of_fset[of "sorted_list_of_fset |`| X"]] + by (auto simp: map_fset_fset_to_nat_def) + (metis mem_idx_sound_output notin_fset sorted_list_of_fset_simps(1))+} + then show ?thesis using assms + by (auto simp add: finj_on_def' fBall_def) +qed + + +lemma relabel_gta_lang [simp]: + "gta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = gta_lang Q \<A>" +proof - + have "gta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>" + unfolding relabel_ta_def relabel_Q\<^sub>f_def + by (intro fmap_states_ta_lang2 map_fset_to_nat_inj) simp + then show ?thesis by fastforce +qed + + +lemma \<L>_relable [simp]: "\<L> (relabel_reg R) = \<L> R" + by (auto simp: \<L>_def relabel_reg_def) + +lemma relabel_ta_lang [simp]: + "ta_lang (relabel_Q\<^sub>f Q \<A>) (relabel_ta \<A>) = ta_lang Q \<A>" + unfolding ta_lang_to_gta_lang + using relabel_gta_lang + by simp + + + +lemma relabel_fset_gta_lang [simp]: + "gta_lang (relabel_fset_Q\<^sub>f Q \<A>) (relabel_fset_ta \<A>) = gta_lang Q \<A>" +proof - + have "gta_lang (relabel_fset_Q\<^sub>f Q \<A>) (relabel_fset_ta \<A>) = gta_lang (Q |\<inter>| \<Q> \<A>) \<A>" + unfolding relabel_fset_Q\<^sub>f_def relabel_fset_ta_def + by (intro fmap_states_ta_lang2 map_fset_fset_to_nat_inj) simp + then show ?thesis by fastforce +qed + + +lemma \<L>_relable_fset [simp]: "\<L> (relable_fset_reg R) = \<L> R" + by (auto simp: \<L>_def relable_fset_reg_def) + +lemma ta_states_trim_ta: + "\<Q> (trim_ta Q \<A>) |\<subseteq>| \<Q> \<A>" + unfolding trim_ta_def using ta_prod_reach_states . + +lemma trim_ta_reach: "\<Q> (trim_ta Q \<A>) |\<subseteq>| ta_reachable (trim_ta Q \<A>)" + unfolding trim_ta_def using ta_only_prod_reachable ta_only_reach_reachable + by metis + +lemma trim_ta_prod: "\<Q> (trim_ta Q A) |\<subseteq>| ta_productive Q (trim_ta Q A)" + unfolding trim_ta_def using ta_only_prod_productive + by metis + +lemma empty_gta_lang: + "gta_lang Q (TA {||} {||}) = {}" + using ta_reachable_gtermI + by (force simp: gta_lang_def gta_der_def elim!: ta_langE) + +abbreviation empty_reg where + "empty_reg \<equiv> Reg {||} (TA {||} {||})" + +lemma \<L>_epmty: + "\<L> empty_reg = {}" + by (auto simp: \<L>_def empty_gta_lang) + +lemma const_ta_lang: + "gta_lang {|q|} (TA {| TA_rule f [] q |} {||}) = {GFun f []}" +proof - + have [dest!]: "q' |\<in>| ta_der (TA {| TA_rule f [] q |} {||}) t' \<Longrightarrow> ground t' \<Longrightarrow> t' = Fun f []" for t' q' + by (induct t') auto + show ?thesis + by (auto simp: gta_lang_def gta_der_def elim!: gta_langE) + (metis gterm_of_term.simps list.simps(8) term_of_gterm_inv) +qed + + +lemma run_argsD: + "run \<A> s t \<Longrightarrow> length (gargs s) = length (gargs t) \<and> (\<forall> i < length (gargs t). run \<A> (gargs s ! i) (gargs t ! i))" + using run.cases by fastforce + +lemma run_root_rule: + "run \<A> s t \<Longrightarrow> TA_rule (groot_sym t) (map ex_comp_state (gargs s)) (ex_rule_state s) |\<in>| (rules \<A>) \<and> + (ex_rule_state s = ex_comp_state s \<or> (ex_rule_state s, ex_comp_state s) |\<in>| (eps \<A>)|\<^sup>+|)" + by (cases s; cases t) (auto elim: run.cases) + +lemma run_poss_eq: "run \<A> s t \<Longrightarrow> gposs s = gposs t" + by (induct rule: run.induct) auto + +lemma run_gsubt_cl: + assumes "run \<A> s t" and "p \<in> gposs t" + shows "run \<A> (gsubt_at s p) (gsubt_at t p)" using assms +proof (induct p arbitrary: s t) + case (Cons i p) show ?case using Cons(1) Cons(2-) + by (cases s; cases t) (auto dest: run_argsD) +qed auto + +lemma run_replace_at: + assumes "run \<A> s t" and "run \<A> u v" and "p \<in> gposs s" + and "ex_comp_state (gsubt_at s p) = ex_comp_state u" + shows "run \<A> s[p \<leftarrow> u]\<^sub>G t[p \<leftarrow> v]\<^sub>G" using assms +proof (induct p arbitrary: s t) + case (Cons i p) + obtain r q qs f ts where [simp]: "s = GFun (r, q) qs" "t = GFun f ts" by (cases s, cases t) auto + have *: "j < length qs \<Longrightarrow> ex_comp_state (qs[i := (qs ! i)[p \<leftarrow> u]\<^sub>G] ! j) = ex_comp_state (qs ! j)" for j + using Cons(5) by (cases "i = j", cases p) auto + have [simp]: "map ex_comp_state (qs[i := (qs ! i)[p \<leftarrow> u]\<^sub>G]) = map ex_comp_state qs" using Cons(5) + by (auto simp: *[unfolded comp_def] intro!: nth_equalityI) + have "run \<A> (qs ! i)[p \<leftarrow> u]\<^sub>G (ts ! i)[p \<leftarrow> v]\<^sub>G" using Cons(2-) + by (intro Cons(1)) (auto dest: run_argsD) + moreover have "i < length qs" "i < length ts" using Cons(4) run_poss_eq[OF Cons(2)] + by force+ + ultimately show ?case using Cons(2) run_root_rule[OF Cons(2)] + by (fastforce simp: nth_list_update dest: run_argsD intro!: run.intros) +qed simp + +text \<open>relating runs to derivation definition\<close> + +lemma run_to_comp_st_gta_der: + "run \<A> s t \<Longrightarrow> ex_comp_state s |\<in>| gta_der \<A> t" +proof (induct s arbitrary: t) + case (GFun q qs) + show ?case using GFun(1)[OF nth_mem, of i "gargs t ! i" for i] + using run_argsD[OF GFun(2)] run_root_rule[OF GFun(2-)] + by (cases t) (auto simp: gta_der_def intro!: exI[of _ "map ex_comp_state qs"] exI[of _ "fst q"]) +qed + +lemma run_to_rule_st_gta_der: + assumes "run \<A> s t" shows "ex_rule_state s |\<in>| gta_der \<A> t" +proof (cases s) + case [simp]: (GFun q qs) + have "i < length qs \<Longrightarrow> ex_comp_state (qs ! i) |\<in>| gta_der \<A> (gargs t ! i)" for i + using run_to_comp_st_gta_der[of \<A>] run_argsD[OF assms] by force + then show ?thesis using conjunct1[OF run_argsD[OF assms]] run_root_rule[OF assms] + by (cases t) (auto simp: gta_der_def intro!: exI[of _ "map ex_comp_state qs"] exI[of _ "fst q"]) +qed + +lemma run_to_gta_der_gsubt_at: + assumes "run \<A> s t" and "p \<in> gposs t" + shows "ex_rule_state (gsubt_at s p) |\<in>| gta_der \<A> (gsubt_at t p)" + "ex_comp_state (gsubt_at s p) |\<in>| gta_der \<A> (gsubt_at t p)" + using assms run_gsubt_cl[THEN run_to_comp_st_gta_der] run_gsubt_cl[THEN run_to_rule_st_gta_der] + by blast+ + +lemma gta_der_to_run: + "q |\<in>| gta_der \<A> t \<Longrightarrow> (\<exists> p qs. run \<A> (GFun (p, q) qs) t)" unfolding gta_der_def +proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + from GFun(5) Ex_list_of_length_P[of "length ts" "\<lambda> qs i. run \<A> (GFun (fst qs, ps ! i) (snd qs)) (ts ! i)"] + obtain qss where mid: "length qss = length ts" "\<forall> i < length ts .run \<A> (GFun (fst (qss ! i), ps ! i) (snd (qss ! i))) (ts ! i)" + by auto + have [simp]: "map (ex_comp_state \<circ> (\<lambda>(qs, y). GFun (fst y, qs) (snd y))) (zip ps qss) = ps" using GFun(2) mid(1) + by (intro nth_equalityI) auto + show ?case using mid GFun(1 - 4) + by (intro exI[of _ p] exI[of _ "map2 (\<lambda> f args. GFun (fst args, f) (snd args)) ps qss"]) + (auto intro: run.intros) +qed + +lemma run_ta_der_ctxt_split1: + assumes "run \<A> s t" "p \<in> gposs t" + shows "ex_comp_state s |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm t) p)\<langle>Var (ex_comp_state (gsubt_at s p))\<rangle>" + using assms +proof (induct p arbitrary: s t) + case (Cons i p) + obtain q f qs ts where [simp]: "s = GFun q qs" "t = GFun f ts" and l: "length qs = length ts" + using run_argsD[OF Cons(2)] by (cases s, cases t) auto + from Cons(2, 3) l have "ex_comp_state (qs ! i) |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm (ts ! i)) p)\<langle>Var (ex_comp_state (gsubt_at (qs ! i) p))\<rangle>" + by (intro Cons(1)) (auto dest: run_argsD) + then show ?case using Cons(2-) l + by (fastforce simp: nth_append_Cons min_def dest: run_root_rule run_argsD + intro!: exI[of _ "map ex_comp_state (gargs s)"] exI[of _ "ex_rule_state s"] + run_to_comp_st_gta_der[of \<A> "qs ! i" "ts ! i" for i, unfolded comp_def gta_der_def]) +qed auto + + +lemma run_ta_der_ctxt_split2: + assumes "run \<A> s t" "p \<in> gposs t" + shows "ex_comp_state s |\<in>| ta_der \<A> (ctxt_at_pos (term_of_gterm t) p)\<langle>Var (ex_rule_state (gsubt_at s p))\<rangle>" +proof (cases "ex_rule_state (gsubt_at s p) = ex_comp_state (gsubt_at s p)") + case False then show ?thesis + using run_root_rule[OF run_gsubt_cl[OF assms]] + by (intro ta_der_eps_ctxt[OF run_ta_der_ctxt_split1[OF assms]]) auto +qed (auto simp: run_ta_der_ctxt_split1[OF assms, unfolded comp_def]) + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Abstract_Impl.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Abstract_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Abstract_Impl.thy @@ -0,0 +1,333 @@ +theory Tree_Automata_Abstract_Impl + imports Tree_Automata_Det Horn_Fset +begin + +section \<open>Computing state derivation\<close> + +lemma ta_der_Var_code [code]: + "ta_der \<A> (Var q) = finsert q ((eps \<A>)|\<^sup>+| |``| {|q|})" + by (auto) + +lemma ta_der_Fun_code [code]: + "ta_der \<A> (Fun f ts) = + (let args = map (ta_der \<A>) ts in + let P = (\<lambda> r. case r of TA_rule g ps p \<Rightarrow> f = g \<and> list_all2 fmember ps args) in + let S = r_rhs |`| ffilter P (rules \<A>) in + S |\<union>| (eps \<A>)|\<^sup>+| |``| S)" (is "?Ls = ?Rs") +proof + {fix q assume "q |\<in>| ?Ls" then have "q |\<in>| ?Rs" + by (auto simp: Let_def ffmember_filter fimage_iff fBex_def list_all2_conv_all_nth fImage_iff + split!: ta_rule.splits) force} + then show "?Ls |\<subseteq>| ?Rs" by blast +next + {fix q assume "q |\<in>| ?Rs" then have "q |\<in>| ?Ls" + apply (auto simp: Let_def ffmember_filter fimage_iff fBex_def list_all2_conv_all_nth fImage_iff + split!: ta_rule.splits) + apply (metis ta_rule.collapse) + apply blast + done} + then show "?Rs |\<subseteq>| ?Ls" by blast +qed + +definition eps_free_automata where + "eps_free_automata epscl \<A> = + (let ruleps = (\<lambda> r. finsert (r_rhs r) (epscl |``| {|r_rhs r|})) in + let rules = (\<lambda> r. (\<lambda> q. TA_rule (r_root r) (r_lhs_states r) q) |`| (ruleps r)) |`| (rules \<A>) in + TA ( |\<Union>| rules) {||})" + +lemma eps_free [code]: + "eps_free \<A> = eps_free_automata ((eps \<A>)|\<^sup>+|) \<A>" + apply (intro TA_equalityI) + apply (auto simp: eps_free_def eps_free_rulep_def eps_free_automata_def) + using fBex_def apply fastforce + apply (metis ta_rule.exhaust_sel)+ + done + + +lemma eps_of_eps_free_automata [simp]: + "eps (eps_free_automata S \<A>) = {||}" + by (auto simp add: eps_free_automata_def) + +lemma eps_free_automata_empty [simp]: + "eps \<A> = {||} \<Longrightarrow> eps_free_automata {||} \<A> = \<A>" + by (auto simp add: eps_free_automata_def intro!: TA_equalityI) + +section \<open>Computing the restriction of tree automata to state set\<close> + +lemma ta_restrict [code]: + "ta_restrict \<A> Q = + (let rules = ffilter (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> fset_of_list ps |\<subseteq>| Q \<and> p |\<in>| Q) (rules \<A>) in + let eps = ffilter (\<lambda> r. case r of (p, q) \<Rightarrow> p |\<in>| Q \<and> q |\<in>| Q) (eps \<A>) in + TA rules eps)" + by (auto simp: Let_def ta_restrict_def split!: ta_rule.splits intro: finite_subset[OF _ finite_Collect_ta_rule]) + + +section \<open>Computing the epsilon transition for the product automaton\<close> + +lemma prod_eps[code_unfold]: + "fCollect (prod_epsLp \<A> \) = (\<lambda> ((p, q), r). ((p, r), (q, r))) |`| (eps \<A> |\<times>| \<Q> \)" + "fCollect (prod_epsRp \<A> \) = (\<lambda> ((p, q), r). ((r, p), (r, q))) |`| (eps \ |\<times>| \<Q> \<A>)" + by (auto simp: finite_prod_epsLp prod_epsLp_def finite_prod_epsRp prod_epsRp_def fimage_iff fBex_def) + +section \<open>Computing reachability\<close> + +inductive_set ta_reach for \<A> where + rule [intro]: "f qs \<rightarrow> q |\<in>| rules \<A> \<Longrightarrow> \<forall> i < length qs. qs ! i \<in> ta_reach \<A> \<Longrightarrow> q \<in> ta_reach \<A>" + | eps [intro]: "q \<in> ta_reach \<A> \<Longrightarrow> (q, r) |\<in>| eps \<A> \<Longrightarrow> r \<in> ta_reach \<A>" + + +lemma ta_reach_eps_transI: + assumes "(p, q) |\<in>| (eps \<A>)|\<^sup>+|" "p \<in> ta_reach \<A>" + shows "q \<in> ta_reach \<A>" using assms + by (induct rule: ftrancl_induct) auto + +lemma ta_reach_ground_term_der: + assumes "q \<in> ta_reach \<A>" + shows "\<exists> t. ground t \<and> q |\<in>| ta_der \<A> t" using assms +proof (induct) + case (rule f qs q) + then obtain ts where "length ts = length qs" + "\<forall> i < length qs. ground (ts ! i)" + "\<forall> i < length qs. qs ! i |\<in>| ta_der \<A> (ts ! i)" + using Ex_list_of_length_P[of "length qs" "\<lambda> t i. ground t \<and> qs ! i |\<in>| ta_der \<A> t"] + by auto + then show ?case using rule(1) + by (auto dest!: in_set_idx intro!: exI[of _ "Fun f ts"]) blast +qed (auto, meson ta_der_eps) + +lemma ground_term_der_ta_reach: + assumes "ground t" "q |\<in>| ta_der \<A> t" + shows "q \<in> ta_reach \<A>" using assms(2, 1) + by (induct rule: ta_der_induct) (auto simp add: rule ta_reach_eps_transI) + +lemma ta_reach_reachable: + "ta_reach \<A> = fset (ta_reachable \<A>)" + using ta_reach_ground_term_der[of _ \<A>] + using ground_term_der_ta_reach[of _ _ \<A>] + unfolding ta_reachable_def + by (auto simp flip: fmember.rep_eq) + + +subsection \<open>Horn setup for reachable states\<close> +definition "reach_rules \<A> = + {qs \<rightarrow>\<^sub>h q | f qs q. TA_rule f qs q |\<in>| rules \<A>} \<union> + {[q] \<rightarrow>\<^sub>h r | q r. (q, r) |\<in>| eps \<A>}" + +locale reach_horn = + fixes \<A> :: "('q, 'f) ta" +begin + +sublocale horn "reach_rules \<A>" . + +lemma reach_infer0: "infer0 = {q | f q. TA_rule f [] q |\<in>| rules \<A>}" + by (auto simp: horn.infer0_def reach_rules_def) + +lemma reach_infer1: + "infer1 p X = {r | f qs r. TA_rule f qs r |\<in>| rules \<A> \<and> p \<in> set qs \<and> set qs \<subseteq> insert p X} \<union> + {r | r. (p, r) |\<in>| eps \<A>}" + unfolding reach_rules_def + by (auto simp: horn.infer1_def simp flip: ex_simps(1)) + +lemma reach_sound: + "ta_reach \<A> = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr x) obtain p where x: "p = ta_reach \<A>" by auto + show ?case using lr unfolding x + proof (induct) + case (rule f qs q) + then show ?case + by (intro infer[of qs q]) (auto simp: reach_rules_def dest: in_set_idx) + next + case (eps q r) + then show ?case + by (intro infer[of "[q]" r]) (auto simp: reach_rules_def) + qed +next + case (rl x) + then show ?case + by (induct) (auto simp: reach_rules_def) +qed +end + +subsection \<open>Computing productivity\<close> + +text \<open>First, use an alternative definition of productivity\<close> + +inductive_set ta_productive_ind :: "'q fset \<Rightarrow> ('q,'f) ta \<Rightarrow> 'q set" for P and \<A> :: "('q,'f) ta" where + basic [intro]: "q |\<in>| P \<Longrightarrow> q \<in> ta_productive_ind P \<A>" +| eps [intro]: "(p, q) |\<in>| (eps \<A>)|\<^sup>+| \<Longrightarrow> q \<in> ta_productive_ind P \<A> \<Longrightarrow> p \<in> ta_productive_ind P \<A>" +| rule: "TA_rule f qs q |\<in>| rules \<A> \<Longrightarrow> q \<in> ta_productive_ind P \<A> \<Longrightarrow> q' \<in> set qs \<Longrightarrow> q' \<in> ta_productive_ind P \<A>" + +lemma ta_productive_ind: + "ta_productive_ind P \<A> = fset (ta_productive P \<A>)" (is "?LS = ?RS") +proof - + {fix q assume "q \<in> ?LS" then have "q \<in> ?RS" + by (induct) (auto dest: ta_prod_epsD simp flip: fmember.rep_eq intro: ta_productive_setI, + metis (full_types) in_set_conv_nth rule_reachable_ctxt_exist ta_productiveI')} + moreover + {fix q assume "q \<in> ?RS" note * = this[unfolded fmember.rep_eq[symmetric]] + from ta_productiveE[OF *] obtain r C where + reach : "r |\<in>| ta_der \<A> C\<langle>Var q\<rangle>" and f: "r |\<in>| P" by auto + from f have "r \<in> ta_productive_ind P \<A>" "r |\<in>| ta_productive P \<A>" + by (auto intro: ta_productive_setI) + then have "q \<in> ?LS" using reach + proof (induct C arbitrary: q r) + case (More f ss C ts) + from iffD1 ta_der_Fun[THEN iffD1, OF More(4)[unfolded ctxt_apply_term.simps]] obtain ps p where + inv: "f ps \<rightarrow> p |\<in>| rules \<A>" "p = r \<or> (p, r) |\<in>| (eps \<A>)|\<^sup>+|" "length ps = length (ss @ C\<langle>Var q\<rangle> # ts)" + "ps ! length ss |\<in>| ta_der \<A> C\<langle>Var q\<rangle>" + by (auto simp: nth_append_Cons split: if_splits) + then have "p \<in> ta_productive_ind P \<A> \<Longrightarrow> p |\<in>| ta_der \<A> C\<langle>Var q\<rangle> \<Longrightarrow> q \<in> ta_productive_ind P \<A>" for p + using More(1) calculation by (auto simp flip: fmember.rep_eq) + note [intro!] = this[of "ps ! length ss"] + show ?case using More(2) inv + by (auto simp flip: fmember.rep_eq simp: nth_append_Cons ta_productive_ind.rule) + (metis less_add_Suc1 nth_mem ta_productive_ind.simps) + qed (auto intro: ta_productive_setI) + } + ultimately show ?thesis by auto +qed + + +subsubsection \<open>Horn setup for productive states\<close> + +definition "productive_rules P \<A> = {[] \<rightarrow>\<^sub>h q | q. q |\<in>| P} \<union> + {[r] \<rightarrow>\<^sub>h q | q r. (q, r) |\<in>| eps \<A>} \<union> + {[q] \<rightarrow>\<^sub>h r | f qs q r. TA_rule f qs q |\<in>| rules \<A> \<and> r \<in> set qs}" + +locale productive_horn = + fixes \<A> :: "('q, 'f) ta" and P :: "'q fset" +begin + +sublocale horn "productive_rules P \<A>" . + +lemma productive_infer0: "infer0 = fset P" + by (auto simp: productive_rules_def horn.infer0_def simp flip: fmember.rep_eq) + +lemma productive_infer1: + "infer1 p X = {r | r. (r, p) |\<in>| eps \<A>} \<union> + {r | f qs r. TA_rule f qs p |\<in>| rules \<A> \<and> r \<in> set qs}" + unfolding productive_rules_def horn_infer1_union + by (auto simp add: horn.infer1_def) + (metis insertCI list.set(1) list.simps(15) singletonD subsetI) + +lemma productive_sound: + "ta_productive_ind P \<A> = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr p) then show ?case using lr + proof (induct) + case (basic q) + then show ?case + by (intro infer[of "[]" q]) (auto simp: productive_rules_def) + next + case (eps p q) then show ?case + proof (induct rule: ftrancl_induct) + case (Base p q) + then show ?case using infer[of "[q]" p] + by (auto simp: productive_rules_def) + next + case (Step p q r) + then show ?case using infer[of "[r]" q] + by (auto simp: productive_rules_def) + qed + next + case (rule f qs q p) + then show ?case + by (intro infer[of "[q]" p]) (auto simp: productive_rules_def) + qed +next + case (rl p) + then show ?case + by (induct) (auto simp: productive_rules_def ta_productive_ind.rule) +qed +end + +subsection \<open>Horn setup for power set construction states\<close> + +lemma prod_list_exists: + assumes "fst p \<in> set qs" "set qs \<subseteq> insert (fst p) (fst ` X)" + obtains as where "p \<in> set as" "map fst as = qs" "set as \<subseteq> insert p X" +proof - + from assms have "qs \<in> lists (fst ` (insert p X))" by blast + then obtain ts where ts: "map fst ts = qs" "ts \<in> lists (insert p X)" + by (metis image_iff lists_image) + then obtain i where mem: "i < length qs" "qs ! i = fst p" using assms(1) + by (metis in_set_idx) + from ts have p: "ts[i := p] \<in> lists (insert p X)" + using set_update_subset_insert by fastforce + then have "p \<in> set (ts[i := p])" "map fst (ts[i := p]) = qs" "set (ts[i := p]) \<subseteq> insert p X" + using mem ts(1) + by (auto simp add: nth_list_update set_update_memI intro!: nth_equalityI) + then show ?thesis using that + by blast +qed + +definition "ps_states_rules \<A> = {rs \<rightarrow>\<^sub>h (Wrapp q) | rs f q. + q = ps_reachable_states \<A> f (map ex rs) \<and> q \<noteq> {||}}" + +locale ps_states_horn = + fixes \<A> :: "('q, 'f) ta" +begin + +sublocale horn "ps_states_rules \<A>" . + +lemma ps_construction_infer0: "infer0 = + {Wrapp q | f q. q = ps_reachable_states \<A> f [] \<and> q \<noteq> {||}}" + by (auto simp: ps_states_rules_def horn.infer0_def simp flip: fmember.rep_eq) + +lemma ps_construction_infer1: + "infer1 p X = {Wrapp q | f qs q. q = ps_reachable_states \<A> f (map ex qs) \<and> q \<noteq> {||} \<and> + p \<in> set qs \<and> set qs \<subseteq> insert p X}" + unfolding ps_states_rules_def horn_infer1_union + by (auto simp add: horn.infer1_def ps_reachable_states_def comp_def elim!: prod_list_exists) + +lemma ps_states_sound: + "ps_states_set \<A> = saturate" +proof (intro set_eqI iffI, goal_cases lr rl) + case (lr p) then show ?case using lr + proof (induct) + case (1 ps f) + then have "ps \<rightarrow>\<^sub>h (Wrapp (ps_reachable_states \<A> f (map ex ps))) \<in> ps_states_rules \<A>" + by (auto simp: ps_states_rules_def) + then show ?case using horn.saturate.simps 1 + by fastforce + qed +next + case (rl p) + then obtain q where "q \<in> saturate" "q = p" by blast + then show ?case + by (induct arbitrary: p) + (auto simp: ps_states_rules_def intro!: ps_states_set.intros) +qed + +end + +definition ps_reachable_states_cont where + "ps_reachable_states_cont \<Delta> \<Delta>\<^sub>\<epsilon> f ps = + (let R = ffilter (\<lambda> r. case r of TA_rule g qs q \<Rightarrow> f = g \<and> list_all2 (|\<in>|) qs ps) \<Delta> in + let S = r_rhs |`| R in + S |\<union>| \<Delta>\<^sub>\<epsilon>|\<^sup>+| |``| S)" + +lemma ps_reachable_states [code]: + "ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) f ps = ps_reachable_states_cont \<Delta> \<Delta>\<^sub>\<epsilon> f ps" + by (auto simp: ps_reachable_states_fmember ps_reachable_states_cont_def Let_def fimage_iff fBex_def + split!: ta_rule.splits) force+ + +definition ps_rules_cont where + "ps_rules_cont \<A> Q = + (let sig = ta_sig \<A> in + let qss = (\<lambda> (f, n). (f, n, fset_of_list (List.n_lists n (sorted_list_of_fset Q)))) |`| sig in + let res = (\<lambda> (f, n, Qs). (\<lambda> qs. TA_rule f qs (Wrapp (ps_reachable_states \<A> f (map ex qs)))) |`| Qs) |`| qss in + ffilter (\<lambda> r. ex (r_rhs r) \<noteq> {||}) ( |\<Union>| res))" + +lemma ps_rules [code]: + "ps_rules \<A> Q = ps_rules_cont \<A> Q" + using ps_reachable_states_sig finite_ps_rulesp_unfolded[of Q \<A>] + unfolding ps_rules_cont_def + apply (auto simp: fset_of_list_elem ps_rules_def fin_mono ps_rulesp_def + fimage_iff set_n_lists simp flip: fmember.rep_eq split!: prod.splits dest!: in_set_idx) + apply fastforce + apply (meson fmember.rep_eq nth_mem subsetD) + done + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Class_Instances_Impl.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Class_Instances_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Class_Instances_Impl.thy @@ -0,0 +1,233 @@ +theory Tree_Automata_Class_Instances_Impl + imports Tree_Automata + Deriving.Compare_Instances + Containers.Collection_Order + Containers.Collection_Eq + Containers.Collection_Enum + Containers.Set_Impl + Containers.Mapping_Impl +begin + +derive linorder ta_rule +derive linorder "term" +derive compare "term" +derive (compare) ccompare "term" +derive ceq ta_rule +derive (eq) ceq fset +derive (eq) ceq FSet_Lex_Wrapper +derive (no) cenum ta_rule +derive (no) cenum FSet_Lex_Wrapper +derive ccompare ta_rule +derive (eq) ceq "term" ctxt +derive (no) cenum "term" +derive (rbt) set_impl fset FSet_Lex_Wrapper ta_rule "term" + + +instantiation fset :: (linorder) compare +begin +definition compare_fset :: "('a fset \<Rightarrow> 'a fset \<Rightarrow> order)" + where "compare_fset = (\<lambda> A B. + (let A' = sorted_list_of_fset A in + let B' = sorted_list_of_fset B in + if A' < B' then Lt else if B' < A' then Gt else Eq))" +instance + apply intro_classes apply (auto simp: compare_fset_def comparator_def Let_def split!: if_splits) + using sorted_list_of_fset_id apply blast+ + done +end + +instantiation fset :: (linorder) ccompare +begin +definition ccompare_fset :: "('a fset \<Rightarrow> 'a fset \<Rightarrow> order) option" + where "ccompare_fset = Some (\<lambda> A B. + (let A' = sorted_list_of_fset A in + let B' = sorted_list_of_fset B in + if A' < B' then Lt else if B' < A' then Gt else Eq))" +instance + apply intro_classes apply (auto simp: ccompare_fset_def comparator_def Let_def split!: if_splits) + using sorted_list_of_fset_id apply blast+ + done +end + +instantiation FSet_Lex_Wrapper :: (linorder) compare +begin + +definition compare_FSet_Lex_Wrapper :: "'a FSet_Lex_Wrapper \<Rightarrow> 'a FSet_Lex_Wrapper \<Rightarrow> order" + where "compare_FSet_Lex_Wrapper = (\<lambda> A B. + (let A' = sorted_list_of_fset (ex A) in + let B' = sorted_list_of_fset (ex B) in + if A' < B' then Lt else if B' < A' then Gt else Eq))" + +instance + apply intro_classes apply (auto simp: compare_FSet_Lex_Wrapper_def comparator_def Let_def split!: if_splits) + using sorted_list_of_fset_id + by (metis FSet_Lex_Wrapper.expand) +end + +instantiation FSet_Lex_Wrapper :: (linorder) ccompare +begin + +definition ccompare_FSet_Lex_Wrapper :: "('a FSet_Lex_Wrapper \<Rightarrow> 'a FSet_Lex_Wrapper \<Rightarrow> order) option" + where "ccompare_FSet_Lex_Wrapper = Some (\<lambda> A B. + (let A' = sorted_list_of_fset (ex A) in + let B' = sorted_list_of_fset (ex B) in + if A' < B' then Lt else if B' < A' then Gt else Eq))" + +instance + apply intro_classes apply (auto simp: ccompare_FSet_Lex_Wrapper_def comparator_def Let_def split!: if_splits) + using sorted_list_of_fset_id + by (metis FSet_Lex_Wrapper.expand) +end + +lemma infinite_ta_rule_UNIV[simp, intro]: "infinite (UNIV :: ('q,'f) ta_rule set)" +proof - + fix f :: 'f + fix q :: 'q + let ?map = "\<lambda> n. (f (replicate n q) \<rightarrow> q)" + have "inj ?map" unfolding inj_on_def by auto + from infinite_super[OF _ range_inj_infinite[OF this]] + show ?thesis by blast +qed + +instantiation ta_rule :: (type, type) card_UNIV begin +definition "finite_UNIV = Phantom(('a, 'b) ta_rule) False" +definition "card_UNIV = Phantom(('a, 'b)ta_rule) 0" +instance + by intro_classes + (simp_all add: infinite_ta_rule_UNIV card_UNIV_ta_rule_def finite_UNIV_ta_rule_def) +end + +instantiation ta_rule :: (ccompare,ccompare)cproper_interval +begin +definition "cproper_interval = (\<lambda> ( _ :: ('a,'b)ta_rule option) _ . False)" +instance by (intro_classes, auto) +end + +lemma finite_finite_Fpow: + assumes "finite A" + shows "finite (Fpow A)" using assms +proof (induct A) + case (insert x F) + {fix X assume ass: "X \<subseteq> insert x F \<and> finite X" + then have "X - {x} \<subseteq> F" using ass by auto + then have fpow :"X - {x} \<in> Fpow F" using conjunct2[OF ass] + by (auto simp: Fpow_def) + have "X \<in> Fpow F \<union> insert x ` Fpow F" + proof (cases "x \<in> X") + case True + then have "X \<in> insert x ` Fpow F" using fpow + by (metis True image_eqI insert_Diff) + then show ?thesis by simp + next + case False + then show ?thesis using fpow by simp + qed} + then have *: "Fpow (insert x F) = Fpow F \<union> insert x ` Fpow F" + by (auto simp add: Fpow_def image_def) + show ?case using insert unfolding * + by simp +qed (auto simp: Fpow_def) + +lemma infinite_infinite_Fpow: + assumes "infinite A" + shows "infinite (Fpow A)" +proof - + have inj: "inj (\<lambda> S. {S})" by auto + have "(\<lambda> S. {S}) ` A \<subseteq> Fpow A" by (auto simp: Fpow_def) + from finite_subset[OF this] inj assms + show ?thesis + by (auto simp: finite_image_iff) +qed + +lemma inj_on_Abs_fset: + "(\<And> X. X \<in> A \<Longrightarrow> finite X) \<Longrightarrow> inj_on Abs_fset A" unfolding inj_on_def + by (auto simp add: Abs_fset_inject) + +lemma UNIV_FSet_Lex_Wrapper: + "(UNIV :: 'a FSet_Lex_Wrapper set) = (Wrapp \<circ> Abs_fset) ` (Fpow (UNIV :: 'a set))" + by (simp add: image_def Fpow_def) (metis (mono_tags, lifting) Abs_fset_cases FSet_Lex_Wrapper.exhaust UNIV_eq_I mem_Collect_eq) + +lemma FSet_Lex_Wrapper_UNIV: + "(UNIV :: 'a FSet_Lex_Wrapper set) = (Wrapp \<circ> Abs_fset) ` (Fpow (UNIV :: 'a set))" + by (simp add: comp_def image_def Fpow_def) + (metis (mono_tags, lifting) Abs_fset_cases Abs_fset_inverse Collect_cong FSet_Lex_Wrapper.induct iso_tuple_UNIV_I mem_Collect_eq top_set_def) + +lemma Wrapp_Abs_fset_inj: + "inj_on (Wrapp \<circ> Abs_fset) (Fpow A)" + using inj_on_Abs_fset inj_FSet_Lex_Wrapper Fpow_def + by (auto simp: inj_on_def inj_def) + +lemma infinite_FSet_Lex_Wrapper_UNIV: + assumes "infinite (UNIV :: 'a set)" + shows "infinite (UNIV :: 'a FSet_Lex_Wrapper set)" +proof - + let ?FP = "Fpow (UNIV :: 'a set)" + have "finite ((Wrapp \<circ> Abs_fset) ` ?FP) \<Longrightarrow> finite ?FP" + using finite_image_iff[OF Wrapp_Abs_fset_inj] + by (auto simp: inj_on_def inj_def) + then show ?thesis unfolding FSet_Lex_Wrapper_UNIV using infinite_infinite_Fpow[OF assms] + by auto +qed + +lemma finite_FSet_Lex_Wrapper_UNIV: + assumes "finite (UNIV :: 'a set)" + shows "finite (UNIV :: 'a FSet_Lex_Wrapper set)" using assms + unfolding FSet_Lex_Wrapper_UNIV + using finite_image_iff[OF Wrapp_Abs_fset_inj] + using finite_finite_Fpow[OF assms] + by simp + +instantiation FSet_Lex_Wrapper :: (finite_UNIV) finite_UNIV begin +definition "finite_UNIV = Phantom('a FSet_Lex_Wrapper) + (of_phantom (finite_UNIV :: 'a finite_UNIV))" +instance using infinite_FSet_Lex_Wrapper_UNIV + by intro_classes + (auto simp add: finite_UNIV_FSet_Lex_Wrapper_def finite_UNIV finite_FSet_Lex_Wrapper_UNIV) +end + + +instantiation FSet_Lex_Wrapper :: (linorder) cproper_interval begin +fun cproper_interval_FSet_Lex_Wrapper :: "'a FSet_Lex_Wrapper option \<Rightarrow> 'a FSet_Lex_Wrapper option \<Rightarrow> bool" where + "cproper_interval_FSet_Lex_Wrapper None None \<longleftrightarrow> True" +| "cproper_interval_FSet_Lex_Wrapper None (Some B) \<longleftrightarrow> (\<exists> Z. sorted_list_of_fset (ex Z) < sorted_list_of_fset (ex B))" +| "cproper_interval_FSet_Lex_Wrapper (Some A) None \<longleftrightarrow> (\<exists> Z. sorted_list_of_fset (ex A) < sorted_list_of_fset (ex Z))" +| "cproper_interval_FSet_Lex_Wrapper (Some A) (Some B) \<longleftrightarrow> (\<exists> Z. sorted_list_of_fset (ex A) < sorted_list_of_fset (ex Z) \<and> + sorted_list_of_fset (ex Z) < sorted_list_of_fset (ex B))" +declare cproper_interval_FSet_Lex_Wrapper.simps [code del] + +lemma lt_of_comp_sorted_list [simp]: + "ID ccompare = Some f \<Longrightarrow> lt_of_comp f X Z \<longleftrightarrow> sorted_list_of_fset (ex X) < sorted_list_of_fset (ex Z)" + by (auto simp: lt_of_comp_def ID_code ccompare_FSet_Lex_Wrapper_def Let_def split!: if_splits) + +instance by (intro_classes) (auto simp: class.proper_interval_def) +end + + + +lemma infinite_term_UNIV[simp, intro]: "infinite (UNIV :: ('f,'v)term set)" +proof - + fix f :: 'f and v :: 'v + let ?inj = "\<lambda>n. Fun f (replicate n (Var v))" + have "inj ?inj" unfolding inj_on_def by auto + from infinite_super[OF _ range_inj_infinite[OF this]] + show ?thesis by blast +qed + +instantiation "term" :: (type,type) finite_UNIV +begin +definition "finite_UNIV = Phantom(('a,'b)term) False" +instance + by (intro_classes, unfold finite_UNIV_term_def, simp) +end + + + +instantiation "term" :: (compare,compare) cproper_interval +begin +definition "cproper_interval = (\<lambda> ( _ :: ('a,'b)term option) _ . False)" +instance by (intro_classes, auto) +end + +derive (assoclist) mapping_impl FSet_Lex_Wrapper + +end diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Complement.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Complement.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Complement.thy @@ -0,0 +1,193 @@ +theory Tree_Automata_Complement + imports Tree_Automata_Det +begin + +subsection \<open>Complement closure of regular languages\<close> + +definition partially_completely_defined_on where + "partially_completely_defined_on \<A> \<F> \<longleftrightarrow> + (\<forall> t. funas_gterm t \<subseteq> fset \<F> \<longleftrightarrow> (\<exists> q. q |\<in>| ta_der \<A> (term_of_gterm t)))" + +definition sig_ta where + "sig_ta \<F> = TA ((\<lambda> (f, n). TA_rule f (replicate n ()) ()) |`| \<F>) {||}" + +lemma sig_ta_rules_fmember: + "TA_rule f qs q |\<in>| rules (sig_ta \<F>) \<longleftrightarrow> (\<exists> n. (f, n) |\<in>| \<F> \<and> qs = replicate n () \<and> q = ())" + by (auto simp: sig_ta_def fimage_iff fBex_def) + +lemma sig_ta_completely_defined: + "partially_completely_defined_on (sig_ta \<F>) \<F>" +proof - + {fix t assume "funas_gterm t \<subseteq> fset \<F>" + then have "() |\<in>| ta_der (sig_ta \<F>) (term_of_gterm t)" + proof (induct t) + case (GFun f ts) + then show ?case + by (auto simp: sig_ta_rules_fmember SUP_le_iff + simp flip: fmember.rep_eq intro!: exI[of _ "replicate (length ts) ()"]) + qed} + moreover + {fix t q assume "q |\<in>| ta_der (sig_ta \<F>) (term_of_gterm t)" + then have "funas_gterm t \<subseteq> fset \<F>" + proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + from GFun(1 - 4) GFun(5)[THEN subsetD] show ?case + by (auto simp: sig_ta_rules_fmember simp flip: fmember.rep_eq dest!: in_set_idx) + qed} + ultimately show ?thesis + unfolding partially_completely_defined_on_def + by blast +qed + +lemma ta_der_fsubset_sig_ta_completely: + assumes "ta_subset (sig_ta \<F>) \<A>" "ta_sig \<A> |\<subseteq>| \<F>" + shows "partially_completely_defined_on \<A> \<F>" +proof - + have "ta_der (sig_ta \<F>) t |\<subseteq>| ta_der \<A> t" for t + using assms by (simp add: ta_der_mono') + then show ?thesis using sig_ta_completely_defined assms(2) + by (auto simp: partially_completely_defined_on_def) + (metis ffunas_gterm.rep_eq fin_mono notin_fset ta_der_gterm_sig) +qed + +lemma completely_definied_ps_taI: + "partially_completely_defined_on \<A> \<F> \<Longrightarrow> partially_completely_defined_on (ps_ta \<A>) \<F>" + unfolding partially_completely_defined_on_def + using ps_rules_not_empty_reach[of \<A>] + using fsubsetD[OF ps_rules_sound[of _ \<A>]] ps_rules_complete[of _ \<A>] + by (metis FSet_Lex_Wrapper.collapse fsubsetI fsubset_fempty) + +lemma completely_definied_ta_union1I: + "partially_completely_defined_on \<A> \<F> \<Longrightarrow> ta_sig \ |\<subseteq>| \<F> \<Longrightarrow> \<Q> \<A> |\<inter>| \<Q> \ = {||} \<Longrightarrow> + partially_completely_defined_on (ta_union \<A> \) \<F>" + unfolding partially_completely_defined_on_def + using ta_union_der_disj_states'[of \<A> \] + by (auto simp: ta_union_der_disj_states) + (metis ffunas_gterm.rep_eq fsubset_trans less_eq_fset.rep_eq ta_der_gterm_sig) + +lemma completely_definied_fmaps_statesI: + "partially_completely_defined_on \<A> \<F> \<Longrightarrow> finj_on f (\<Q> \<A>) \<Longrightarrow> partially_completely_defined_on (fmap_states_ta f \<A>) \<F>" + unfolding partially_completely_defined_on_def + using fsubsetD[OF ta_der_fmap_states_ta_mono2, of f \<A>] + using ta_der_to_fmap_states_der[of _ \<A> _ f] + by (auto simp: fimage_iff fBex_def) fastforce+ + +lemma det_completely_defined_complement: + assumes "partially_completely_defined_on \<A> \<F>" "ta_det \<A>" + shows "gta_lang (\<Q> \<A> |-| Q) \<A> = \<T>\<^sub>G (fset \<F>) - gta_lang Q \<A>" (is "?Ls = ?Rs") +proof - + {fix t assume "t \<in> ?Ls" + then obtain p where p: "p |\<in>| \<Q> \<A>" "p |\<notin>| Q" "p |\<in>| ta_der \<A> (term_of_gterm t)" + by auto + from ta_detE[OF assms(2) p(3)] have "\<forall> q. q |\<in>| ta_der \<A> (term_of_gterm t) \<longrightarrow> q = p" + by blast + moreover have "funas_gterm t \<subseteq> fset \<F>" + using p(3) assms(1) unfolding partially_completely_defined_on_def + by (auto simp: less_eq_fset.rep_eq ffunas_gterm.rep_eq) + ultimately have "t \<in> ?Rs" using p(2) + by (auto simp: \<T>\<^sub>G_equivalent_def)} + moreover + {fix t assume "t \<in> ?Rs" + then have f: "funas_gterm t \<subseteq> fset \<F>" "\<forall> q. q |\<in>| ta_der \<A> (term_of_gterm t) \<longrightarrow> q |\<notin>| Q" + by (auto simp: \<T>\<^sub>G_equivalent_def) + from f(1) obtain p where "p |\<in>| ta_der \<A> (term_of_gterm t)" using assms(1) + by (force simp: partially_completely_defined_on_def) + then have "t \<in> ?Ls" using f(2) + by (auto simp: gterm_ta_der_states intro: gta_langI[of p])} + ultimately show ?thesis by blast +qed + +lemma ta_der_gterm_sig_fset: + "q |\<in>| ta_der \<A> (term_of_gterm t) \<Longrightarrow> funas_gterm t \<subseteq> fset (ta_sig \<A>)" + using ta_der_gterm_sig + by (metis ffunas_gterm.rep_eq less_eq_fset.rep_eq) + +definition filter_ta_sig where + "filter_ta_sig \<F> \<A> = TA (ffilter (\<lambda> r. (r_root r, length (r_lhs_states r)) |\<in>| \<F>) (rules \<A>)) (eps \<A>)" + +definition filter_ta_reg where + "filter_ta_reg \<F> R = Reg (fin R) (filter_ta_sig \<F> (ta R))" + +lemma filter_ta_sig: + "ta_sig (filter_ta_sig \<F> \<A>) |\<subseteq>| \<F>" + by (auto simp: ta_sig_def filter_ta_sig_def) + +lemma filter_ta_sig_lang: + "gta_lang Q (filter_ta_sig \<F> \<A>) = gta_lang Q \<A> \<inter> \<T>\<^sub>G (fset \<F>)" (is "?Ls = ?Rs") +proof - + let ?A = "filter_ta_sig \<F> \<A>" + {fix t assume "t \<in> ?Ls" + then obtain q where q: "q |\<in>| Q" "q |\<in>| ta_der ?A (term_of_gterm t)" + by auto + then have "funas_gterm t \<subseteq> fset \<F>" + using subset_trans[OF ta_der_gterm_sig_fset[OF q(2)] filter_ta_sig[unfolded less_eq_fset.rep_eq]] + by blast + then have "t \<in> ?Rs" using q + by (auto simp: \<T>\<^sub>G_equivalent_def filter_ta_sig_def + intro!: gta_langI[of q] ta_der_el_mono[where ?q = q and \ = \<A> and \<A> = ?A])} + moreover + {fix t assume ass: "t \<in> ?Rs" + then have funas: "funas_gterm t \<subseteq> fset \<F>" + by (auto simp: \<T>\<^sub>G_equivalent_def) + from ass obtain p where p: "p |\<in>| Q" "p |\<in>| ta_der \<A> (term_of_gterm t)" + by auto + from this(2) funas have "p |\<in>| ta_der ?A (term_of_gterm t)" + proof (induct rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then show ?case + by (auto simp: filter_ta_sig_def SUP_le_iff simp flip: fmember.rep_eq + intro!: exI[of _ ps] exI[of _ p]) + qed + then have "t \<in> ?Ls" using p(1) by auto} + ultimately show ?thesis by blast +qed + +lemma \<L>_filter_ta_reg: + "\<L> (filter_ta_reg \<F> \<A>) = \<L> \<A> \<inter> \<T>\<^sub>G (fset \<F>)" + using filter_ta_sig_lang + by (auto simp: \<L>_def filter_ta_reg_def) + +definition sig_ta_reg where + "sig_ta_reg \<F> = Reg {||} (sig_ta \<F>)" + +lemma \<L>_sig_ta_reg: + "\<L> (sig_ta_reg \<F>) = {}" + by (auto simp: \<L>_def sig_ta_reg_def) + +definition complement_reg where + "complement_reg R \<F> = (let \<A> = ps_reg (reg_union (sig_ta_reg \<F>) R) in + Reg (\<Q>\<^sub>r \<A> |-| fin \<A>) (ta \<A>))" + +lemma \<L>_complement_reg: + assumes "ta_sig (ta \<A>) |\<subseteq>| \<F>" + shows "\<L> (complement_reg \<A> \<F>) = \<T>\<^sub>G (fset \<F>) - \<L> \<A>" +proof - + have "\<L> (complement_reg \<A> \<F>) = \<T>\<^sub>G (fset \<F>) - \<L> (ps_reg (reg_union (sig_ta_reg \<F>) \<A>))" + unfolding \<L>_def complement_reg_def using assms + by (auto simp: complement_reg_def Let_def ps_reg_def reg_union_def sig_ta_reg_def + sig_ta_completely_defined finj_Inl_Inr + intro!: det_completely_defined_complement completely_definied_ps_taI + completely_definied_ta_union1I completely_definied_fmaps_statesI) + then show ?thesis + by (auto simp: \<L>_ps_reg \<L>_union \<L>_sig_ta_reg) +qed + +lemma \<L>_complement_filter_reg: + "\<L> (complement_reg (filter_ta_reg \<F> \<A>) \<F>) = \<T>\<^sub>G (fset \<F>) - \<L> \<A>" +proof - + have *: "ta_sig (ta (filter_ta_reg \<F> \<A>)) |\<subseteq>| \<F>" + by (auto simp: filter_ta_reg_def filter_ta_sig) + show ?thesis unfolding \<L>_complement_reg[OF *] \<L>_filter_ta_reg + by blast +qed + +definition difference_reg where + "difference_reg R L = (let F = ta_sig (ta R) in + reg_intersect R (trim_reg (complement_reg (filter_ta_reg F L) F)))" + +lemma \<L>_difference_reg: + "\<L> (difference_reg R L) = \<L> R - \<L> L" (is "?Ls = ?Rs") + unfolding difference_reg_def Let_def \<L>_trim \<L>_intersect \<L>_complement_filter_reg + using reg_funas by blast + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Det.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Det.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Det.thy @@ -0,0 +1,268 @@ +theory Tree_Automata_Det +imports + Tree_Automata +begin + +subsection \<open>Powerset Construction for Tree Automata\<close> + +text \<open> +The idea to treat states and transitions separately is from arXiv:1511.03595. Some parts of +the implementation are also based on that paper. (The Algorithm corresponds roughly to the one +in "Step 5") +\<close> + +text \<open>Abstract Definitions and Correctness Proof\<close> + +definition ps_reachable_statesp where + "ps_reachable_statesp \<A> f ps = (\<lambda> q'. \<exists> qs q. TA_rule f qs q |\<in>| rules \<A> \<and> list_all2 (|\<in>|) qs ps \<and> + (q = q' \<or> (q,q') |\<in>| (eps \<A>)|\<^sup>+|))" + +lemma ps_reachable_statespE: + assumes "ps_reachable_statesp \<A> f qs q" + obtains ps p where "TA_rule f ps p |\<in>| rules \<A>" "list_all2 (|\<in>|) ps qs" "(p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)" + using assms unfolding ps_reachable_statesp_def + by auto + +lemma ps_reachable_statesp_\<Q>: + "ps_reachable_statesp \<A> f ps q \<Longrightarrow> q |\<in>| \<Q> \<A>" + by (auto simp: ps_reachable_statesp_def simp flip: fmember.rep_eq dest: rule_statesD eps_trancl_statesD) + +lemma finite_Collect_ps_statep [simp]: + "finite (Collect (ps_reachable_statesp \<A> f ps))" (is "finite ?S") + by (intro finite_subset[of ?S "fset (\<Q> \<A>)"]) + (auto simp: ps_reachable_statesp_\<Q> simp flip: fmember.rep_eq) +lemmas finite_Collect_ps_statep_unfolded [simp] = finite_Collect_ps_statep[unfolded ps_reachable_statesp_def, simplified] + +definition "ps_reachable_states \<A> f ps \<equiv> fCollect (ps_reachable_statesp \<A> f ps)" + +lemmas ps_reachable_states_simp = ps_reachable_statesp_def ps_reachable_states_def + +lemma ps_reachable_states_fmember: + "q' |\<in>| ps_reachable_states \<A> f ps \<longleftrightarrow> (\<exists> qs q. TA_rule f qs q |\<in>| rules \<A> \<and> + list_all2 (|\<in>|) qs ps \<and> (q = q' \<or> (q, q') |\<in>| (eps \<A>)|\<^sup>+|))" + by (auto simp: ps_reachable_states_simp) + +lemma ps_reachable_statesI: + assumes "TA_rule f ps p |\<in>| rules \<A>" "list_all2 (|\<in>|) ps qs" "(p = q \<or> (p, q) |\<in>| (eps \<A>)|\<^sup>+|)" + shows "p |\<in>| ps_reachable_states \<A> f qs" + using assms unfolding ps_reachable_states_simp + by auto + +lemma ps_reachable_states_sig: + "ps_reachable_states \<A> f ps \<noteq> {||} \<Longrightarrow> (f, length ps) |\<in>| ta_sig \<A>" + by (auto simp: ps_reachable_states_simp ta_sig_def fimage_iff fBex_def dest!: list_all2_lengthD) + +text \<open> +A set of "powerset states" is complete if it is sufficient to capture all (non)deterministic +derivations. +\<close> + +definition ps_states_complete_it :: "('a, 'b) ta \<Rightarrow> 'a FSet_Lex_Wrapper fset \<Rightarrow> 'a FSet_Lex_Wrapper fset \<Rightarrow> bool" + where "ps_states_complete_it \<A> Q Qnext \<equiv> + \<forall>f ps. fset_of_list ps |\<subseteq>| Q \<and> ps_reachable_states \<A> f (map ex ps) \<noteq> {||} \<longrightarrow> Wrapp (ps_reachable_states \<A> f (map ex ps)) |\<in>| Qnext" + +lemma ps_states_complete_itD: + "ps_states_complete_it \<A> Q Qnext \<Longrightarrow> fset_of_list ps |\<subseteq>| Q \<Longrightarrow> + ps_reachable_states \<A> f (map ex ps) \<noteq> {||} \<Longrightarrow> Wrapp (ps_reachable_states \<A> f (map ex ps)) |\<in>| Qnext" + unfolding ps_states_complete_it_def by blast + +abbreviation "ps_states_complete \<A> Q \<equiv> ps_states_complete_it \<A> Q Q" + +text \<open>The least complete set of states\<close> +inductive_set ps_states_set for \<A> where + "\<forall> p \<in> set ps. p \<in> ps_states_set \<A> \<Longrightarrow> ps_reachable_states \<A> f (map ex ps) \<noteq> {||} \<Longrightarrow> + Wrapp (ps_reachable_states \<A> f (map ex ps)) \<in> ps_states_set \<A>" + +lemma ps_states_Pow: + "ps_states_set \<A> \<subseteq> fset (Wrapp |`| fPow (\<Q> \<A>))" +proof - + {fix q assume "q \<in> ps_states_set \<A>" then have "q \<in> fset (Wrapp |`| fPow (\<Q> \<A>))" + by induct (auto simp: ps_reachable_statesp_\<Q> ps_reachable_states_def image_iff simp flip: fmember.rep_eq)} + then show ?thesis by blast +qed + +context +includes fset.lifting +begin +lift_definition ps_states :: "('a, 'b) ta \<Rightarrow> 'a FSet_Lex_Wrapper fset" is ps_states_set + by (auto intro: finite_subset[OF ps_states_Pow]) + +lemma ps_states: "ps_states \<A> |\<subseteq>| Wrapp |`| fPow (\<Q> \<A>)" using ps_states_Pow + by (simp add: ps_states_Pow less_eq_fset.rep_eq ps_states.rep_eq) + +lemmas ps_states_cases = ps_states_set.cases[Transfer.transferred] +lemmas ps_states_induct = ps_states_set.induct[Transfer.transferred] +lemmas ps_states_simps = ps_states_set.simps[Transfer.transferred] +lemmas ps_states_intros= ps_states_set.intros[Transfer.transferred] +end + +lemma ps_states_complete: + "ps_states_complete \<A> (ps_states \<A>)" + unfolding ps_states_complete_it_def + by (auto intro: ps_states_intros) + +lemma ps_states_least_complete: + assumes "ps_states_complete_it \<A> Q Qnext" "Qnext |\<subseteq>| Q" + shows "ps_states \<A> |\<subseteq>| Q" +proof standard + fix q assume ass: "q |\<in>| ps_states \<A>" then show "q |\<in>| Q" + using ps_states_complete_itD[OF assms(1)] fsubsetD[OF assms(2)] + by (induct rule: ps_states_induct[of _ \<A>]) (fastforce intro: ass)+ +qed + +definition ps_rulesp :: "('a, 'b) ta \<Rightarrow> 'a FSet_Lex_Wrapper fset \<Rightarrow> ('a FSet_Lex_Wrapper, 'b) ta_rule \<Rightarrow> bool" where + "ps_rulesp \<A> Q = (\<lambda> r. \<exists> f ps p. r = TA_rule f ps (Wrapp p) \<and> fset_of_list ps |\<subseteq>| Q \<and> + p = ps_reachable_states \<A> f (map ex ps) \<and> p \<noteq> {||})" + +definition "ps_rules" where + "ps_rules \<A> Q \<equiv> fCollect (ps_rulesp \<A> Q)" + +lemma finite_ps_rulesp [simp]: + "finite (Collect (ps_rulesp \<A> Q))" (is "finite ?S") +proof - + let ?Q = "fset (Wrapp |`| fPow (\<Q> \<A>) |\<union>| Q)" let ?sig = "fset (ta_sig \<A>)" + define args where "args \<equiv> \<Union> (f,n) \<in> ?sig. {qs| qs. set qs \<subseteq> ?Q \<and> length qs = n}" + define bound where "bound \<equiv> \<Union>(f,_) \<in> ?sig. \<Union>q \<in> ?Q. \<Union>qs \<in> args. {TA_rule f qs q}" + have finite: "finite ?Q" "finite ?sig" by (auto intro: finite_subset) + then have "finite args" using finite_lists_length_eq[OF \<open>finite ?Q\<close>] + by (force simp: args_def) + with finite have "finite bound" unfolding bound_def by (auto simp only: finite_UN) + moreover have "Collect (ps_rulesp \<A> Q) \<subseteq> bound" + proof standard + fix r assume *: "r \<in> Collect (ps_rulesp \<A> Q)" + obtain f ps p where r[simp]: "r = TA_rule f ps p" by (cases r) + from * obtain qs q where "TA_rule f qs q |\<in>| rules \<A>" and len: "length ps = length qs" + unfolding ps_rulesp_def ps_reachable_states_simp + using list_all2_lengthD by fastforce + from this have sym: "(f, length qs) \<in> ?sig" + by (auto simp flip: fmember.rep_eq) + moreover from * have "set ps \<subseteq> ?Q" unfolding ps_rulesp_def + by (auto simp flip: fset_of_list_elem fmember.rep_eq simp: ps_reachable_statesp_def) + ultimately have ps: "ps \<in> args" + by (auto simp only: args_def UN_iff intro!: bexI[of _ "(f, length qs)"] len) + from * have "p \<in> ?Q" unfolding ps_rulesp_def ps_reachable_states_def + using fmember.rep_eq ps_reachable_statesp_\<Q> + by (fastforce simp add: image_iff) + with ps sym show "r \<in> bound" + by (auto simp only: r bound_def UN_iff intro!: bexI[of _ "(f, length qs)"] bexI[of _ "p"] bexI[of _ "ps"]) + qed + ultimately show ?thesis by (blast intro: finite_subset) +qed + +lemmas finite_ps_rulesp_unfolded = finite_ps_rulesp[unfolded ps_rulesp_def, simplified] + +lemmas ps_rulesI [intro!] = fCollect_memberI[OF finite_ps_rulesp] + +lemma ps_rules_states: + "rule_states (fCollect (ps_rulesp \<A> Q)) |\<subseteq>| (Wrapp |`| fPow (\<Q> \<A>) |\<union>| Q)" + by (auto simp: ps_rulesp_def rule_states_def ps_reachable_states_def ps_reachable_statesp_\<Q>) blast + +definition ps_ta :: "('q, 'f) ta \<Rightarrow> ('q FSet_Lex_Wrapper, 'f) ta" where + "ps_ta \<A> = (let Q = ps_states \<A> in + TA (ps_rules \<A> Q) {||})" + +definition ps_ta_Q\<^sub>f :: "'q fset \<Rightarrow> ('q, 'f) ta \<Rightarrow> 'q FSet_Lex_Wrapper fset" where + "ps_ta_Q\<^sub>f Q \<A> = (let Q' = ps_states \<A> in + ffilter (\<lambda> S. Q |\<inter>| (ex S) \<noteq> {||}) Q')" + +lemma ps_rules_sound: + assumes "p |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t)" + shows "ex p |\<subseteq>| ta_der \<A> (term_of_gterm t)" using assms +proof (induction rule: ta_der_gterm_induct) + case (GFun f ts ps p q) + then have IH: "\<forall>i < length ts. ex (ps ! i) |\<subseteq>| gta_der \<A> (ts ! i)" unfolding gta_der_def by auto + show ?case + proof standard + fix r assume "r |\<in>| ex q" + with GFun(1 - 3) obtain qs q' where "TA_rule f qs q' |\<in>| rules \<A>" + "q' = r \<or> (q', r) |\<in>| (eps \<A>)|\<^sup>+|" "list_all2 (|\<in>|) qs (map ex ps)" + by (auto simp: Let_def ps_ta_def ps_rulesp_def ps_reachable_states_simp ps_rules_def) + then show "r |\<in>| ta_der \<A> (term_of_gterm (GFun f ts))" + using GFun(2) IH unfolding gta_der_def + by (force dest!: fsubsetD intro!: exI[of _ q'] exI[of _ qs] simp: list_all2_conv_all_nth) + qed +qed + +lemma ps_ta_nt_empty_set: + "TA_rule f qs (Wrapp {||}) |\<in>| rules (ps_ta \<A>) \<Longrightarrow> False" + by (auto simp: ps_ta_def ps_rulesp_def ps_rules_def) + +lemma ps_rules_not_empty_reach: + assumes "Wrapp {||} |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t)" + shows False using assms +proof (induction t) + case (GFun f ts) + then show ?case using ps_ta_nt_empty_set[of f _ \<A>] + by (auto simp: ps_ta_def) +qed + +lemma ps_rules_complete: + assumes "q |\<in>| ta_der \<A> (term_of_gterm t)" + shows "\<exists>p. q |\<in>| ex p \<and> p |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t) \<and> p |\<in>| ps_states \<A>" using assms +proof (induction rule: ta_der_gterm_induct) + let ?P = "\<lambda>t q p. q |\<in>| ex p \<and> p |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t) \<and> p |\<in>| ps_states \<A>" + case (GFun f ts ps p q) + then have "\<forall>i. \<exists>p. i < length ts \<longrightarrow> ?P (ts ! i) (ps ! i) p" by auto + with choice[OF this] obtain psf where ps: "\<forall>i < length ts. ?P (ts ! i) (ps ! i) (psf i)" by auto + define qs where "qs = map psf [0 ..< length ts]" + let ?p = "ps_reachable_states \<A> f (map ex qs)" + from ps have in_Q: "fset_of_list qs |\<subseteq>| ps_states \<A>" + by (auto simp: qs_def fset_of_list_elem) + from ps GFun(2) have all: "list_all2 (|\<in>|) ps (map ex qs)" + by (auto simp: list_all2_conv_all_nth qs_def) + then have in_p: "q |\<in>| ?p" using GFun(1, 3) + unfolding ps_reachable_statesp_def ps_reachable_states_def by auto + then have rule: "TA_rule f qs (Wrapp ?p) |\<in>| ps_rules \<A> (ps_states \<A>)" using in_Q unfolding ps_rules_def + by (intro ps_rulesI) (auto simp: ps_rulesp_def) + from in_Q in_p have "Wrapp ?p |\<in>| (ps_states \<A>)" + by (auto intro!: ps_states_complete[unfolded ps_states_complete_it_def, rule_format]) + with in_p ps rule show ?case + by (auto intro!: exI[of _ "Wrapp ?p"] exI[of _ qs] simp: ps_ta_def qs_def) +qed + +lemma ps_ta_eps[simp]: "eps (ps_ta \<A>) = {||}" by (auto simp: Let_def ps_ta_def) + +lemma ps_ta_det[iff]: "ta_det (ps_ta \<A>)" by (auto simp: Let_def ps_ta_def ta_det_def ps_rulesp_def ps_rules_def) + +lemma ps_gta_lang: + "gta_lang (ps_ta_Q\<^sub>f Q \<A>) (ps_ta \<A>) = gta_lang Q \<A>" (is "?R = ?L") +proof standard + show "?L \<subseteq> ?R" proof standard + fix t assume "t \<in> ?L" + then obtain q where q_res: "q |\<in>| ta_der \<A> (term_of_gterm t)" and q_final: "q |\<in>| Q" + by auto + from ps_rules_complete[OF q_res] obtain p where + "p |\<in>| ps_states \<A>" "q |\<in>| ex p" "p |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t)" + by auto + moreover with q_final have "p |\<in>| ps_ta_Q\<^sub>f Q \<A>" + by (auto simp: ps_ta_Q\<^sub>f_def) + ultimately show "t \<in> ?R" by auto + qed + show "?R \<subseteq> ?L" proof standard + fix t assume "t \<in> ?R" + then obtain p where + p_res: "p |\<in>| ta_der (ps_ta \<A>) (term_of_gterm t)" and p_final: "p |\<in>| ps_ta_Q\<^sub>f Q \<A>" + by (auto simp: ta_lang_def) + from ps_rules_sound[OF p_res] have "ex p |\<subseteq>| ta_der \<A> (term_of_gterm t)" + by auto + moreover from p_final obtain q where "q |\<in>| ex p" "q |\<in>| Q" by (auto simp: ps_ta_Q\<^sub>f_def) + ultimately show "t \<in> ?L" by auto + qed +qed + +definition ps_reg where + "ps_reg R = Reg (ps_ta_Q\<^sub>f (fin R) (ta R)) (ps_ta (ta R))" + +lemma \<L>_ps_reg: + "\<L> (ps_reg R) = \<L> R" + by (auto simp: \<L>_def ps_gta_lang ps_reg_def) + +lemma ps_ta_states: "\<Q> (ps_ta \<A>) |\<subseteq>| Wrapp |`| fPow (\<Q> \<A>)" + using ps_rules_states ps_states unfolding ps_ta_def \<Q>_def + by (auto simp: Let_def ps_rules_def) blast + +lemma ps_ta_states': "ex |`| \<Q> (ps_ta \<A>) |\<subseteq>| fPow (\<Q> \<A>)" + using ps_ta_states[of \<A>] + by fastforce + +end diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Impl.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Impl.thy @@ -0,0 +1,406 @@ +theory Tree_Automata_Impl + imports Tree_Automata_Abstract_Impl + "HOL-Library.List_Lexorder" + "HOL-Library.AList_Mapping" + Tree_Automata_Class_Instances_Impl + Containers.Containers +begin + +definition map_val_of_list :: "('b \<Rightarrow> 'a) \<Rightarrow> ('b \<Rightarrow> 'c list) \<Rightarrow> 'b list \<Rightarrow> ('a, 'c list) mapping" where + "map_val_of_list ek ev xs = foldr (\<lambda>x m. Mapping.update (ek x) (ev x @ case_option Nil id (Mapping.lookup m (ek x))) m) xs Mapping.empty" + +abbreviation "map_of_list ek ev xs \<equiv> map_val_of_list ek (\<lambda> x. [ev x]) xs" + +lemma map_val_of_list_tabulate_conv: + "map_val_of_list ek ev xs = Mapping.tabulate (sort (remdups (map ek xs))) (\<lambda> k. concat (map ev (filter (\<lambda> x. k = ek x) xs)))" + unfolding map_val_of_list_def +proof (induct xs) + case (Cons x xs) then show ?case + by (intro mapping_eqI) (auto simp: lookup_combine lookup_update' lookup_empty lookup_tabulate image_iff) +qed (simp add: empty_Mapping tabulate_Mapping) + +lemmas map_val_of_list_simp = map_val_of_list_tabulate_conv lookup_tabulate +subsection \<open>Setup for the list implementation of reachable states\<close> + +definition reach_infer0_cont where + "reach_infer0_cont \<Delta> = + map r_rhs (filter (\<lambda> r. case r of TA_rule f ps p \<Rightarrow> ps = []) (sorted_list_of_fset \<Delta>))" + +definition reach_infer1_cont :: "('q :: linorder, 'f :: linorder) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> 'q \<Rightarrow> 'q fset \<Rightarrow> 'q list" where + "reach_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> = + (let rules = sorted_list_of_fset \<Delta> in + let eps = sorted_list_of_fset \<Delta>\<^sub>\<epsilon> in + let mapp_r = map_val_of_list fst snd (concat (map (\<lambda> r. map (\<lambda> q. (q, [r])) (r_lhs_states r)) rules)) in + let mapp_e = map_of_list fst snd eps in + (\<lambda> p bs. + (map r_rhs (filter (\<lambda> r. case r of TA_rule f qs q \<Rightarrow> + fset_of_list qs |\<subseteq>| finsert p bs) (case_option Nil id (Mapping.lookup mapp_r p)))) @ + case_option Nil id (Mapping.lookup mapp_e p)))" + +locale reach_rules_fset = + fixes \<Delta> :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>\<epsilon> :: "('q \<times> 'q) fset" +begin + +sublocale reach_horn "TA \<Delta> \<Delta>\<^sub>\<epsilon>" . + +lemma infer1: + "infer1 p (fset bs) = set (reach_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> p bs)" + unfolding reach_infer1 reach_infer1_cont_def set_append Un_assoc[symmetric] Let_def + unfolding sorted_list_of_fset_simps union_fset + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"]) + subgoal + apply (auto simp: fset_of_list_elem less_eq_fset.rep_eq fset_of_list.rep_eq image_iff + map_val_of_list_simp fmember.rep_eq split!: ta_rule.splits) + apply (metis list.set_intros(1) ta_rule.sel(2, 3)) + apply (metis in_set_simps(2) ta_rule.exhaust_sel) + done + subgoal + apply (simp add: image_def Bex_def fmember.rep_eq map_val_of_list_simp) + done + done + +sublocale l: horn_fset "reach_rules (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" "reach_infer0_cont \<Delta>" "reach_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>" + apply (unfold_locales) + unfolding reach_infer0 reach_infer0_cont_def + subgoal + apply (auto simp: image_iff ta_rule.case_eq_if Bex_def fset_of_list_elem fmember.rep_eq) + apply force + apply (metis ta_rule.collapse)+ + done + subgoal using infer1 + apply blast + done + done + +lemmas infer = l.infer0 l.infer1 +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition "reach_cont_impl \<Delta> \<Delta>\<^sub>\<epsilon> = + horn_fset_impl.saturate_impl (reach_infer0_cont \<Delta>) (reach_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>)" + +lemma reach_fset_impl_sound: + "reach_cont_impl \<Delta> \<Delta>\<^sub>\<epsilon> = Some xs \<Longrightarrow> fset xs = ta_reach (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" + using reach_rules_fset.saturate_impl_sound unfolding reach_cont_impl_def + unfolding reach_horn.reach_sound . + +lemma reach_fset_impl_complete: + "reach_cont_impl \<Delta> \<Delta>\<^sub>\<epsilon> \<noteq> None" +proof - + have "finite (ta_reach (TA \<Delta> \<Delta>\<^sub>\<epsilon>))" + unfolding ta_reach_reachable by simp + then show ?thesis unfolding reach_cont_impl_def + by (intro reach_rules_fset.saturate_impl_complete) + (auto simp: reach_horn.reach_sound) +qed + +lemma reach_impl [code]: + "ta_reachable (TA \<Delta> \<Delta>\<^sub>\<epsilon>) = the (reach_cont_impl \<Delta> \<Delta>\<^sub>\<epsilon>)" + using reach_fset_impl_sound[of \<Delta> \<Delta>\<^sub>\<epsilon>] + apply (auto simp add: ta_reach_reachable reach_fset_impl_complete fset_of_list_elem) + apply (metis fset_inject option.exhaust_sel reach_fset_impl_complete)+ + done + +subsection \<open>Setup for list implementation of productive states\<close> +definition productive_infer1_cont :: "('q :: linorder, 'f :: linorder) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> 'q \<Rightarrow> 'q fset \<Rightarrow> 'q list" where + "productive_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> = + (let rules = sorted_list_of_fset \<Delta> in + let eps = sorted_list_of_fset \<Delta>\<^sub>\<epsilon> in + let mapp_r = map_of_list (\<lambda> r. r_rhs r) r_lhs_states rules in + let mapp_e = map_of_list snd fst eps in + (\<lambda> p bs. + (case_option Nil id (Mapping.lookup mapp_e p)) @ + concat (case_option Nil id (Mapping.lookup mapp_r p))))" + +locale productive_rules_fset = + fixes \<Delta> :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>\<epsilon> :: "('q \<times> 'q) fset" and P :: "'q fset" +begin + +sublocale productive_horn "TA \<Delta> \<Delta>\<^sub>\<epsilon>" P . + +lemma infer1: + "infer1 p (fset bs) = set (productive_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> p bs)" + unfolding productive_infer1 productive_infer1_cont_def set_append Un_assoc[symmetric] + unfolding union_fset sorted_list_of_fset_simps Let_def set_append + apply (intro arg_cong2[of _ _ _ _ "(\<union>)"]) + subgoal + apply (simp add: image_def Bex_def fmember.rep_eq map_val_of_list_simp) + done + subgoal + apply (auto simp flip: fmember.rep_eq simp: map_val_of_list_simp image_iff) + apply (metis ta_rule.sel(2, 3)) + apply (metis ta_rule.collapse) + apply (metis notin_fset ta_rule.sel(3)) + done + done + +sublocale l: horn_fset "productive_rules P (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" "sorted_list_of_fset P" "productive_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>" + apply (unfold_locales) + using infer1 productive_infer0 fset_of_list.rep_eq + by fastforce+ + +lemmas infer = l.infer0 l.infer1 +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + +end + +definition "productive_cont_impl P \<Delta> \<Delta>\<^sub>\<epsilon> = + horn_fset_impl.saturate_impl (sorted_list_of_fset P) (productive_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>)" + +lemma productive_cont_impl_sound: + "productive_cont_impl P \<Delta> \<Delta>\<^sub>\<epsilon> = Some xs \<Longrightarrow> fset xs = ta_productive_ind P (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" + using productive_rules_fset.saturate_impl_sound unfolding productive_cont_impl_def + unfolding productive_horn.productive_sound . + +lemma productive_cont_impl_complete: + "productive_cont_impl P \<Delta> \<Delta>\<^sub>\<epsilon> \<noteq> None" +proof - + have "finite (ta_productive_ind P (TA \<Delta> \<Delta>\<^sub>\<epsilon>))" + unfolding ta_productive_ind by simp + then show ?thesis unfolding productive_cont_impl_def + by (intro productive_rules_fset.saturate_impl_complete) + (auto simp: productive_horn.productive_sound) +qed + +lemma productive_impl [code]: + "ta_productive P (TA \<Delta> \<Delta>\<^sub>\<epsilon>) = the (productive_cont_impl P \<Delta> \<Delta>\<^sub>\<epsilon>)" + using productive_cont_impl_complete[of P \<Delta>] productive_cont_impl_sound[of P \<Delta>] + by (auto simp add: ta_productive_ind fset_of_list_elem fmember.rep_eq) + +subsection \<open>Setup for the implementation of power set construction states\<close> + + +abbreviation "r_statesl r \<equiv> length (r_lhs_states r)" + +definition ps_reachable_states_list where + "ps_reachable_states_list mapp_r mapp_e f ps = + (let R = filter (\<lambda> r. list_all2 (|\<in>|) (r_lhs_states r) ps) + (case_option Nil id (Mapping.lookup mapp_r (f, length ps))) in + let S = map r_rhs R in + S @ concat (map (case_option Nil id \<circ> Mapping.lookup mapp_e) S))" + +lemma ps_reachable_states_list_sound: + assumes "length ps = n" + and mapp_r: "case_option Nil id (Mapping.lookup mapp_r (f, n)) = + filter (\<lambda>r. r_root r = f \<and> r_statesl r = n) (sorted_list_of_fset \<Delta>)" + and mapp_e: "\<And>p. case_option Nil id (Mapping.lookup mapp_e p) = + map snd (filter (\<lambda> q. fst q = p) (sorted_list_of_fset (\<Delta>\<^sub>\<epsilon>|\<^sup>+|)))" + shows "fset_of_list (ps_reachable_states_list mapp_r mapp_e f (map ex ps)) = + ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) f (map ex ps)" (is "?Ls = ?Rs") +proof - + have *: "length ps = n" "length (map ex ps) = n" using assms by auto + {fix q assume "q |\<in>| ?Ls" + then obtain qs p where "TA_rule f qs p |\<in>| \<Delta>" "length ps = length qs" + "list_all2 (|\<in>|) qs (map ex ps)" "p = q \<or> (p, q) |\<in>| \<Delta>\<^sub>\<epsilon>|\<^sup>+|" + unfolding ps_reachable_states_list_def Let_def comp_def assms(1, 2, 3) * + by (force simp add: fset_of_list_elem image_iff fBex_def simp flip: fmember.rep_eq) + then have "q |\<in>| ?Rs" + by (force simp add: ps_reachable_states_fmember image_iff)} + moreover + {fix q assume "q |\<in>| ?Rs" + then obtain qs p where "TA_rule f qs p |\<in>| \<Delta>" "length ps = length qs" + "list_all2 (|\<in>|) qs (map ex ps)" "p = q \<or> (p, q) |\<in>| \<Delta>\<^sub>\<epsilon>|\<^sup>+|" + by (auto simp add: ps_reachable_states_fmember list_all2_iff) + then have "q |\<in>| ?Ls" + unfolding ps_reachable_states_list_def Let_def * comp_def assms(2, 3) + by (force simp add: fset_of_list_elem image_iff simp flip: fmember.rep_eq)} + ultimately show ?thesis by blast +qed + + +lemma rule_target_statesI: + "\<exists> r |\<in>| \<Delta>. r_rhs r = q \<Longrightarrow> q |\<in>| rule_target_states \<Delta>" + by auto + +definition ps_states_infer0_cont :: "('q :: linorder, 'f :: linorder) ta_rule fset \<Rightarrow> + ('q \<times> 'q) fset \<Rightarrow> 'q FSet_Lex_Wrapper list" where + "ps_states_infer0_cont \<Delta> \<Delta>\<^sub>\<epsilon> = + (let sig = filter (\<lambda> r. r_lhs_states r = []) (sorted_list_of_fset \<Delta>) in + filter (\<lambda> p. ex p \<noteq> {||}) (map (\<lambda> r. Wrapp (ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) (r_root r) [])) sig))" + +definition ps_states_infer1_cont :: "('q :: linorder , 'f :: linorder) ta_rule fset \<Rightarrow> ('q \<times> 'q) fset \<Rightarrow> + 'q FSet_Lex_Wrapper \<Rightarrow> 'q FSet_Lex_Wrapper fset \<Rightarrow> 'q FSet_Lex_Wrapper list" where + "ps_states_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> = + (let sig = remdups (map (\<lambda> r. (r_root r, r_statesl r)) (filter (\<lambda> r. r_lhs_states r \<noteq> []) (sorted_list_of_fset \<Delta>))) in + let arities = remdups (map snd sig) in + let etr = sorted_list_of_fset (\<Delta>\<^sub>\<epsilon>|\<^sup>+|) in + let mapp_r = map_of_list (\<lambda> r. (r_root r, r_statesl r)) id (sorted_list_of_fset \<Delta>) in + let mapp_e = map_of_list fst snd etr in + (\<lambda> p bs. + (let states = sorted_list_of_fset (finsert p bs) in + let arity_to_states_map = Mapping.tabulate arities (\<lambda> n. list_of_permutation_element_n p n states) in + let res = map (\<lambda> (f, n). + map (\<lambda> s. let rules = the (Mapping.lookup mapp_r (f, n)) in + Wrapp (fset_of_list (ps_reachable_states_list mapp_r mapp_e f (map ex s)))) + (the (Mapping.lookup arity_to_states_map n))) + sig in + filter (\<lambda> p. ex p \<noteq> {||}) (concat res))))" + +locale ps_states_fset = + fixes \<Delta> :: "('q :: linorder, 'f :: linorder) ta_rule fset" and \<Delta>\<^sub>\<epsilon> :: "('q \<times> 'q) fset" +begin + +sublocale ps_states_horn "TA \<Delta> \<Delta>\<^sub>\<epsilon>" . + +lemma infer0: "infer0 = set (ps_states_infer0_cont \<Delta> \<Delta>\<^sub>\<epsilon>)" + unfolding ps_states_horn.ps_construction_infer0 + unfolding ps_states_infer0_cont_def Let_def + using ps_reachable_states_fmember + by (auto simp add: image_def Ball_def Bex_def) + (metis fmember.rep_eq list_all2_Nil2 ps_reachable_states_fmember ta.sel(1) ta_rule.sel(1, 2)) + +lemma r_lhs_states_nConst: + "r_lhs_states r \<noteq> [] \<Longrightarrow> r_statesl r \<noteq> 0" for r by auto + + +lemma filter_empty_conv': + "[] = filter P xs \<longleftrightarrow> (\<forall>x\<in>set xs. \<not> P x)" + by (metis filter_empty_conv) + +lemma infer1: + "infer1 p (fset bs) = set (ps_states_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon> p bs)" (is "?Ls = ?Rs") +proof - + let ?mapp_r = "map_of_list (\<lambda>r. (r_root r, r_statesl r)) (\<lambda>x. x) (sorted_list_of_fset \<Delta>)" + let ?mapp_e = "map_of_list fst snd (sorted_list_of_fset (\<Delta>\<^sub>\<epsilon>|\<^sup>+|))" + have mapr: "case_option Nil id (Mapping.lookup ?mapp_r (f, n)) = + filter (\<lambda>r. r_root r = f \<and> r_statesl r = n) (sorted_list_of_fset \<Delta>)" for f n + by (auto simp: map_val_of_list_simp image_iff filter_empty_conv' intro: filter_cong) + have epsr: "\<And>p. case_option Nil id (Mapping.lookup ?mapp_e p) = + map snd (filter (\<lambda> q. fst q = p) (sorted_list_of_fset (\<Delta>\<^sub>\<epsilon>|\<^sup>+|)))" + by (auto simp: map_val_of_list_simp image_iff filter_empty_conv) metis + have *: "p \<in> set qs \<Longrightarrow> x |\<in>| ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) f (map ex qs) \<Longrightarrow> + (\<exists> ps q. TA_rule f ps q |\<in>| \<Delta> \<and> length ps = length qs)" for x f qs + by (auto simp: ps_reachable_states_fmember list_all2_conv_all_nth) + {fix q assume "q \<in> ?Ls" + then obtain f qss where sp: "q = Wrapp (ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) f (map ex qss))" + "ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) f (map ex qss) \<noteq> {||}" "p \<in> set qss" "set qss \<subseteq> insert p (fset bs)" + by (auto simp add: ps_construction_infer1 ps_reachable_states_fmember) + from sp(2, 3) obtain ps p' where r: "TA_rule f ps p' |\<in>| \<Delta>" "length ps = length qss" using * + by blast + then have mem: "qss \<in> set (list_of_permutation_element_n p (length ps) (sorted_list_of_fset (finsert p bs)))" using sp(2-) + by (auto simp: list_of_permutation_element_n_iff) + (meson in_set_idx insertE set_list_subset_eq_nth_conv) + then have "q \<in> ?Rs" using sp r + unfolding ps_construction_infer1 ps_states_infer1_cont_def Let_def + apply (simp add: lookup_tabulate ps_reachable_states_fmember image_iff flip: fmember.rep_eq) + apply (rule_tac x = "f ps \<rightarrow> p'" in exI) + apply (auto simp: Bex_def ps_reachable_states_list_sound[OF _ mapr epsr] intro: exI[of _ qss]) + done} + moreover + {fix q assume ass: "q \<in> ?Rs" + then obtain r qss where "r |\<in>| \<Delta>" "r_lhs_states r \<noteq> []" "qss \<in> set (list_of_permutation_element_n p (r_statesl r) (sorted_list_of_fset (finsert p bs)))" + "q = Wrapp (ps_reachable_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>) (r_root r) (map ex qss))" + unfolding ps_states_infer1_cont_def Let_def + by (auto simp add: lookup_tabulate ps_reachable_states_fmember image_iff + ps_reachable_states_list_sound[OF _ mapr epsr] split: if_splits simp flip: fmember.rep_eq) + moreover have "q \<noteq> Wrapp {||}" using ass + by (auto simp: ps_states_infer1_cont_def Let_def) + ultimately have "q \<in> ?Ls" unfolding ps_construction_infer1 + apply (auto simp: list_of_permutation_element_n_iff intro!: exI[of _ "r_root r"] exI[of _ qss]) + apply (metis in_set_idx) + done} + ultimately show ?thesis by blast +qed + + +sublocale l: horn_fset "ps_states_rules (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" "ps_states_infer0_cont \<Delta> \<Delta>\<^sub>\<epsilon>" "ps_states_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>" + apply (unfold_locales) + using infer0 infer1 + by fastforce+ + +lemmas infer = l.infer0 l.infer1 +lemmas saturate_impl_sound = l.saturate_impl_sound +lemmas saturate_impl_complete = l.saturate_impl_complete + + +end + +definition "ps_states_fset_impl \<Delta> \<Delta>\<^sub>\<epsilon> = + horn_fset_impl.saturate_impl (ps_states_infer0_cont \<Delta> \<Delta>\<^sub>\<epsilon>) (ps_states_infer1_cont \<Delta> \<Delta>\<^sub>\<epsilon>)" + +lemma ps_states_fset_impl_sound: + assumes "ps_states_fset_impl \<Delta> \<Delta>\<^sub>\<epsilon> = Some xs" + shows "xs = ps_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" + using ps_states_fset.saturate_impl_sound[OF assms[unfolded ps_states_fset_impl_def]] + using ps_states_horn.ps_states_sound[of "TA \<Delta> \<Delta>\<^sub>\<epsilon>"] + by (auto simp: fset_of_list_elem fmember.rep_eq ps_states.rep_eq fset_of_list.rep_eq) + +lemma ps_states_fset_impl_complete: + "ps_states_fset_impl \<Delta> \<Delta>\<^sub>\<epsilon> \<noteq> None" +proof - + let ?R = "ps_states (TA \<Delta> \<Delta>\<^sub>\<epsilon>)" + let ?S = "horn.saturate (ps_states_rules (TA \<Delta> \<Delta>\<^sub>\<epsilon>))" + have "?S \<subseteq> fset ?R" + using ps_states_horn.ps_states_sound + by (simp add: ps_states_horn.ps_states_sound ps_states.rep_eq) + from finite_subset[OF this] show ?thesis + unfolding ps_states_fset_impl_def + by (intro ps_states_fset.saturate_impl_complete) simp +qed + +lemma ps_ta_impl [code]: + "ps_ta (TA \<Delta> \<Delta>\<^sub>\<epsilon>) = + (let xs = the (ps_states_fset_impl \<Delta> \<Delta>\<^sub>\<epsilon>) in + TA (ps_rules (TA \<Delta> \<Delta>\<^sub>\<epsilon>) xs) {||})" + using ps_states_fset_impl_complete + using ps_states_fset_impl_sound + unfolding ps_ta_def Let_def + by (metis option.exhaust_sel) + +lemma ps_reg_impl [code]: + "ps_reg (Reg Q (TA \<Delta> \<Delta>\<^sub>\<epsilon>)) = + (let xs = the (ps_states_fset_impl \<Delta> \<Delta>\<^sub>\<epsilon>) in + Reg (ffilter (\<lambda> S. Q |\<inter>| ex S \<noteq> {||}) xs) + (TA (ps_rules (TA \<Delta> \<Delta>\<^sub>\<epsilon>) xs) {||}))" + using ps_states_fset_impl_complete[of \<Delta> \<Delta>\<^sub>\<epsilon>] + using ps_states_fset_impl_sound[of \<Delta> \<Delta>\<^sub>\<epsilon>] + unfolding ps_reg_def ps_ta_Q\<^sub>f_def Let_def + unfolding ps_ta_def Let_def + using eq_ffilter by auto + +lemma prod_ta_zip [code]: + "prod_ta_rules (\<A> :: ('q1 :: linorder, 'f :: linorder) ta) (\ :: ('q2 :: linorder, 'f :: linorder) ta) = + (let sig = sorted_list_of_fset (ta_sig \<A> |\<inter>| ta_sig \) in + let mapA = map_of_list (\<lambda>r. (r_root r, r_statesl r)) id (sorted_list_of_fset (rules \<A>)) in + let mapB = map_of_list (\<lambda>r. (r_root r, r_statesl r)) id (sorted_list_of_fset (rules \)) in + let merge = (\<lambda> (ra, rb). TA_rule (r_root ra) (zip (r_lhs_states ra) (r_lhs_states rb)) (r_rhs ra, r_rhs rb)) in + fset_of_list ( + concat (map (\<lambda> (f, n). map merge + (List.product (the (Mapping.lookup mapA (f, n))) (the (Mapping.lookup mapB (f, n))))) sig)))" + (is "?Ls = ?Rs") +proof - + have [simp]: "distinct (sorted_list_of_fset (ta_sig \<A>))" "distinct (sorted_list_of_fset (ta_sig \))" + by (simp_all add: distinct_sorted_list_of_fset) + have *: "sort (remdups (map (\<lambda>r. (r_root r, r_statesl r)) (sorted_list_of_fset (rules \<A>)))) = sorted_list_of_fset (ta_sig \<A>)" + "sort (remdups (map (\<lambda>r. (r_root r, r_statesl r)) (sorted_list_of_fset (rules \)))) = sorted_list_of_fset (ta_sig \)" + by (auto simp: ta_sig_def sorted_list_of_fset_fimage_dist) + {fix r assume ass: "r |\<in>| ?Ls" + then obtain f qs q where [simp]: "r = f qs \<rightarrow> q" by auto + then have "(f, length qs) |\<in>| ta_sig \<A> |\<inter>| ta_sig \" using ass by auto + then have "r |\<in>| ?Rs" using ass unfolding map_val_of_list_tabulate_conv * + by (auto simp: Let_def fset_of_list_elem image_iff case_prod_beta lookup_tabulate simp flip: fmember.rep_eq intro!: bexI[of _ "(f, length qs)"]) + (metis (no_types, lifting) length_map ta_rule.sel(1 - 3) zip_map_fst_snd)} + moreover + {fix r assume ass: "r |\<in>| ?Rs" then have "r |\<in>| ?Ls" unfolding map_val_of_list_tabulate_conv * + by (auto simp: fset_of_list_elem finite_Collect_prod_ta_rules lookup_tabulate simp flip: fmember.rep_eq) + (metis ta_rule.collapse)} + ultimately show ?thesis by blast +qed + +(* +export_code ta_der in Haskell +export_code ta_reachable in Haskell +export_code ta_productive in Haskell +export_code trim_ta in Haskell +export_code ta_restrict in Haskell +export_code ps_reachable_states in Haskell +export_code prod_ta_rules in Haskell +export_code ps_ta in Haskell +export_code ps_reg in Haskell +export_code reg_intersect in Haskell +*) + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Pumping.thy b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Pumping.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Tree_Automata/Tree_Automata_Pumping.thy @@ -0,0 +1,362 @@ +theory Tree_Automata_Pumping + imports Tree_Automata +begin + +subsection \<open>Pumping lemma\<close> + +(* We need to deal with non deterministic tree automata, + to show the pumping lemma we need to find cycles on the derivation + of terms with depth greater than the number of states. + + assumes "card (ta_states A) < depth t" and "finite (ta_states A)" + and "q \<in> ta_res A t" and "ground t" + shows "\<exists> s v p. t \<unrhd> s \<and> s \<rhd> v \<and> p \<in> ta_res A v \<and> p \<in> ta_res A s" + + we only get t \<longrightarrow>* q, v \<longrightarrow> p, s \<longrightarrow> p, but we have no chance to conclude + that the state p appears in the derivation t \<longrightarrow>* q, because our derivation is + not deterministic and there could be a cycle in the derivation of t which does not + end in state q. + *) + +abbreviation "derivation_ctxt ts Cs \<equiv> Suc (length Cs) = length ts \<and> + (\<forall> i < length Cs. (Cs ! i) \<langle>ts ! i\<rangle> = ts ! Suc i)" + +abbreviation "derivation_ctxt_st A ts Cs qs \<equiv> length qs = length ts \<and> Suc (length Cs) = length ts \<and> + (\<forall> i < length Cs. qs ! Suc i |\<in>| ta_der A (Cs ! i)\<langle>Var (qs ! i)\<rangle>)" + +abbreviation "derivation_sound A ts qs \<equiv> length qs = length ts \<and> + (\<forall> i < length qs. qs ! i |\<in>| ta_der A (ts ! i))" + +definition "derivation A ts Cs qs \<longleftrightarrow> derivation_ctxt ts Cs \<and> + derivation_ctxt_st A ts Cs qs \<and> derivation_sound A ts qs" + + +(* Context compositions from left *) +lemma ctxt_comp_lhs_not_hole: + assumes "C \<noteq> \<box>" + shows "C \<circ>\<^sub>c D \<noteq> \<box>" + using assms by (cases C; cases D) auto + +lemma ctxt_comp_rhs_not_hole: + assumes "D \<noteq> \<box>" + shows "C \<circ>\<^sub>c D \<noteq> \<box>" + using assms by (cases C; cases D) auto + +lemma fold_ctxt_comp_nt_empty_acc: + assumes "D \<noteq> \<box>" + shows "fold (\<circ>\<^sub>c) Cs D \<noteq> \<box>" + using assms by (induct Cs arbitrary: D) (auto simp add: ctxt_comp_rhs_not_hole) + +lemma fold_ctxt_comp_nt_empty: + assumes "C \<in> set Cs" and "C \<noteq> \<box>" + shows "fold (\<circ>\<^sub>c) Cs D \<noteq> \<box>" using assms + by (induct Cs arbitrary: D) (auto simp: ctxt_comp_lhs_not_hole fold_ctxt_comp_nt_empty_acc) + +(* Rep of context *) + +lemma empty_ctxt_power [simp]: + "\<box> ^ n = \<box>" + by (induct n) auto + +lemma ctxt_comp_not_hole: + assumes "C \<noteq> \<box>" and "n \<noteq> 0" + shows "C^n \<noteq> \<box>" + using assms by (induct n arbitrary: C) (auto elim!: ctxt_compose.elims) + +lemma ctxt_comp_n_suc [simp]: + shows "(C^(Suc n))\<langle>t\<rangle> = (C^n)\<langle>C\<langle>t\<rangle>\<rangle>" + by (induct n arbitrary: C) auto + +lemma ctxt_comp_reach: + assumes "p |\<in>| ta_der A C\<langle>Var p\<rangle>" + shows "p |\<in>| ta_der A (C^n)\<langle>Var p\<rangle>" + using assms by (induct n arbitrary: C) (auto intro: ta_der_ctxt) + + +(* Connecting positions to term depth and trivial depth lemmas *) + +lemma args_depth_less [simp]: + assumes "u \<in> set ss" + shows "depth u < depth (Fun f ss)" using assms + by (cases ss) (auto simp: less_Suc_eq_le) + +lemma subterm_depth_less: + assumes "s \<rhd> t" + shows "depth t < depth s" + using assms by (induct s t rule: supt.induct) (auto intro: less_trans) + +lemma poss_length_depth: + shows "\<exists> p \<in> poss t. length p = depth t" +proof (induct t) + case (Fun f ts) + then show ?case + proof (cases ts) + case [simp]: (Cons a list) + have "ts \<noteq> [] \<Longrightarrow> \<exists> s. f s = Max (f ` set ts) \<and> s \<in> set ts" for ts f + using Max_in[of "f ` set ts"] by (auto simp: image_iff) + from this[of ts depth] obtain s where s: "depth s = Max (depth ` set ts) \<and> s \<in> set ts" + by auto + then show ?thesis using Fun[of s] in_set_idx[OF conjunct2[OF s]] + by fastforce + qed auto +qed auto + +lemma poss_length_bounded_by_depth: + assumes "p \<in> poss t" + shows "length p \<le> depth t" using assms + by (induct t arbitrary: p) (auto intro!: Suc_leI, meson args_depth_less dual_order.strict_trans2 nth_mem) + +(* Connecting depth to ctxt repetition *) + +lemma depth_ctxt_nt_hole_inc: + assumes "C \<noteq> \<box>" + shows "depth t < depth C\<langle>t\<rangle>" using assms + using subterm_depth_less[of t "C\<langle>t\<rangle>"] + by (simp add: nectxt_imp_supt_ctxt subterm_depth_less) + +lemma depth_ctxt_less_eq: + "depth t \<le> depth C\<langle>t\<rangle>" using depth_ctxt_nt_hole_inc less_imp_le + by (cases C, simp) blast + +lemma ctxt_comp_n_not_hole_depth_inc: + assumes "C \<noteq> \<box>" + shows "depth (C^n)\<langle>t\<rangle> < depth (C^(Suc n))\<langle>t\<rangle>" + using assms by (induct n arbitrary: C t) (auto simp: ctxt_comp_not_hole depth_ctxt_nt_hole_inc) + +lemma ctxt_comp_n_lower_bound: + assumes "C \<noteq> \<box>" + shows "n < depth (C^(Suc n))\<langle>t\<rangle>" + using assms +proof (induct n arbitrary: C) + case 0 then show ?case using ctxt_comp_not_hole depth_ctxt_nt_hole_inc gr_implies_not_zero by blast +next + case (Suc n) then show ?case using ctxt_comp_n_not_hole_depth_inc less_trans_Suc by blast +qed + +lemma ta_der_ctxt_n_loop: + assumes "q |\<in>| ta_der \<A> t" "q |\<in>| ta_der \<A> C\<langle>Var q\<rangle>" + shows " q |\<in>| ta_der \<A> (C^n)\<langle>t\<rangle>" + using assms by (induct n) (auto simp: ta_der_ctxt) + +lemma ctxt_compose_funs_ctxt [simp]: + "funs_ctxt (C \<circ>\<^sub>c D) = funs_ctxt C \<union> funs_ctxt D" + by (induct C arbitrary: D) auto + +lemma ctxt_compose_vars_ctxt [simp]: + "vars_ctxt (C \<circ>\<^sub>c D) = vars_ctxt C \<union> vars_ctxt D" + by (induct C arbitrary: D) auto + +lemma ctxt_power_funs_vars_0 [simp]: + assumes "n = 0" + shows "funs_ctxt (C^n) = {}" "vars_ctxt (C^n) = {}" + using assms by auto + +lemma ctxt_power_funs_vars_n [simp]: + assumes "n \<noteq> 0" + shows "funs_ctxt (C^n) = funs_ctxt C" "vars_ctxt (C^n) = vars_ctxt C" + using assms by (induct n arbitrary: C, auto) fastforce+ + + +(* Collect all terms in a path via positions *) + +fun terms_pos where + "terms_pos s [] = [s]" +| "terms_pos s (p # ps) = terms_pos (s |_ [p]) ps @ [s]" + +lemma subt_at_poss [simp]: + assumes "a # p \<in> poss s" + shows "p \<in> poss (s |_ [a])" + using assms by (metis append_Cons append_self_conv2 poss_append_poss) + +lemma terms_pos_length [simp]: + shows "length (terms_pos t p) = Suc (length p)" + by (induct p arbitrary: t) auto + +lemma terms_pos_last [simp]: + assumes "i = length p" + shows "terms_pos t p ! i = t" using assms + by (induct p arbitrary: t) (auto simp add: append_Cons_nth_middle) + +lemma terms_pos_subterm: + assumes "p \<in> poss t" and "s \<in> set (terms_pos t p)" + shows "t \<unrhd> s" using assms + using assms +proof (induct p arbitrary: t s) + case (Cons a p) + from Cons(2) have st: "t \<unrhd> t |_ [a]" by auto + from Cons(1)[of "t |_ [a]"] Cons(2-) show ?case + using supteq_trans[OF st] by fastforce +qed auto + +lemma terms_pos_differ_subterm: + assumes "p \<in> poss t" and "i < length (terms_pos t p)" + and "j < length (terms_pos t p)" and "i < j" + shows "terms_pos t p ! i \<lhd> terms_pos t p ! j" + using assms +proof (induct p arbitrary: t i j) + case (Cons a p) + from Cons(2-) have "t |_ [a] \<unrhd> terms_pos (t |_ [a]) p ! i" + by (intro terms_pos_subterm[of p]) auto + from subterm.order.strict_trans1[OF this, of t] Cons(1)[of "t |_ [a]" i j] Cons(2-) show ?case + by (cases "j = length (a # p)") (force simp add: append_Cons_nth_middle append_Cons_nth_left)+ +qed auto + +lemma distinct_terms_pos: + assumes "p \<in> poss t" + shows "distinct (terms_pos t p)" using assms +proof (induct p arbitrary: t) + case (Cons a p) + have "\<And>i. i < Suc (length p) \<Longrightarrow> t \<rhd> (terms_pos (t |_ [a]) p) ! i" + using terms_pos_differ_subterm[OF Cons(2), of _ "Suc (length p)"] by (auto simp: nth_append) + then show ?case using Cons(1)[of "t |_ [a]"] Cons(2-) + by (auto simp: in_set_conv_nth) (metis supt_not_sym) +qed auto + + +lemma term_chain_depth: + assumes "depth t = n" + shows "\<exists> p \<in> poss t. length (terms_pos t p) = (n + 1)" +proof - + obtain p where p: "p \<in> poss t" "length p = depth t" + using poss_length_depth[of t] by blast + from terms_pos_length[of t p] this show ?thesis using assms + by auto +qed + +lemma ta_der_derivation_chain_terms_pos_exist: + assumes "p \<in> poss t" and "q |\<in>| ta_der A t" + shows "\<exists> Cs qs. derivation A (terms_pos t p) Cs qs \<and> last qs = q" + using assms +proof (induct p arbitrary: t q) + case Nil + then show ?case by (auto simp: derivation_def intro!: exI[of _ "[q]"]) +next + case (Cons a p) + from Cons(2) have poss: "p \<in> poss (t |_ [a])" by auto + from Cons(2) obtain C where C: "C\<langle>t |_ [a]\<rangle> = t" + using ctxt_at_pos_subt_at_id poss_Cons by blast + from C ta_der_ctxt_decompose Cons(3) obtain q' where + res: "q' |\<in>| ta_der A (t |_ [a])" "q |\<in>| ta_der A C\<langle>Var q'\<rangle>" + by metis + from Cons(1)[OF _ res(1)] Cons(2-) C obtain Cs qs where + der: "derivation A (terms_pos (t |_ [a]) p) Cs qs \<and> last qs = q'" + by (auto simp del: terms_pos.simps) + {fix i assume "i < Suc (length Cs)" + then have "derivation_ctxt (terms_pos (t |_ [a]) p @ [t]) (Cs @ [C])" + using der C[symmetric] unfolding derivation_def + by (cases "i = length Cs") (auto simp: nth_append_Cons)} + note der_ctxt = this + {fix i assume "i < Suc (length Cs)" + then have "derivation_ctxt_st A (terms_pos (t |_ [a]) p @ [t]) (Cs @ [C]) (qs @ [q])" + using der poss C res(2) last_conv_nth[of qs] + by (cases "i = length Cs", auto 0 0 simp: derivation_def nth_append not_less less_Suc_eq) fastforce+} + then show ?case using C poss res(1) der_ctxt der + by (auto simp: derivation_def intro!: exI[of _ "Cs @ [C]"] exI[of _ "qs @ [q]"]) + (simp add: Cons.prems(2) nth_append_Cons) +qed + +lemma derivation_ctxt_terms_pos_nt_empty: + assumes "p \<in> poss t" and "derivation_ctxt (terms_pos t p) Cs" and "C \<in> set Cs" + shows "C \<noteq> \<box>" + using assms by (auto simp: in_set_conv_nth) + (metis Suc_mono assms(2) ctxt_apply_term.simps(1) distinct_terms_pos lessI less_SucI less_irrefl_nat nth_eq_iff_index_eq) + +lemma derivation_ctxt_terms_pos_sub_list_nt_empty: + assumes "p \<in> poss t" and "derivation_ctxt (terms_pos t p) Cs" + and "i < length Cs" and "j \<le> length Cs" and "i < j" + shows "fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box> \<noteq> \<box>" +proof - + have "\<exists> C. C \<in> set (take (j - i) (drop i Cs))" + using assms(3-) not_le by fastforce + then obtain C where w: "C \<in> set (take (j - i) (drop i Cs))" by blast + then have "C \<noteq> \<box>" + by auto (meson assms(1, 2) derivation_ctxt_terms_pos_nt_empty in_set_dropD in_set_takeD) + then show ?thesis by (auto simp: fold_ctxt_comp_nt_empty[OF w]) +qed + +lemma derivation_ctxt_comp_term: + assumes "derivation_ctxt ts Cs" + and "i < length Cs" and "j \<le> length Cs" and "i < j" + shows "(fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box>)\<langle>ts ! i\<rangle> = ts ! j" + using assms +proof (induct "j - i" arbitrary: j i) + case (Suc x) + then obtain n where j [simp]: "j = Suc n" by (meson lessE) + then have r: "x = n - i" "Suc n - i = 1 + (n - i)" using Suc(2, 6) by linarith+ + then show ?case using Suc(1)[OF r(1)] Suc(2-) unfolding j r(2) take_add[of "n - i" 1] + by (cases "i = n") (auto simp: take_Suc_conv_app_nth) +qed auto + +lemma derivation_ctxt_comp_states: + assumes "derivation_ctxt_st A ts Cs qs" + and "i < length Cs" and "j \<le> length Cs" and "i < j" + shows "qs ! j |\<in>| ta_der A (fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box>)\<langle>Var (qs ! i)\<rangle>" + using assms +proof (induct "j - i" arbitrary: j i) + case (Suc x) + then obtain n where j [simp]: "j = Suc n" by (meson lessE) + then have r: "x = n - i" "Suc n - i = 1 + (n - i)" using Suc(2, 6) by linarith+ + then show ?case using Suc(1)[OF r(1)] Suc(2-) unfolding j r(2) take_add[of "n - i" 1] + by (cases "i = n") (auto simp: take_Suc_conv_app_nth ta_der_ctxt) +qed auto + +lemma terms_pos_ground: + assumes "ground t" and "p \<in> poss t" + shows "\<forall> s \<in> set (terms_pos t p). ground s" + using terms_pos_subterm[OF assms(2)] subterm_eq_pres_ground[OF assms(1)] by simp + + +lemma list_card_smaller_contains_eq_elemens: + assumes "length qs = n" and "card (set qs) < n" + shows "\<exists> i < length qs. \<exists> j < length qs. i < j \<and> qs ! i = qs ! j" + using assms by auto (metis distinct_card distinct_conv_nth linorder_neqE_nat) + +lemma length_remdups_less_eq: + assumes "set xs \<subseteq> set ys" + shows "length (remdups xs) \<le> length (remdups ys)" using assms + by (auto simp: length_remdups_card_conv card_mono) + +(* Main lemma *) + +lemma pigeonhole_tree_automata: + assumes "fcard (\<Q> A) < depth t" and "q |\<in>| ta_der A t" and "ground t" + shows "\<exists> C C2 v p. C2 \<noteq> \<box> \<and> C\<langle>C2\<langle>v\<rangle>\<rangle> = t \<and> p |\<in>| ta_der A v \<and> + p |\<in>| ta_der A C2\<langle>Var p\<rangle> \<and> q |\<in>| ta_der A C\<langle>Var p\<rangle>" +proof - + obtain p n where p: "p \<in> poss t" "depth t = n" and + card: "fcard (\<Q> A) < n" "length (terms_pos t p) = (n + 1)" + using assms(1) term_chain_depth by blast + from ta_der_derivation_chain_terms_pos_exist[OF p(1) assms(2)] obtain Cs qs where + derivation: "derivation A (terms_pos t p) Cs qs \<and> last qs = q" by blast + then have d_ctxt: "derivation_ctxt_st A (terms_pos t p) Cs qs" "derivation_ctxt (terms_pos t p) Cs" + by (auto simp: derivation_def) + then have l: "length Cs = length qs - 1" by (auto simp: derivation_def) + from derivation have sub: "fset_of_list qs |\<subseteq>| \<Q> A" "length qs = length (terms_pos t p)" + unfolding derivation_def + using ta_der_states[of A "t |_ i" for i] terms_pos_ground[OF assms(3) p(1)] + by auto (metis derivation derivation_def gterm_of_term_inv gterm_ta_der_states in_fset_conv_nth nth_mem) + then have "\<exists> i < length (butlast qs). \<exists> j < length (butlast qs). i < j \<and> (butlast qs) ! i = (butlast qs) ! j" + using card(1, 2) assms(1) fcard_mono[OF sub(1)] length_remdups_less_eq[of "butlast qs" qs] + by (intro list_card_smaller_contains_eq_elemens[of "butlast qs" n]) + (auto simp: card_set fcard_fset in_set_butlastD subsetI + intro!: le_less_trans[of "length (remdups (butlast qs))" "fcard (\<Q> A)" "length p"]) + then obtain i j where len: "i < length Cs" "j < length Cs" and less: "i < j" and st: "qs ! i = qs ! j" + unfolding l length_butlast by (auto simp: nth_butlast) + then have gt_0: "0 < length Cs" and gt_j: "0 < j" using len less less_trans by auto + have "fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box> \<noteq> \<box>" + using derivation_ctxt_terms_pos_sub_list_nt_empty[OF p(1) d_ctxt(2) len(1) order.strict_implies_order[OF len(2)] less] . + moreover have "(fold (\<circ>\<^sub>c) (take (length Cs - j) (drop j Cs)) \<box>)\<langle>terms_pos t p ! j\<rangle> = terms_pos t p ! length Cs" + using derivation_ctxt_comp_term[OF d_ctxt(2) len(2) _ len(2)] len(2) by auto + moreover have "(fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box>)\<langle>terms_pos t p ! i\<rangle> = terms_pos t p ! j" + using derivation_ctxt_comp_term[OF d_ctxt(2) len(1) _ less] len(2) by auto + moreover have "qs ! j |\<in>| ta_der A (terms_pos t p ! i)" using derivation len + by (auto simp: derivation_def st[symmetric]) + moreover have "qs ! j |\<in>| ta_der A (fold (\<circ>\<^sub>c) (take (j - i) (drop i Cs)) \<box>)\<langle>Var (qs ! i)\<rangle>" + using derivation_ctxt_comp_states[OF d_ctxt(1) len(1) _ less] len(2) st by simp + moreover have "q |\<in>| ta_der A (fold (\<circ>\<^sub>c) (take (length Cs - j) (drop j Cs)) \<box>)\<langle>Var (qs ! j)\<rangle>" + using derivation_ctxt_comp_states[OF d_ctxt(1) len(2) _ len(2)] conjunct2[OF derivation] + by (auto simp: l sub(2)) (metis Suc_inject Zero_not_Suc d_ctxt(1) l last_conv_nth list.size(3) terms_pos_length) + ultimately show ?thesis using st d_ctxt(1) by (metis Suc_inject terms_pos_last terms_pos_length) +qed + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/Basic_Utils.thy b/thys/Regular_Tree_Relations/Util/Basic_Utils.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/Basic_Utils.thy @@ -0,0 +1,275 @@ +theory Basic_Utils + imports Term_Context +begin + +primrec is_Inl where + "is_Inl (Inl q) \<longleftrightarrow> True" +| "is_Inl (Inr q) \<longleftrightarrow> False" + +primrec is_Inr where + "is_Inr (Inr q) \<longleftrightarrow> True" +| "is_Inr (Inl q) \<longleftrightarrow> False" + +fun remove_sum where + "remove_sum (Inl q) = q" +| "remove_sum (Inr q) = q" + + +text \<open>List operations\<close> + +definition filter_rev_nth where + "filter_rev_nth P xs i = length (filter P (take (Suc i) xs)) - 1" + +lemma filter_rev_nth_butlast: + "\<not> P (last xs) \<Longrightarrow> filter_rev_nth P xs i = filter_rev_nth P (butlast xs) i" + unfolding filter_rev_nth_def + by (induct xs arbitrary: i rule: rev_induct) (auto simp add: take_Cons') + +lemma filter_rev_nth_idx: + assumes "i < length xs" "P (xs ! i)" "ys = filter P xs" + shows "xs ! i = ys ! (filter_rev_nth P xs i) \<and> filter_rev_nth P xs i < length ys" + using assms unfolding filter_rev_nth_def +proof (induct xs arbitrary: ys i) + case (Cons x xs) show ?case + proof (cases "P x") + case True + then obtain ys' where *:"ys = x # ys'" using Cons(4) by auto + show ?thesis using True Cons(1)[of "i - 1" ys'] Cons(2-) + unfolding * + by (cases i) (auto simp: nth_Cons' take_Suc_conv_app_nth) + next + case False + then show ?thesis using Cons(1)[of "i - 1" ys] Cons(2-) + by (auto simp: nth_Cons') + qed +qed auto + + +(*replace list_of_permutation_n with n_lists *) + +primrec add_elem_list_lists :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list list" where + "add_elem_list_lists x [] = [[x]]" +| "add_elem_list_lists x (y # ys) = (x # y # ys) # (map ((#) y) (add_elem_list_lists x ys))" + +lemma length_add_elem_list_lists: + "ys \<in> set (add_elem_list_lists x xs) \<Longrightarrow> length ys = Suc (length xs)" + by (induct xs arbitrary: ys) auto + +lemma add_elem_list_listsE: + assumes "ys \<in> set (add_elem_list_lists x xs)" + shows "\<exists> n \<le> length xs. ys = take n xs @ x # drop n xs" using assms +proof(induct xs arbitrary: ys) + case (Cons a xs) + then show ?case + by auto fastforce +qed auto + +lemma add_elem_list_listsI: + assumes "n \<le> length xs" "ys = take n xs @ x # drop n xs" + shows "ys \<in> set (add_elem_list_lists x xs)" using assms +proof (induct xs arbitrary: ys n) + case (Cons a xs) + then show ?case + by (cases n) (auto simp: image_iff) +qed auto + +lemma add_elem_list_lists_def': + "set (add_elem_list_lists x xs) = {ys | ys n. n \<le> length xs \<and> ys = take n xs @ x # drop n xs}" + using add_elem_list_listsI add_elem_list_listsE + by fastforce + +fun list_of_permutation_element_n :: "'a \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list list" where + "list_of_permutation_element_n x 0 L = [[]]" +| "list_of_permutation_element_n x (Suc n) L = concat (map (add_elem_list_lists x) (List.n_lists n L))" + +lemma list_of_permutation_element_n_conv: + assumes "n \<noteq> 0" + shows "set (list_of_permutation_element_n x n L) = + {xs | xs i. i < length xs \<and> (\<forall> j < length xs. j \<noteq> i \<longrightarrow> xs ! j \<in> set L) \<and> length xs = n \<and> xs ! i = x}" (is "?Ls = ?Rs") +proof (intro equalityI) + from assms obtain j where [simp]: "n = Suc j" using assms by (cases n) auto + {fix ys assume "ys \<in> ?Ls" + then obtain xs i where wit: "xs \<in> set (List.n_lists j L)" "i \<le> length xs" + "ys = take i xs @ x # drop i xs" + by (auto dest: add_elem_list_listsE) + then have "i < length ys" "length ys = Suc (length xs)" "ys ! i = x" + by (auto simp: nth_append) + moreover have "\<forall> j < length ys. j \<noteq> i \<longrightarrow> ys ! j \<in> set L" using wit(1, 2) + by (auto simp: wit(3) min_def nth_append set_n_lists) + ultimately have "ys \<in> ?Rs" using wit(1) unfolding set_n_lists + by auto} + then show "?Ls \<subseteq> ?Rs" by blast +next + {fix xs assume "xs \<in> ?Rs" + then obtain i where wit: "i < length xs" "\<forall> j < length xs. j \<noteq> i \<longrightarrow> xs ! j \<in> set L" + "length xs = n" "xs ! i = x" + by blast + then have *: "xs \<in> set (add_elem_list_lists (xs ! i) (take i xs @ drop (Suc i) xs))" + unfolding add_elem_list_lists_def' + by (auto simp: min_def intro!: nth_equalityI) + (metis Cons_nth_drop_Suc Suc_pred append_Nil append_take_drop_id assms diff_le_self diff_self_eq_0 drop_take less_Suc_eq_le nat_less_le take0) + have [simp]: "x \<in> set (take i xs) \<Longrightarrow> x \<in> set L" + "x \<in> set (drop (Suc i) xs) \<Longrightarrow> x \<in> set L" for x using wit(2) + by (auto simp: set_conv_nth) + have "xs \<in> ?Ls" using wit + by (cases "length xs") + (auto simp: set_n_lists nth_append * min_def + intro!: exI[of _ "take i xs @ drop (Suc i) xs"])} + then show "?Rs \<subseteq> ?Ls" by blast +qed + +lemma list_of_permutation_element_n_iff: + "set (list_of_permutation_element_n x n L) = + (if n = 0 then {[]} else {xs | xs i. i < length xs \<and> (\<forall> j < length xs. j \<noteq> i \<longrightarrow> xs ! j \<in> set L) \<and> length xs = n \<and> xs ! i = x})" +proof (cases n) + case (Suc nat) + then have [simp]: "Suc nat \<noteq> 0" by auto + then show ?thesis + by (auto simp: list_of_permutation_element_n_conv) +qed auto + +lemma list_of_permutation_element_n_conv': + assumes "x \<in> set L" "0 < n" + shows "set (list_of_permutation_element_n x n L) = + {xs. set xs \<subseteq> insert x (set L) \<and> length xs = n \<and> x \<in> set xs}" +proof - + from assms(2) have *: "n \<noteq> 0" by simp + show ?thesis using assms + unfolding list_of_permutation_element_n_conv[OF *] + by (auto simp: in_set_conv_nth) + (metis in_set_conv_nth insert_absorb subsetD)+ +qed + +text \<open>Misc\<close> + +lemma in_set_idx: + "x \<in> set xs \<Longrightarrow> \<exists> i < length xs. xs ! i = x" + by (induct xs) force+ + +lemma set_list_subset_eq_nth_conv: + "set xs \<subseteq> A \<longleftrightarrow> (\<forall> i < length xs. xs ! i \<in> A)" + by (metis in_set_conv_nth subset_code(1)) + +lemma map_eq_nth_conv: + "map f xs = map g ys \<longleftrightarrow> length xs = length ys \<and> (\<forall> i < length ys. f (xs ! i) = g (ys ! i))" + using map_eq_imp_length_eq[of f xs g ys] + by (auto intro: nth_equalityI) (metis nth_map) + +lemma nth_append_Cons: "(xs @ y # zs) ! i = + (if i < length xs then xs ! i else if i = length xs then y else zs ! (i - Suc (length xs)))" + by (cases i "length xs" rule: linorder_cases, auto simp: nth_append) + +lemma map_prod_times: + "f ` A \<times> g ` B = map_prod f g ` (A \<times> B)" + by auto + +lemma trancl_full_on: "(X \<times> X)\<^sup>+ = X \<times> X" + using trancl_unfold_left[of "X \<times> X"] trancl_unfold_right[of "X \<times> X"] by auto + +lemma trancl_map: + assumes simu: "\<And>x y. (x, y) \<in> r \<Longrightarrow> (f x, f y) \<in> s" + and steps: "(x, y) \<in> r\<^sup>+" + shows "(f x, f y) \<in> s\<^sup>+" using steps +proof (induct) + case (step y z) show ?case using step(3) simu[OF step(2)] + by auto +qed (auto simp: simu) + +lemma trancl_map_prod_mono: + "map_both f ` R\<^sup>+ \<subseteq> (map_both f ` R)\<^sup>+" +proof - + have "(f x, f y) \<in> (map_both f ` R)\<^sup>+" if "(x, y) \<in> R\<^sup>+" for x y using that + by (induct) (auto intro: trancl_into_trancl) + then show ?thesis by auto +qed + +lemma trancl_map_both_Restr: + assumes "inj_on f X" + shows "(map_both f ` Restr R X)\<^sup>+ = map_both f ` (Restr R X)\<^sup>+" +proof - + have [simp]: + "map_prod (inv_into X f \<circ> f) (inv_into X f \<circ> f) ` Restr R X = Restr R X" + using inv_into_f_f[OF assms] + by (intro equalityI subrelI) + (force simp: comp_def map_prod_def image_def split: prod.splits)+ + have [simp]: + "map_prod (f \<circ> inv_into X f) (f \<circ> inv_into X f) ` (map_both f ` Restr R X)\<^sup>+ = (map_both f ` Restr R X)\<^sup>+" + using f_inv_into_f[of _ f X] subsetD[OF trancl_mono_set[OF image_mono[of "Restr R X" "X \<times> X" "map_both f"]]] + by (intro equalityI subrelI) (auto simp: map_prod_surj_on trancl_full_on comp_def rev_image_eqI) + show ?thesis using assms trancl_map_prod_mono[of f "Restr R X"] + image_mono[OF trancl_map_prod_mono[of "inv_into X f" "map_both f ` Restr R X"], of "map_both f"] + by (intro equalityI) (simp_all add: image_comp map_prod.comp) +qed + +lemma inj_on_trancl_map_both: + assumes "inj_on f (fst ` R \<union> snd ` R)" + shows "(map_both f ` R)\<^sup>+ = map_both f ` R\<^sup>+" +proof - + have [simp]: "Restr R (fst ` R \<union> snd ` R) = R" + by (force simp: image_def) + then show ?thesis using assms + using trancl_map_both_Restr[of f "fst ` R \<union> snd ` R" R] + by simp +qed + + +lemma kleene_induct: + "A \<subseteq> X \<Longrightarrow> B O X \<subseteq> X \<Longrightarrow> X O C \<subseteq> X \<Longrightarrow> B\<^sup>* O A O C\<^sup>* \<subseteq> X" + using relcomp_mono[OF compat_tr_compat[of B X] subset_refl, of "C\<^sup>*"] compat_tr_compat[of "C\<inverse>" "X\<inverse>"] + relcomp_mono[OF relcomp_mono, OF subset_refl _ subset_refl, of A X "B\<^sup>*" "C\<^sup>*"] + unfolding rtrancl_converse converse_relcomp[symmetric] converse_mono by blast + +lemma kleene_trancl_induct: + "A \<subseteq> X \<Longrightarrow> B O X \<subseteq> X \<Longrightarrow> X O C \<subseteq> X \<Longrightarrow> B\<^sup>+ O A O C\<^sup>+ \<subseteq> X" + using kleene_induct[of A X B C] + by (auto simp: rtrancl_eq_or_trancl) + (meson relcomp.relcompI subsetD trancl_into_rtrancl) + +lemma rtrancl_Un2_separatorE: + "B O A = {} \<Longrightarrow> (A \<union> B)\<^sup>* = A\<^sup>* \<union> A\<^sup>* O B\<^sup>*" + by (metis R_O_Id empty_subsetI relcomp_distrib rtrancl_U_push rtrancl_reflcl_absorb sup_commute) + +lemma trancl_Un2_separatorE: + assumes "B O A = {}" + shows "(A \<union> B)\<^sup>+ = A\<^sup>+ \<union> A\<^sup>+ O B\<^sup>+ \<union> B\<^sup>+" (is "?Ls = ?Rs") +proof - + {fix x y assume "(x, y) \<in> ?Ls" + then have "(x, y) \<in> ?Rs" using assms + proof (induct) + case (step y z) + then show ?case + by (auto simp add: trancl_into_trancl relcomp_unfold dest: tranclD2) + qed auto} + then show ?thesis + by (auto simp add: trancl_mono) + (meson sup_ge1 sup_ge2 trancl_mono trancl_trans) +qed + +text \<open>Sum types where both components have the same type (to create copies)\<close> + +lemma is_InrE: + assumes "is_Inr q" + obtains p where "q = Inr p" + using assms by (cases q) auto + +lemma is_InlE: + assumes "is_Inl q" + obtains p where "q = Inl p" + using assms by (cases q) auto + +lemma not_is_Inr_is_Inl [simp]: + "\<not> is_Inl t \<longleftrightarrow> is_Inr t" + "\<not> is_Inr t \<longleftrightarrow> is_Inl t" + by (cases t, auto)+ + +lemma [simp]: "remove_sum \<circ> Inl = id" by auto + +abbreviation CInl :: "'q \<Rightarrow> 'q + 'q" where "CInl \<equiv> Inl" +abbreviation CInr :: "'q \<Rightarrow> 'q + 'q" where "CInr \<equiv> Inr" + +lemma inj_CInl: "inj CInl" "inj CInr" using inj_Inl inj_Inr by blast+ + +lemma map_prod_simp': "map_prod f g G = (f (fst G), g (snd G))" + by (auto simp add: map_prod_def split!: prod.splits) + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/FSet_Utils.thy b/thys/Regular_Tree_Relations/Util/FSet_Utils.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/FSet_Utils.thy @@ -0,0 +1,541 @@ +theory FSet_Utils + imports "HOL-Library.FSet" + "HOL-Library.List_Lexorder" + Ground_Terms +begin + +context +includes fset.lifting +begin + +lift_definition fCollect :: "('a \<Rightarrow> bool) \<Rightarrow> 'a fset" is "\<lambda> P. if finite (Collect P) then Collect P else {}" + by auto + +lift_definition fSigma :: "'a fset \<Rightarrow> ('a \<Rightarrow> 'b fset) \<Rightarrow> ('a \<times> 'b) fset" is Sigma + by auto + +lift_definition is_fempty :: "'a fset \<Rightarrow> bool" is Set.is_empty . +lift_definition fremove :: "'a \<Rightarrow> 'a fset \<Rightarrow> 'a fset" is Set.remove + by (simp add: remove_def) + +lift_definition finj_on :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a fset \<Rightarrow> bool" is inj_on . +lift_definition the_finv_into :: "'a fset \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a" is the_inv_into . + +lemma fCollect_memberI [intro!]: + "finite (Collect P) \<Longrightarrow> P x \<Longrightarrow> x |\<in>| fCollect P" + by transfer auto + +lemma fCollect_member [iff]: + "x |\<in>| fCollect P \<longleftrightarrow> finite (Collect P) \<and> P x" + by transfer (auto split: if_splits) + +lemma fCollect_cong: "(\<And>x. P x = Q x) \<Longrightarrow> fCollect P = fCollect Q" + by presburger +end + +syntax + "_fColl" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a set" ("(1{|_./ _|})") +translations + "{|x. P|}" \<rightleftharpoons> "CONST fCollect (\<lambda>x. P)" + +syntax (ASCII) + "_fCollect" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> 'a set" ("(1{(_/|:| _)./ _})") +syntax + "_fCollect" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> 'a set" ("(1{(_/ |\<in>| _)./ _})") +translations + "{p|:|A. P}" \<rightharpoonup> "CONST fCollect (\<lambda>p. p |\<in>| A \<and> P)" + +syntax (ASCII) + "_fBall" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3ALL (_/|:|_)./ _)" [0, 0, 10] 10) + "_fBex" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3EX (_/|:|_)./ _)" [0, 0, 10] 10) + +syntax (input) + "_fBall" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3! (_/|:|_)./ _)" [0, 0, 10] 10) + "_fBex" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3? (_/|:|_)./ _)" [0, 0, 10] 10) + +syntax + "_fBall" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3\<forall>(_/|\<in>|_)./ _)" [0, 0, 10] 10) + "_fBex" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>(_/|\<in>|_)./ _)" [0, 0, 10] 10) + +translations + "\<forall>x|\<in>|A. P" \<rightleftharpoons> "CONST fBall A (\<lambda>x. P)" + "\<exists>x|\<in>|A. P" \<rightleftharpoons> "CONST fBex A (\<lambda>x. P)" + +syntax (ASCII output) + "_setlessfAll" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3ALL _|<|_./ _)" [0, 0, 10] 10) + "_setlessfEx" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3EX _|<|_./ _)" [0, 0, 10] 10) + "_setlefAll" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3ALL _|<=|_./ _)" [0, 0, 10] 10) + "_setlefEx" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3EX _|<=|_./ _)" [0, 0, 10] 10) + +syntax + "_setlessfAll" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_|\<subset>|_./ _)" [0, 0, 10] 10) + "_setlessfEx" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_|\<subset>|_./ _)" [0, 0, 10] 10) + "_setlefAll" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<forall>_|\<subseteq>|_./ _)" [0, 0, 10] 10) + "_setlefEx" :: "[idt, 'a, bool] \<Rightarrow> bool" ("(3\<exists>_|\<subseteq>|_./ _)" [0, 0, 10] 10) + +translations + "\<forall>A|\<subset>|B. P" \<rightharpoonup> "\<forall>A. A |\<subset>| B \<longrightarrow> P" + "\<exists>A|\<subset>|B. P" \<rightharpoonup> "\<exists>A. A |\<subset>| B \<and> P" + "\<forall>A|\<subseteq>|B. P" \<rightharpoonup> "\<forall>A. A |\<subseteq>| B \<longrightarrow> P" + "\<exists>A|\<subseteq>|B. P" \<rightharpoonup> "\<exists>A. A |\<subseteq>| B \<and> P" + +syntax + "_fSetcompr" :: "'a \<Rightarrow> idts \<Rightarrow> bool \<Rightarrow> 'a fset" ("(1{|_ |/_./ _|})") + +parse_translation \<open> + let + val ex_tr = snd (Syntax_Trans.mk_binder_tr ("EX ", \<^const_syntax>\<open>Ex\<close>)); + + fun nvars (Const (\<^syntax_const>\<open>_idts\<close>, _) $ _ $ idts) = nvars idts + 1 + | nvars _ = 1; + + fun setcompr_tr ctxt [e, idts, b] = + let + val eq = Syntax.const \<^const_syntax>\<open>HOL.eq\<close> $ Bound (nvars idts) $ e; + val P = Syntax.const \<^const_syntax>\<open>HOL.conj\<close> $ eq $ b; + val exP = ex_tr ctxt [idts, P]; + in Syntax.const \<^const_syntax>\<open>fCollect\<close> $ absdummy dummyT exP end; + + in [(\<^syntax_const>\<open>_fSetcompr\<close>, setcompr_tr)] end +\<close> + +print_translation \<open> + [Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\<open>fBall\<close> \<^syntax_const>\<open>_fBall\<close>, + Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\<open>fBex\<close> \<^syntax_const>\<open>_fBex\<close>] +\<close> \<comment> \<open>to avoid eta-contraction of body\<close> + +print_translation \<open> +let + val ex_tr' = snd (Syntax_Trans.mk_binder_tr' (\<^const_syntax>\<open>Ex\<close>, "DUMMY")); + + fun setcompr_tr' ctxt [Abs (abs as (_, _, P))] = + let + fun check (Const (\<^const_syntax>\<open>Ex\<close>, _) $ Abs (_, _, P), n) = check (P, n + 1) + | check (Const (\<^const_syntax>\<open>HOL.conj\<close>, _) $ + (Const (\<^const_syntax>\<open>HOL.eq\<close>, _) $ Bound m $ e) $ P, n) = + n > 0 andalso m = n andalso not (loose_bvar1 (P, n)) andalso + subset (=) (0 upto (n - 1), add_loose_bnos (e, 0, [])) + | check _ = false; + + fun tr' (_ $ abs) = + let val _ $ idts $ (_ $ (_ $ _ $ e) $ Q) = ex_tr' ctxt [abs] + in Syntax.const \<^syntax_const>\<open>_fSetcompr\<close> $ e $ idts $ Q end; + in + if check (P, 0) then tr' P + else + let + val (x as _ $ Free(xN, _), t) = Syntax_Trans.atomic_abs_tr' abs; + val M = Syntax.const \<^syntax_const>\<open>_fColl\<close> $ x $ t; + in + case t of + Const (\<^const_syntax>\<open>HOL.conj\<close>, _) $ + (Const (\<^const_syntax>\<open>fmember\<close>, _) $ + (Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (yN, _)) $ A) $ P => + if xN = yN then Syntax.const \<^syntax_const>\<open>_fCollect\<close> $ x $ A $ P else M + | _ => M + end + end; + in [(\<^const_syntax>\<open>fCollect\<close>, setcompr_tr')] end +\<close> + +syntax + "_fSigma" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> 'b fset \<Rightarrow> ('a \<times> 'b) set" ("(3fSIGMA _|:|_./ _)" [0, 0, 10] 10) +translations + "fSIGMA x|:|A. B" \<rightleftharpoons> "CONST fSigma A (\<lambda>x. B)" + +notation + ffUnion ("|\<Union>|") + +context +includes fset.lifting +begin + +lemma right_total_cr_fset [transfer_rule]: + "right_total cr_fset" + by (auto simp: cr_fset_def right_total_def) + +lemma bi_unique_cr_fset [transfer_rule]: + "bi_unique cr_fset" + by (auto simp: bi_unique_def cr_fset_def fset_inject) + +lemma right_total_pcr_fset_eq [transfer_rule]: + "right_total (pcr_fset (=))" + by (simp add: right_total_cr_fset fset.pcr_cr_eq) + +lemma bi_unique_pcr_fset [transfer_rule]: + "bi_unique (pcr_fset (=))" + by (simp add: fset.pcr_cr_eq bi_unique_cr_fset) + + +lemma set_fset_of_list_transfer [transfer_rule]: + "rel_fun (list_all2 A) (pcr_fset A) set fset_of_list" + unfolding pcr_fset_def rel_set_def rel_fun_def + by (force simp: list_all2_conv_all_nth in_set_conv_nth cr_fset_def fset_of_list.rep_eq relcompp_apply) + + +lemma fCollectD: "a |\<in>| {|x . P x|} \<Longrightarrow> P a" + by transfer (auto split: if_splits) + +lemma fCollectI: "P a \<Longrightarrow> finite (Collect P) \<Longrightarrow> a |\<in>| {| x. P x|}" + by (auto intro: fCollect_memberI) + +lemma fCollect_fempty_eq [simp]: "fCollect P = {||} \<longleftrightarrow> (\<forall>x. \<not> P x) \<or> infinite (Collect P)" + by auto + +lemma fempty_fCollect_eq [simp]: "{||} = fCollect P \<longleftrightarrow> (\<forall>x. \<not> P x) \<or> infinite (Collect P)" + by auto + + +lemma fset_image_conv: + "{f x | x. x |\<in>| T} = fset (f |`| T)" + by transfer auto + +lemma fimage_def: + "f |`| A = {| y. \<exists>x|\<in>|A. y = f x |}" + by transfer auto + +lemma ffilter_simp: "ffilter P A = {a |\<in>| A. P a}" + by transfer auto + +lemmas fset_list_fsubset_eq_nth_conv = set_list_subset_eq_nth_conv[Transfer.transferred] +lemmas mem_idx_fset_sound = mem_idx_sound[Transfer.transferred] +\<comment> \<open>Dealing with fset products\<close> + +abbreviation fTimes :: "'a fset \<Rightarrow> 'b fset \<Rightarrow> ('a \<times> 'b) fset" (infixr "|\<times>|" 80) + where "A |\<times>| B \<equiv> fSigma A (\<lambda>_. B)" + +lemma fSigma_repeq: + "fset (A |\<times>| B) = fset A \<times> fset B" + by (transfer) auto + +lemmas fSigmaI [intro!] = SigmaI[Transfer.transferred] +lemmas fSigmaE [elim!] = SigmaE[Transfer.transferred] +lemmas fSigmaD1 = SigmaD1[Transfer.transferred] +lemmas fSigmaD2 = SigmaD2[Transfer.transferred] +lemmas fSigmaE2 = SigmaE2[Transfer.transferred] +lemmas fSigma_cong = Sigma_cong[Transfer.transferred] +lemmas fSigma_mono = Sigma_mono[Transfer.transferred] +lemmas fSigma_empty1 [simp] = Sigma_empty1[Transfer.transferred] +lemmas fSigma_empty2 [simp] = Sigma_empty2[Transfer.transferred] +lemmas fmem_Sigma_iff [iff] = mem_Sigma_iff[Transfer.transferred] +lemmas fmem_Times_iff = mem_Times_iff[Transfer.transferred] +lemmas fSigma_empty_iff = Sigma_empty_iff[Transfer.transferred] +lemmas fTimes_subset_cancel2 = Times_subset_cancel2[Transfer.transferred] +lemmas fTimes_eq_cancel2 = Times_eq_cancel2[Transfer.transferred] +lemmas fUN_Times_distrib = UN_Times_distrib[Transfer.transferred] +lemmas fsplit_paired_Ball_Sigma [simp, no_atp] = split_paired_Ball_Sigma[Transfer.transferred] +lemmas fsplit_paired_Bex_Sigma [simp, no_atp] = split_paired_Bex_Sigma[Transfer.transferred] +lemmas fSigma_Un_distrib1 = Sigma_Un_distrib1[Transfer.transferred] +lemmas fSigma_Un_distrib2 = Sigma_Un_distrib2[Transfer.transferred] +lemmas fSigma_Int_distrib1 = Sigma_Int_distrib1[Transfer.transferred] +lemmas fSigma_Int_distrib2 = Sigma_Int_distrib2[Transfer.transferred] +lemmas fSigma_Diff_distrib1 = Sigma_Diff_distrib1[Transfer.transferred] +lemmas fSigma_Diff_distrib2 = Sigma_Diff_distrib2[Transfer.transferred] +lemmas fSigma_Union = Sigma_Union[Transfer.transferred] +lemmas fTimes_Un_distrib1 = Times_Un_distrib1[Transfer.transferred] +lemmas fTimes_Int_distrib1 = Times_Int_distrib1[Transfer.transferred] +lemmas fTimes_Diff_distrib1 = Times_Diff_distrib1[Transfer.transferred] +lemmas fTimes_empty [simp] = Times_empty[Transfer.transferred] +lemmas ftimes_subset_iff = times_subset_iff[Transfer.transferred] +lemmas ftimes_eq_iff = times_eq_iff[Transfer.transferred] +lemmas ffst_image_times [simp] = fst_image_times[Transfer.transferred] +lemmas fsnd_image_times [simp] = snd_image_times[Transfer.transferred] +lemmas fsnd_image_Sigma = snd_image_Sigma[Transfer.transferred] +lemmas finsert_Times_insert = insert_Times_insert[Transfer.transferred] +lemmas fTimes_Int_Times = Times_Int_Times[Transfer.transferred] +lemmas fimage_paired_Times = image_paired_Times[Transfer.transferred] +lemmas fproduct_swap = product_swap[Transfer.transferred] +lemmas fswap_product = swap_product[Transfer.transferred] +lemmas fsubset_fst_snd = subset_fst_snd[Transfer.transferred] +lemmas map_prod_ftimes = map_prod_times[Transfer.transferred] + + +lemma fCollect_case_prod [simp]: + "{|(a, b). P a \<and> Q b|} = fCollect P |\<times>| fCollect Q" + by transfer (auto dest: finite_cartesian_productD1 finite_cartesian_productD2) +lemma fCollect_case_prodD: + "x |\<in>| {|(x, y). A x y|} \<Longrightarrow> A (fst x) (snd x)" + by auto + + +(*FIX *) +lemmas fCollect_case_prod_Sigma = Collect_case_prod_Sigma[Transfer.transferred] +lemmas ffst_image_Sigma = fst_image_Sigma[Transfer.transferred] +lemmas fimage_split_eq_Sigma = image_split_eq_Sigma[Transfer.transferred] + + +\<comment> \<open>Dealing with transitive closure\<close> + +lift_definition ftrancl :: "('a \<times> 'a) fset \<Rightarrow> ('a \<times> 'a) fset" ("(_|\<^sup>+|)" [1000] 999) is trancl + by auto + +lemmas fr_into_trancl [intro, Pure.intro] = r_into_trancl[Transfer.transferred] +lemmas ftrancl_into_trancl [Pure.intro] = trancl_into_trancl[Transfer.transferred] +lemmas ftrancl_induct[consumes 1, case_names Base Step] = trancl.induct[Transfer.transferred] +lemmas ftrancl_mono = trancl_mono[Transfer.transferred] +lemmas ftrancl_trans[trans] = trancl_trans[Transfer.transferred] +lemmas ftrancl_empty [simp] = trancl_empty [Transfer.transferred] +lemmas ftranclE[cases set: ftrancl] = tranclE[Transfer.transferred] +lemmas converse_ftrancl_induct[consumes 1, case_names Base Step] = converse_trancl_induct[Transfer.transferred] +lemmas converse_ftranclE = converse_tranclE[Transfer.transferred] +lemma in_ftrancl_UnI: + "x |\<in>| R|\<^sup>+| \<or> x |\<in>| S|\<^sup>+| \<Longrightarrow> x |\<in>| (R |\<union>| S)|\<^sup>+|" + by transfer (auto simp add: trancl_mono) + +lemma ftranclD: + "(x, y) |\<in>| R|\<^sup>+| \<Longrightarrow> \<exists>z. (x, z) |\<in>| R \<and> (z = y \<or> (z, y) |\<in>| R|\<^sup>+|)" + by (induct rule: ftrancl_induct) (auto, meson ftrancl_into_trancl) + +lemma ftranclD2: + "(x, y) |\<in>| R|\<^sup>+| \<Longrightarrow> \<exists>z. (x = z \<or> (x, z) |\<in>| R|\<^sup>+|) \<and> (z, y) |\<in>| R" + by (induct rule: ftrancl_induct) auto + +lemma not_ftrancl_into: + "(x, z) |\<notin>| r|\<^sup>+| \<Longrightarrow> (y, z) |\<in>| r \<Longrightarrow> (x, y) |\<notin>| r|\<^sup>+|" + by transfer (auto simp add: trancl.trancl_into_trancl) +lemmas ftrancl_map_both_fRestr = trancl_map_both_Restr[Transfer.transferred] +lemma ftrancl_map_both_fsubset: + "finj_on f X \<Longrightarrow> R |\<subseteq>| X |\<times>| X \<Longrightarrow> (map_both f |`| R)|\<^sup>+| = map_both f |`| R|\<^sup>+|" + using ftrancl_map_both_fRestr[of f X R] + by (simp add: inf_absorb1) +lemmas ftrancl_map_prod_mono = trancl_map_prod_mono[Transfer.transferred] +lemmas ftrancl_map = trancl_map[Transfer.transferred] + + +lemmas ffUnion_iff [simp] = Union_iff[Transfer.transferred] +lemmas ffUnionI [intro] = UnionI[Transfer.transferred] +lemmas fUn_simps [simp] = UN_simps[Transfer.transferred] + + +(* TODO Diff *) +lemmas fINT_simps [simp] = INT_simps[Transfer.transferred] + +lemmas fUN_ball_bex_simps [simp] = UN_ball_bex_simps[Transfer.transferred] + +(* List *) +lemmas in_fset_conv_nth = in_set_conv_nth[Transfer.transferred] +lemmas fnth_mem [simp] = nth_mem[Transfer.transferred] +lemmas distinct_sorted_list_of_fset = distinct_sorted_list_of_set [Transfer.transferred] +lemmas fcard_fset = card_set[Transfer.transferred] +lemma upt_fset: + "fset_of_list [i..<j] = fCollect (\<lambda> n. i \<le> n \<and> n < j)" + by (induct j arbitrary: i) auto + +(* Restr *) +abbreviation fRestr :: "('a \<times> 'a) fset \<Rightarrow> 'a fset \<Rightarrow> ('a \<times> 'a) fset" where + "fRestr r A \<equiv> r |\<inter>| (A |\<times>| A)" + +(* Identity on set*) + +lift_definition fId_on :: "'a fset \<Rightarrow> ('a \<times> 'a) fset" is Id_on + using Id_on_subset_Times finite_subset by fastforce + +lemmas fId_on_empty [simp] = Id_on_empty [Transfer.transferred] +lemmas fId_on_eqI = Id_on_eqI [Transfer.transferred] +lemmas fId_onI [intro!] = Id_onI [Transfer.transferred] +lemmas fId_onE [elim!] = Id_onE [Transfer.transferred] +lemmas fId_on_iff = Id_on_iff [Transfer.transferred] +lemmas fId_on_fsubset_fTimes = Id_on_subset_Times [Transfer.transferred] + +(* Converse*) +lift_definition fconverse :: "('a \<times> 'b) fset \<Rightarrow> ('b \<times> 'a) fset" ("(_|\<inverse>|)" [1000] 999) is converse by auto + +lemmas fconverseI [sym] = converseI [Transfer.transferred] +lemmas fconverseD [sym] = converseD [Transfer.transferred] +lemmas fconverseE [elim!] = converseE [Transfer.transferred] +lemmas fconverse_iff [iff] = converse_iff[Transfer.transferred] +lemmas fconverse_fconverse [simp] = converse_converse[Transfer.transferred] +lemmas fconverse_empty[simp] = converse_empty[Transfer.transferred] + +(* injectivity *) + +lemmas finj_on_def' = inj_on_def[Transfer.transferred] +lemmas fsubset_finj_on = subset_inj_on[Transfer.transferred] +lemmas the_finv_into_f_f = the_inv_into_f_f[Transfer.transferred] +lemmas f_the_finv_into_f = f_the_inv_into_f[Transfer.transferred] +lemmas the_finv_into_into = the_inv_into_into[Transfer.transferred] +lemmas the_finv_into_onto [simp] = the_inv_into_onto[Transfer.transferred] +lemmas the_finv_into_f_eq = the_inv_into_f_eq[Transfer.transferred] +lemmas the_finv_into_comp = the_inv_into_comp[Transfer.transferred] +lemmas finj_on_the_finv_into = inj_on_the_inv_into [Transfer.transferred] +lemmas finj_on_fUn = inj_on_Un[Transfer.transferred] + +lemma finj_Inl_Inr: + "finj_on Inl A" "finj_on Inr A" + by (transfer, auto)+ +lemma finj_CInl_CInr: + "finj_on CInl A" "finj_on CInr A" + using finj_Inl_Inr by force+ + +lemma finj_Some: + "finj_on Some A" + by (transfer, auto) + +(* Image *) + +lift_definition fImage :: "('a \<times> 'b) fset \<Rightarrow> 'a fset \<Rightarrow> 'b fset" (infixr "|``|" 90) is Image + using finite_Image by force + +lemmas fImage_iff = Image_iff[Transfer.transferred] +lemmas fImage_singleton_iff [iff] = Image_singleton_iff[Transfer.transferred] +lemmas fImageI [intro] = ImageI[Transfer.transferred] +lemmas ImageE [elim!] = ImageE[Transfer.transferred] +lemmas frev_ImageI = rev_ImageI[Transfer.transferred] +lemmas fImage_empty1 [simp] = Image_empty1[Transfer.transferred] +lemmas fImage_empty2 [simp] = Image_empty2[Transfer.transferred] +lemmas fImage_fInt_fsubset = Image_Int_subset[Transfer.transferred] +lemmas fImage_fUn = Image_Un[Transfer.transferred] +lemmas fUn_fImage = Un_Image[Transfer.transferred] +lemmas fImage_fsubset = Image_subset[Transfer.transferred] +lemmas fImage_eq_fUN = Image_eq_UN[Transfer.transferred] +lemmas fImage_mono = Image_mono[Transfer.transferred] +lemmas fImage_fUN = Image_UN[Transfer.transferred] +lemmas fUN_fImage = UN_Image[Transfer.transferred] +lemmas fSigma_fImage = Sigma_Image[Transfer.transferred] + + +(* fix us *) +lemmas fImage_singleton = Image_singleton[Transfer.transferred] +lemmas fImage_Id_on [simp] = Image_Id_on[Transfer.transferred] +lemmas fImage_Id [simp] = Image_Id[Transfer.transferred] +lemmas fImage_fInt_eq = Image_Int_eq[Transfer.transferred] +lemmas fImage_fsubset_eq = Image_subset_eq[Transfer.transferred] +lemmas fImage_fCollect_case_prod [simp] = Image_Collect_case_prod[Transfer.transferred] +lemmas fImage_fINT_fsubset = Image_INT_subset[Transfer.transferred] +(* Misc *) +lemmas term_fset_induct = term.induct[Transfer.transferred] +lemmas fmap_prod_fimageI = map_prod_imageI[Transfer.transferred] +lemmas finj_on_eq_iff = inj_on_eq_iff[Transfer.transferred] +lemmas prod_fun_fimageE = prod_fun_imageE[Transfer.transferred] + +lemma rel_set_cr_fset: + "rel_set cr_fset = (\<lambda> A B. A = fset ` B)" +proof - + have "rel_set cr_fset A B \<longleftrightarrow> A = fset ` B" for A B + by (auto simp: image_def rel_set_def cr_fset_def ) + then show ?thesis by blast +qed +lemma pcr_fset_cr_fset: + "pcr_fset cr_fset = (\<lambda> x y. x = fset (fset |`| y))" + unfolding pcr_fset_def rel_set_cr_fset + unfolding cr_fset_def + by (auto simp: image_def relcompp_apply) + + +lemma sorted_list_of_fset_id: + "sorted_list_of_fset x = sorted_list_of_fset y \<Longrightarrow> x = y" + by (metis sorted_list_of_fset_simps(2)) + +(*end *) + +lemmas fBall_def = Ball_def[Transfer.transferred] +lemmas fBex_def = Bex_def[Transfer.transferred] +lemmas fCollectE = fCollectD [elim_format] +lemma fCollect_conj_eq: + "finite (Collect P) \<Longrightarrow> finite (Collect Q) \<Longrightarrow> {|x. P x \<and> Q x|} = fCollect P |\<inter>| fCollect Q" + by auto + +lemma finite_ntrancl: + "finite R \<Longrightarrow> finite (ntrancl n R)" + by (induct n) auto + +lift_definition nftrancl :: "nat \<Rightarrow> ('a \<times> 'a) fset \<Rightarrow> ('a \<times> 'a) fset" is ntrancl + by (intro finite_ntrancl) simp + +lift_definition frelcomp :: "('a \<times> 'b) fset \<Rightarrow> ('b \<times> 'c) fset \<Rightarrow> ('a \<times> 'c) fset" (infixr "|O|" 75) is relcomp + by (intro finite_relcomp) simp + +lemmas frelcompE[elim!] = relcompE[Transfer.transferred] +lemmas frelcompI[intro] = relcompI[Transfer.transferred] +lemma fId_on_frelcomp_id: + "fst |`| R |\<subseteq>| S \<Longrightarrow> fId_on S |O| R = R" + by (auto intro!: frelcompI) +lemma fId_on_frelcomp_id2: + "snd |`| R |\<subseteq>| S \<Longrightarrow> R |O| fId_on S = R" + by (auto intro!: frelcompI) + + +lemmas fimage_fset = image_set[Transfer.transferred] +lemmas ftrancl_Un2_separatorE = trancl_Un2_separatorE[Transfer.transferred] + +(* finite vars of term finite function symbols of terms *) + +lemma finite_funs_term: "finite (funs_term t)" by (induct t) auto +lemma finite_funas_term: "finite (funas_term t)" by (induct t) auto +lemma finite_vars_ctxt: "finite (vars_ctxt C)" by (induct C) auto + +lift_definition ffuns_term :: "('f, 'v) term \<Rightarrow> 'f fset" is funs_term using finite_funs_term + by blast +lift_definition fvars_term :: "('f, 'v) term \<Rightarrow> 'v fset" is vars_term by simp +lift_definition fvars_ctxt :: "('f, 'v) ctxt \<Rightarrow> 'v fset" is vars_ctxt by (simp add: finite_vars_ctxt) + + +lemmas fvars_term_ctxt_apply [simp] = vars_term_ctxt_apply[Transfer.transferred] +lemmas fvars_term_of_gterm [simp] = vars_term_of_gterm[Transfer.transferred] +lemmas ground_fvars_term_empty [simp] = ground_vars_term_empty[Transfer.transferred] + +lemma ffuns_term_Var [simp]: "ffuns_term (Var x) = {||}" + by transfer auto +lemma fffuns_term_Fun [simp]: "ffuns_term (Fun f ts) = |\<Union>| (ffuns_term |`| fset_of_list ts) |\<union>| {|f|}" + by transfer auto + +lemma fvars_term_Var [simp]: "fvars_term (Var x) = {|x|}" + by transfer auto +lemma fvars_term_Fun [simp]: "fvars_term (Fun f ts) = |\<Union>| (fvars_term |`| fset_of_list ts)" + by transfer auto + +lift_definition ffunas_term :: "('f, 'v) term \<Rightarrow> ('f \<times> nat) fset" is funas_term + by (simp add: finite_funas_term) +lift_definition ffunas_gterm :: "'f gterm \<Rightarrow> ('f \<times> nat) fset" is funas_gterm + by (simp add: finite_funas_gterm) + +lemmas ffunas_term_simps [simp] = funas_term.simps[Transfer.transferred] +lemmas ffunas_gterm_simps [simp] = funas_gterm.simps[Transfer.transferred] +lemmas ffunas_term_of_gterm_conv = funas_term_of_gterm_conv[Transfer.transferred] +lemmas ffunas_gterm_gterm_of_term = funas_gterm_gterm_of_term[Transfer.transferred] + + +lemma sorted_list_of_fset_fimage_dist: + "sorted_list_of_fset (f |`| A) = sort (remdups (map f (sorted_list_of_fset A)))" + by (auto simp: sorted_list_of_fset.rep_eq simp flip: sorted_list_of_set_sort_remdups) + +end + +(* Move me *) +lemma finite_snd [intro]: + "finite S \<Longrightarrow> finite {x. (y, x) \<in> S}" + by (induct S rule: finite.induct) auto + +lemma finite_Collect_less_eq: + "Q \<le> P \<Longrightarrow> finite (Collect P) \<Longrightarrow> finite (Collect Q)" + by (metis (full_types) Ball_Collect infinite_iff_countable_subset rev_predicate1D) + + +datatype 'a FSet_Lex_Wrapper = Wrapp (ex: "'a fset") + +lemma inj_FSet_Lex_Wrapper: "inj Wrapp" + unfolding inj_def by auto + +lemmas ftrancl_map_both = inj_on_trancl_map_both[Transfer.transferred] + +instantiation FSet_Lex_Wrapper :: (linorder) linorder +begin + +definition less_eq_FSet_Lex_Wrapper :: "('a :: linorder) FSet_Lex_Wrapper \<Rightarrow> 'a FSet_Lex_Wrapper \<Rightarrow> bool" + where "less_eq_FSet_Lex_Wrapper S T = + (let S' = sorted_list_of_fset (ex S) in + let T' = sorted_list_of_fset (ex T) in + S' \<le> T')" + +definition less_FSet_Lex_Wrapper :: "'a FSet_Lex_Wrapper \<Rightarrow> 'a FSet_Lex_Wrapper \<Rightarrow> bool" + where "less_FSet_Lex_Wrapper S T = + (let S' = sorted_list_of_fset (ex S) in + let T' = sorted_list_of_fset (ex T) in + S' < T')" + +instance by (intro_classes) + (auto simp: less_eq_FSet_Lex_Wrapper_def less_FSet_Lex_Wrapper_def ex_def FSet_Lex_Wrapper.expand dest: sorted_list_of_fset_id) +end + + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/Ground_Closure.thy b/thys/Regular_Tree_Relations/Util/Ground_Closure.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/Ground_Closure.thy @@ -0,0 +1,247 @@ +theory Ground_Closure + imports Ground_Terms +begin + +subsubsection \<open>Multihole context closure\<close> + +text \<open>Computing the multihole context closure of a given relation\<close> +inductive_set gmctxt_cl :: "('f \<times> nat) set \<Rightarrow> 'f gterm rel \<Rightarrow> 'f gterm rel" for \<F> \<R> where + base [intro]: "(s, t) \<in> \<R> \<Longrightarrow> (s, t) \<in> gmctxt_cl \<F> \<R>" +| step [intro]: "length ss = length ts \<Longrightarrow> (\<forall> i < length ts. (ss ! i, ts ! i) \<in> gmctxt_cl \<F> \<R>) \<Longrightarrow> (f, length ss) \<in> \<F> \<Longrightarrow> + (GFun f ss, GFun f ts) \<in> gmctxt_cl \<F> \<R>" + +lemma gmctxt_cl_idemp [simp]: + "gmctxt_cl \<F> (gmctxt_cl \<F> \<R>) = gmctxt_cl \<F> \<R>" +proof - + {fix s t assume "(s, t) \<in> gmctxt_cl \<F> (gmctxt_cl \<F> \<R>)" + then have "(s, t) \<in> gmctxt_cl \<F> \<R>" + by (induct) (auto intro: gmctxt_cl.step)} + then show ?thesis by auto +qed + +lemma gmctxt_cl_refl: + "funas_gterm t \<subseteq> \<F> \<Longrightarrow> (t, t) \<in> gmctxt_cl \<F> \<R>" + by (induct t) (auto simp: SUP_le_iff intro!: gmctxt_cl.step) + +lemma gmctxt_cl_swap: + "gmctxt_cl \<F> (prod.swap ` \<R>) = prod.swap ` gmctxt_cl \<F> \<R>" (is "?Ls = ?Rs") +proof - + {fix s t assume "(s, t) \<in> ?Ls" then have "(s, t) \<in> ?Rs" + by induct auto} + moreover + {fix s t assume "(s, t) \<in> ?Rs" + then have "(t, s) \<in> gmctxt_cl \<F> \<R>" by auto + then have "(s, t) \<in> ?Ls" by induct auto} + ultimately show ?thesis by auto +qed + +lemma gmctxt_cl_mono_funas: + assumes "\<F> \<subseteq> \<G>" shows "gmctxt_cl \<F> \<R> \<subseteq> gmctxt_cl \<G> \<R>" +proof - + {fix s t assume "(s, t) \<in> gmctxt_cl \<F> \<R>" then have "(s, t) \<in> gmctxt_cl \<G> \<R>" + by induct (auto simp: subsetD[OF assms])} + then show ?thesis by auto +qed + +lemma gmctxt_cl_mono_rel: + assumes "\ \<subseteq> \<R>" shows "gmctxt_cl \<F> \ \<subseteq> gmctxt_cl \<F> \<R>" +proof - + {fix s t assume "(s, t) \<in> gmctxt_cl \<F> \" then have "(s, t) \<in> gmctxt_cl \<F> \<R>" using assms + by induct auto} + then show ?thesis by auto +qed + +definition gcomp_rel :: "('f \<times> nat) set \<Rightarrow> 'f gterm rel \<Rightarrow> 'f gterm rel \<Rightarrow> 'f gterm rel" where + "gcomp_rel \<F> R S = (R O gmctxt_cl \<F> S) \<union> (gmctxt_cl \<F> R O S)" + +definition gtrancl_rel :: "('f \<times> nat) set \<Rightarrow> 'f gterm rel \<Rightarrow> 'f gterm rel" where + "gtrancl_rel \<F> \<R> = (gmctxt_cl \<F> \<R>)\<^sup>+ O \<R> O (gmctxt_cl \<F> \<R>)\<^sup>+" + +lemma gcomp_rel: + "gmctxt_cl \<F> (gcomp_rel \<F> \<R> \<S>) = gmctxt_cl \<F> \<R> O gmctxt_cl \<F> \<S>" (is "?Ls = ?Rs") +proof + { fix s u assume "(s, u) \<in> gmctxt_cl \<F> (\<R> O gmctxt_cl \<F> \<S> \<union> gmctxt_cl \<F> \<R> O \<S>)" + then have "\<exists>t. (s, t) \<in> gmctxt_cl \<F> \<R> \<and> (t, u) \<in> gmctxt_cl \<F> \<S>" + proof (induct) + case (step ss ts f) + from Ex_list_of_length_P[of _ "\<lambda> u i. (ss ! i, u) \<in> gmctxt_cl \<F> \<R> \<and> (u, ts ! i) \<in> gmctxt_cl \<F> \<S>"] + obtain us where l: "length us = length ts" and + inv: "\<forall> i < length ts. (ss ! i, us ! i) \<in> gmctxt_cl \<F> \<R> \<and> (us ! i, ts ! i) \<in> gmctxt_cl \<F> \<S>" + using step(2, 3) by blast + then show ?case using step(1, 3) + by (intro exI[of _ "GFun f us"]) auto + qed auto} + then show "?Ls \<subseteq> ?Rs" unfolding gcomp_rel_def + by auto +next + {fix s t u assume "(s, t) \<in> gmctxt_cl \<F> \<R>" "(t, u) \<in> gmctxt_cl \<F> \<S>" + then have "(s, u) \<in> gmctxt_cl \<F> (\<R> O gmctxt_cl \<F> \<S> \<union> gmctxt_cl \<F> \<R> O \<S>)" + proof (induct arbitrary: u rule: gmctxt_cl.induct) + case (step ss ts f) + then show ?case + proof (cases "(GFun f ts, u) \<in> \<S>") + case True + then have "(GFun f ss, u) \<in> gmctxt_cl \<F> \<R> O \<S>" using gmctxt_cl.step[OF step(1) _ step(3)] step(2) + by auto + then show ?thesis by auto + next + case False + then obtain us where u[simp]: "u = GFun f us" and l: "length ts = length us" + using step(4) by (cases u) (auto elim: gmctxt_cl.cases) + have "i < length us \<Longrightarrow> + (ss ! i, us ! i) \<in> gmctxt_cl \<F> (\<R> O gmctxt_cl \<F> \<S> \<union> gmctxt_cl \<F> \<R> O \<S>)" for i + using step(1, 2, 4) False by (auto elim: gmctxt_cl.cases) + then show ?thesis using l step(1, 3) + by auto + qed + qed auto} + then show "?Rs \<subseteq> ?Ls" + by (auto simp: gcomp_rel_def) +qed + +subsubsection \<open>Signature closed property\<close> + +definition all_ctxt_closed :: "('f \<times> nat) set \<Rightarrow> 'f gterm rel \<Rightarrow> bool" where + "all_ctxt_closed F r \<longleftrightarrow> (\<forall> f ts ss. (f, length ss) \<in> F \<longrightarrow> length ss = length ts \<longrightarrow> + (\<forall>i. i < length ts \<longrightarrow> (ss ! i, ts ! i) \<in> r) \<longrightarrow> + (GFun f ss, GFun f ts) \<in> r)" + +lemma all_ctxt_closedI: + assumes "\<And> f ss ts. (f, length ss) \<in> \<F> \<Longrightarrow> length ss = length ts \<Longrightarrow> + (\<forall> i < length ts. (ss ! i, ts ! i) \<in> r) \<Longrightarrow> (GFun f ss, GFun f ts) \<in> r" + shows "all_ctxt_closed \<F> r" using assms + unfolding all_ctxt_closed_def by auto + +lemma all_ctxt_closedD: + "all_ctxt_closed F r \<Longrightarrow> (f, length ss) \<in> F \<Longrightarrow> length ss = length ts \<Longrightarrow> + (\<forall> i < length ts. (ss ! i, ts ! i) \<in> r) \<Longrightarrow> (GFun f ss, GFun f ts) \<in> r" + by (auto simp: all_ctxt_closed_def) + +lemma all_ctxt_closed_refl_on: + assumes "all_ctxt_closed \<F> r" "s \<in> \<T>\<^sub>G \<F>" + shows "(s, s) \<in> r" using assms(2) + by (induct) (auto simp: all_ctxt_closedD[OF assms(1)]) + +lemma gmctxt_cl_is_all_ctxt_closed [simp]: + "all_ctxt_closed \<F> (gmctxt_cl \<F> \<R>)" + unfolding all_ctxt_closed_def + by auto + +lemma all_ctxt_closed_gmctxt_cl_idem [simp]: + assumes "all_ctxt_closed \<F> \<R>" + shows "gmctxt_cl \<F> \<R> = \<R>" +proof - + {fix s t assume "(s, t) \<in> gmctxt_cl \<F> \<R>" then have "(s, t) \<in> \<R>" + proof (induct) + case (step ss ts f) + show ?case using step(2) all_ctxt_closedD[OF assms step(3, 1)] + by auto + qed auto} + then show ?thesis by auto +qed + + +subsubsection \<open>Transitive closure preserves @{const all_ctxt_closed}\<close> + +text \<open>induction scheme for transitive closures of lists\<close> + +inductive_set trancl_list for \<R> where + base[intro, Pure.intro] : "length xs = length ys \<Longrightarrow> + (\<forall> i < length ys. (xs ! i, ys ! i) \<in> \<R>) \<Longrightarrow> (xs, ys) \<in> trancl_list \<R>" +| list_trancl [Pure.intro]: "(xs, ys) \<in> trancl_list \<R> \<Longrightarrow> i < length ys \<Longrightarrow> (ys ! i, z) \<in> \<R> \<Longrightarrow> + (xs, ys[i := z]) \<in> trancl_list \<R>" + +lemma trancl_list_appendI [simp, intro]: + "(xs, ys) \<in> trancl_list \<R> \<Longrightarrow> (x, y) \<in> \<R> \<Longrightarrow> (x # xs, y # ys) \<in> trancl_list \<R>" +proof (induct rule: trancl_list.induct) + case (base xs ys) + then show ?case using less_Suc_eq_0_disj + by (intro trancl_list.base) auto +next + case (list_trancl xs ys i z) + from list_trancl(3) have *: "y # ys[i := z] = (y # ys)[Suc i := z]" by auto + show ?case using list_trancl unfolding * + by (intro trancl_list.list_trancl) auto +qed + +lemma trancl_list_append_tranclI [intro]: + "(x, y) \<in> \<R>\<^sup>+ \<Longrightarrow> (xs, ys) \<in> trancl_list \<R> \<Longrightarrow> (x # xs, y # ys) \<in> trancl_list \<R>" +proof (induct rule: trancl.induct) + case (trancl_into_trancl a b c) + then have "(a # xs, b # ys) \<in> trancl_list \<R>" by auto + from trancl_list.list_trancl[OF this, of 0 c] + show ?case using trancl_into_trancl(3) + by auto +qed auto + +lemma trancl_list_conv: + "(xs, ys) \<in> trancl_list \<R> \<longleftrightarrow> length xs = length ys \<and> (\<forall> i < length ys. (xs ! i, ys ! i) \<in> \<R>\<^sup>+)" (is "?Ls \<longleftrightarrow> ?Rs") +proof + assume "?Ls" then show ?Rs + proof (induct) + case (list_trancl xs ys i z) + then show ?case + by auto (metis nth_list_update trancl.trancl_into_trancl) + qed auto +next + assume ?Rs then show ?Ls + proof (induct ys arbitrary: xs) + case Nil + then show ?case by (cases xs) auto + next + case (Cons y ys) + from Cons(2) obtain x xs' where *: "xs = x # xs'" and + inv: "(x, y) \<in> \<R>\<^sup>+" + by (cases xs) auto + show ?case using Cons(1)[of "tl xs"] Cons(2) unfolding * + by (intro trancl_list_append_tranclI[OF inv]) force + qed +qed + +lemma trancl_list_induct [consumes 2, case_names base step]: + assumes "length ss = length ts" "\<forall> i < length ts. (ss ! i, ts ! i) \<in> \<R>\<^sup>+" + and "\<And>xs ys. length xs = length ys \<Longrightarrow> \<forall> i < length ys. (xs ! i, ys ! i) \<in> \<R> \<Longrightarrow> P xs ys" + and "\<And>xs ys i z. length xs = length ys \<Longrightarrow> \<forall> i < length ys. (xs ! i, ys ! i) \<in> \<R>\<^sup>+ \<Longrightarrow> P xs ys + \<Longrightarrow> i < length ys \<Longrightarrow> (ys ! i, z) \<in> \<R> \<Longrightarrow> P xs (ys[i := z])" + shows "P ss ts" using assms + by (intro trancl_list.induct[of ss ts \<R> P]) (auto simp: trancl_list_conv) + +lemma trancl_list_all_step_induct [consumes 2, case_names base step]: + assumes "length ss = length ts" "\<forall> i < length ts. (ss ! i, ts ! i) \<in> \<R>\<^sup>+" + and base: "\<And>xs ys. length xs = length ys \<Longrightarrow> \<forall> i < length ys. (xs ! i, ys ! i) \<in> \<R> \<Longrightarrow> P xs ys" + and steps: "\<And>xs ys zs. length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> + \<forall> i < length zs. (xs ! i, ys ! i) \<in> \<R>\<^sup>+ \<Longrightarrow> \<forall> i < length zs. (ys ! i, zs ! i) \<in> \<R> \<or> ys ! i = zs ! i \<Longrightarrow> + P xs ys \<Longrightarrow> P xs zs" + shows "P ss ts" using assms(1, 2) +proof (induct rule: trancl_list_induct) +case (step xs ys i z) + then show ?case + by (intro steps[of xs ys "ys[i := z]"]) + (auto simp: nth_list_update) +qed (auto simp: base) + +lemma all_ctxt_closed_trancl: + assumes "all_ctxt_closed \<F> \<R>" "\<R> \<subseteq> \<T>\<^sub>G \<F> \<times> \<T>\<^sub>G \<F>" + shows "all_ctxt_closed \<F> (\<R>\<^sup>+)" +proof - + {fix f ss ts assume sig: "(f, length ss) \<in> \<F>" and + steps: "length ss = length ts" "\<forall>i<length ts. (ss ! i, ts ! i) \<in> \<R>\<^sup>+" + have "(GFun f ss, GFun f ts) \<in> \<R>\<^sup>+" using steps sig + proof (induct rule: trancl_list_induct) + case (base ss ts) + then show ?case using all_ctxt_closedD[OF assms(1) base(3, 1, 2)] + by auto + next + case (step ss ts i t') + from step(2) have "j < length ts \<Longrightarrow> ts ! j \<in> \<T>\<^sub>G \<F>" for j using assms(2) + by (metis (no_types, lifting) SigmaD2 subset_iff trancl.simps) + from this[THEN all_ctxt_closed_refl_on[OF assms(1)]] + have "(GFun f ts, GFun f (ts[i := t'])) \<in> \<R>" using step(1, 4-) + by (intro all_ctxt_closedD[OF assms(1)]) (auto simp: nth_list_update) + then show ?case using step(3, 6) + by auto + qed} + then show ?thesis by (intro all_ctxt_closedI) +qed + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/Ground_Ctxt.thy b/thys/Regular_Tree_Relations/Util/Ground_Ctxt.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/Ground_Ctxt.thy @@ -0,0 +1,302 @@ +theory Ground_Ctxt + imports Ground_Terms +begin + +subsubsection \<open>Ground context\<close> + +datatype (gfuns_ctxt: 'f) gctxt = + GHole ("\<box>\<^sub>G") | GMore 'f "'f gterm list" "'f gctxt" "'f gterm list" +declare gctxt.map_comp[simp] + +fun gctxt_apply_term :: "'f gctxt \<Rightarrow> 'f gterm \<Rightarrow> 'f gterm" ("_\<langle>_\<rangle>\<^sub>G" [1000, 0] 1000) where + "\<box>\<^sub>G\<langle>s\<rangle>\<^sub>G = s" | + "(GMore f ss1 C ss2)\<langle>s\<rangle>\<^sub>G = GFun f (ss1 @ C\<langle>s\<rangle>\<^sub>G # ss2)" + +fun hole_gpos where + "hole_gpos \<box>\<^sub>G = []" | + "hole_gpos (GMore f ss1 C ss2) = length ss1 # hole_gpos C" + +lemma gctxt_eq [simp]: "(C\<langle>s\<rangle>\<^sub>G = C\<langle>t\<rangle>\<^sub>G) = (s = t)" + by (induct C) auto + +fun gctxt_compose :: "'f gctxt \<Rightarrow> 'f gctxt \<Rightarrow> 'f gctxt" (infixl "\<circ>\<^sub>G\<^sub>c" 75) where + "\<box>\<^sub>G \<circ>\<^sub>G\<^sub>c D = D" | + "(GMore f ss1 C ss2) \<circ>\<^sub>G\<^sub>c D = GMore f ss1 (C \<circ>\<^sub>G\<^sub>c D) ss2" + +fun gctxt_at_pos :: "'f gterm \<Rightarrow> pos \<Rightarrow> 'f gctxt" where + "gctxt_at_pos t [] = \<box>\<^sub>G" | + "gctxt_at_pos (GFun f ts) (i # ps) = + GMore f (take i ts) (gctxt_at_pos (ts ! i) ps) (drop (Suc i) ts)" + +interpretation ctxt_monoid_mult: monoid_mult "\<box>\<^sub>G" "(\<circ>\<^sub>G\<^sub>c)" +proof + fix C D E :: "'f gctxt" + show "C \<circ>\<^sub>G\<^sub>c D \<circ>\<^sub>G\<^sub>c E = C \<circ>\<^sub>G\<^sub>c (D \<circ>\<^sub>G\<^sub>c E)" by (induct C) simp_all + show "\<box>\<^sub>G \<circ>\<^sub>G\<^sub>c C = C" by simp + show "C \<circ>\<^sub>G\<^sub>c \<box>\<^sub>G = C" by (induct C) simp_all +qed + +instantiation gctxt :: (type) monoid_mult +begin + definition [simp]: "1 = \<box>\<^sub>G" + definition [simp]: "(*) = (\<circ>\<^sub>G\<^sub>c)" + instance by (intro_classes) (simp_all add: ac_simps) +end + +lemma ctxt_ctxt_compose [simp]: "(C \<circ>\<^sub>G\<^sub>c D)\<langle>t\<rangle>\<^sub>G = C\<langle>D\<langle>t\<rangle>\<^sub>G\<rangle>\<^sub>G" + by (induct C) simp_all + +lemmas ctxt_ctxt = ctxt_ctxt_compose [symmetric] + +fun ctxt_of_gctxt where + "ctxt_of_gctxt \<box>\<^sub>G = \<box>" +| "ctxt_of_gctxt (GMore f ss C ts) = More f (map term_of_gterm ss) (ctxt_of_gctxt C) (map term_of_gterm ts)" + +fun gctxt_of_ctxt where + "gctxt_of_ctxt \<box> = \<box>\<^sub>G" +| "gctxt_of_ctxt (More f ss C ts) = GMore f (map gterm_of_term ss) (gctxt_of_ctxt C) (map gterm_of_term ts)" + +lemma ground_ctxt_of_gctxt [simp]: + "ground_ctxt (ctxt_of_gctxt s)" + by (induct s) auto + +lemma ground_ctxt_of_gctxt' [simp]: + "ctxt_of_gctxt C = More f ss D ts \<Longrightarrow> ground_ctxt (More f ss D ts)" + by (induct C) auto + +lemma ctxt_of_gctxt_inv [simp]: + "gctxt_of_ctxt (ctxt_of_gctxt t) = t" + by (induct t) (auto intro!: nth_equalityI) + +lemma inj_ctxt_of_gctxt: "inj_on ctxt_of_gctxt X" + by (metis inj_on_def ctxt_of_gctxt_inv) + +lemma gctxt_of_ctxt_inv [simp]: + "ground_ctxt C \<Longrightarrow> ctxt_of_gctxt (gctxt_of_ctxt C) = C" + by (induct C) (auto 0 0 intro!: nth_equalityI) + +lemma map_ctxt_of_gctxt [simp]: + "map_ctxt f g (ctxt_of_gctxt C) = ctxt_of_gctxt (map_gctxt f C)" + by (induct C) auto + +lemma map_gctxt_of_ctxt [simp]: + "ground_ctxt C \<Longrightarrow> gctxt_of_ctxt (map_ctxt f g C) = map_gctxt f (gctxt_of_ctxt C)" + by (induct C) auto + +lemma map_gctxt_nempty [simp]: + "C \<noteq> \<box>\<^sub>G \<Longrightarrow> map_gctxt f C \<noteq> \<box>\<^sub>G" + by (cases C) auto + +lemma gctxt_set_funs_ctxt: + "gfuns_ctxt C = funs_ctxt (ctxt_of_gctxt C)" + using gterm_set_gterm_funs_terms + by (induct C) fastforce+ + +lemma ctxt_set_funs_gctxt: + assumes "ground_ctxt C" + shows "gfuns_ctxt (gctxt_of_ctxt C) = funs_ctxt C" + using assms term_set_gterm_funs_terms + by (induct C) fastforce+ + +lemma vars_ctxt_of_gctxt [simp]: + "vars_ctxt (ctxt_of_gctxt C) = {}" + by (induct C) auto + +lemma vars_ctxt_of_gctxt_subseteq [simp]: + "vars_ctxt (ctxt_of_gctxt C) \<subseteq> Q \<longleftrightarrow> True" + by auto + +lemma term_of_gterm_ctxt_apply_ground [simp]: + "term_of_gterm s = C\<langle>l\<rangle> \<Longrightarrow> ground_ctxt C" + "term_of_gterm s = C\<langle>l\<rangle> \<Longrightarrow> ground l" + by (metis ground_ctxt_apply ground_term_of_gterm)+ + +lemma term_of_gterm_ctxt_subst_apply_ground [simp]: + "term_of_gterm s = C\<langle>l \<cdot> \<sigma>\<rangle> \<Longrightarrow> x \<in> vars_term l \<Longrightarrow> ground (\<sigma> x)" + by (meson ground_substD term_of_gterm_ctxt_apply_ground(2)) + +lemma gctxt_compose_HoleE: + "C \<circ>\<^sub>G\<^sub>c D = \<box>\<^sub>G \<Longrightarrow> C = \<box>\<^sub>G" + "C \<circ>\<^sub>G\<^sub>c D = \<box>\<^sub>G \<Longrightarrow> D = \<box>\<^sub>G" + by (cases C; cases D, auto)+ + + +\<comment> \<open>Relations between ground contexts and contexts\<close> + +lemma nempty_ground_ctxt_gctxt [simp]: + "C \<noteq> \<box> \<Longrightarrow> ground_ctxt C \<Longrightarrow> gctxt_of_ctxt C \<noteq> \<box>\<^sub>G" + by (induct C) auto + +lemma ctxt_of_gctxt_apply [simp]: + "gterm_of_term (ctxt_of_gctxt C)\<langle>term_of_gterm t\<rangle> = C\<langle>t\<rangle>\<^sub>G" + by (induct C) (auto simp: comp_def map_idI) + +lemma ctxt_of_gctxt_apply_gterm: + "gterm_of_term (ctxt_of_gctxt C)\<langle>t\<rangle> = C\<langle>gterm_of_term t\<rangle>\<^sub>G" + by (induct C) (auto simp: comp_def map_idI) + +lemma ground_gctxt_of_ctxt_apply_gterm: + assumes "ground_ctxt C" + shows "term_of_gterm (gctxt_of_ctxt C)\<langle>t\<rangle>\<^sub>G = C\<langle>term_of_gterm t\<rangle>" using assms + by (induct C) (auto simp: comp_def map_idI) + +lemma ground_gctxt_of_ctxt_apply [simp]: + assumes "ground_ctxt C" "ground t" + shows "term_of_gterm (gctxt_of_ctxt C)\<langle>gterm_of_term t\<rangle>\<^sub>G = C\<langle>t\<rangle>" using assms + by (induct C) (auto simp: comp_def map_idI) + +lemma term_of_gterm_ctxt_apply [simp]: + "term_of_gterm s = C\<langle>l\<rangle> \<Longrightarrow> (gctxt_of_ctxt C)\<langle>gterm_of_term l\<rangle>\<^sub>G = s" + by (metis ctxt_of_gctxt_apply_gterm gctxt_of_ctxt_inv term_of_gterm_ctxt_apply_ground(1) term_of_gterm_inv) + +lemma gctxt_apply_inj_term: "inj (gctxt_apply_term C)" + by (auto simp: inj_on_def) + +lemma gctxt_apply_inj_on_term: "inj_on (gctxt_apply_term C) S" + by (auto simp: inj_on_def) + +lemma ctxt_of_pos_gterm [simp]: + "p \<in> gposs t \<Longrightarrow> ctxt_at_pos (term_of_gterm t) p = ctxt_of_gctxt (gctxt_at_pos t p)" + by (induct t arbitrary: p) (auto simp add: take_map drop_map) + +lemma gctxt_of_gpos_gterm_gsubt_at_to_gterm [simp]: + assumes "p \<in> gposs t" + shows "(gctxt_at_pos t p)\<langle>gsubt_at t p\<rangle>\<^sub>G = t" using assms + by (induct t arbitrary: p) (auto simp: comp_def min_def nth_append_Cons intro!: nth_equalityI) + +text \<open>The position of the hole in a context is uniquely determined\<close> +fun ghole_pos :: "'f gctxt \<Rightarrow> pos" where + "ghole_pos \<box>\<^sub>G = []" | + "ghole_pos (GMore f ss D ts) = length ss # ghole_pos D" + +lemma ghole_pos_gctxt_at_pos [simp]: + "p \<in> gposs t \<Longrightarrow> ghole_pos (gctxt_at_pos t p) = p" + by (induct t arbitrary: p) auto + +lemma ghole_pos_id_ctxt [simp]: + "C\<langle>s\<rangle>\<^sub>G = t \<Longrightarrow> gctxt_at_pos t (ghole_pos C) = C" + by (induct C arbitrary: t) auto + +lemma ghole_pos_in_apply: + "ghole_pos C = p \<Longrightarrow> p \<in> gposs C\<langle>u\<rangle>\<^sub>G" + by (induct C arbitrary: p) (auto simp: nth_append) + +lemma ground_hole_pos_to_ghole: + "ground_ctxt C \<Longrightarrow> ghole_pos (gctxt_of_ctxt C) = hole_pos C" + by (induct C) auto + +lemma gsubst_at_gctxt_at_eq_gtermD: + assumes "s = t" "p \<in> gposs t" + shows "gsubt_at s p = gsubt_at t p \<and> gctxt_at_pos s p = gctxt_at_pos t p" using assms + by auto + +lemma gsubst_at_gctxt_at_eq_gtermI: + assumes "p \<in> gposs s" "p \<in> gposs t" + and "gsubt_at s p = gsubt_at t p" + and "gctxt_at_pos s p = gctxt_at_pos t p" + shows "s = t" using assms + using gctxt_of_gpos_gterm_gsubt_at_to_gterm by force + + +lemma gsubt_at_gctxt_apply_ghole [simp]: + "gsubt_at C\<langle>u\<rangle>\<^sub>G (ghole_pos C) = u" + by (induct C) auto + +lemma gctxt_at_pos_gsubt_at_pos [simp]: + "p \<in> gposs t \<Longrightarrow> gsubt_at (gctxt_at_pos t p)\<langle>u\<rangle>\<^sub>G p = u" +proof (induct p arbitrary: t) + case (Cons i p) + then show ?case using id_take_nth_drop + by (cases t) (auto simp: nth_append) +qed auto + +lemma gfun_at_gctxt_at_pos_not_after: + assumes "p \<in> gposs t" "q \<in> gposs t" "\<not> (p \<le>\<^sub>p q)" + shows "gfun_at (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G q = gfun_at t q" using assms +proof (induct q arbitrary: p t) + case Nil + then show ?case + by (cases p; cases t) auto +next + case (Cons i q) + from Cons(4) obtain j r where [simp]: "p = j # r" by (cases p) auto + from Cons(4) have "j = i \<Longrightarrow> \<not> (r \<le>\<^sub>p q)" by auto + from this Cons(2-) Cons(1)[of r "gargs t ! j"] + have "j = i \<Longrightarrow> gfun_at (gctxt_at_pos (gargs t ! j) r)\<langle>v\<rangle>\<^sub>G q = gfun_at (gargs t ! j) q" + by (cases t) auto + then show ?case using Cons(2, 3) + by (cases t) (auto simp: nth_append_Cons min_def) +qed + +lemma gpos_less_eq_append [simp]: "p \<le>\<^sub>p (p @ q)" + unfolding position_less_eq_def + by blast + +lemma gposs_ConsE [elim]: + assumes "i # p \<in> gposs t" + obtains f ts where "t = GFun f ts" "ts \<noteq> []" "i < length ts" "p \<in> gposs (ts ! i)" using assms + by (cases t) force+ + +lemma gposs_gctxt_at_pos_not_after: + assumes "p \<in> gposs t" "q \<in> gposs t" "\<not> (p \<le>\<^sub>p q)" + shows "q \<in> gposs (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G \<longleftrightarrow> q \<in> gposs t" using assms +proof (induct q arbitrary: p t) + case Nil then show ?case + by (cases p; cases t) auto +next + case (Cons i q) + from Cons(4) obtain j r where [simp]: "p = j # r" by (cases p) auto + from Cons(4) have "j = i \<Longrightarrow> \<not> (r \<le>\<^sub>p q)" by auto + from this Cons(2-) Cons(1)[of r "gargs t ! j"] + have "j = i \<Longrightarrow> q \<in> gposs (gctxt_at_pos (gargs t ! j) r)\<langle>v\<rangle>\<^sub>G \<longleftrightarrow> q \<in> gposs (gargs t ! j)" + by (cases t) auto + then show ?case using Cons(2, 3) + by (cases t) (auto simp: nth_append_Cons min_def) +qed + +lemma gposs_gctxt_at_pos: + "p \<in> gposs t \<Longrightarrow> gposs (gctxt_at_pos t p)\<langle>v\<rangle>\<^sub>G = {q. q \<in> gposs t \<and> \<not> (p \<le>\<^sub>p q)} \<union> (@) p ` gposs v" +proof (induct p arbitrary: t) + case (Cons i p) + show ?case using Cons(1)[of "gargs t ! i"] Cons(2) gposs_gctxt_at_pos_not_after[OF Cons(2)] + by (auto simp: min_def nth_append_Cons split: if_splits elim!: gposs_ConsE) +qed auto + +lemma eq_gctxt_at_pos: + assumes "p \<in> gposs s" "p \<in> gposs t" + and "\<And> q. \<not> (p \<le>\<^sub>p q) \<Longrightarrow> q \<in> gposs s \<longleftrightarrow> q \<in> gposs t" + and "(\<And> q. q \<in> gposs s \<Longrightarrow> \<not> (p \<le>\<^sub>p q) \<Longrightarrow> gfun_at s q = gfun_at t q)" + shows "gctxt_at_pos s p = gctxt_at_pos t p" using assms(1, 2) + using arg_cong[where ?f = gctxt_of_ctxt, OF eq_ctxt_at_pos_by_poss, of _ "term_of_gterm s :: (_, unit) term" + "term_of_gterm t :: (_, unit) term" for s t, unfolded poss_gposs_conv fun_at_gfun_at_conv ctxt_of_pos_gterm, + OF assms] + by simp + +text \<open>Signature of a ground context\<close> + +fun funas_gctxt :: "'f gctxt \<Rightarrow> ('f \<times> nat) set" where + "funas_gctxt GHole = {}" | + "funas_gctxt (GMore f ss1 D ss2) = {(f, Suc (length (ss1 @ ss2)))} + \<union> funas_gctxt D \<union> \<Union>(set (map funas_gterm (ss1 @ ss2)))" + +lemma funas_gctxt_of_ctxt [simp]: + "ground_ctxt C \<Longrightarrow> funas_gctxt (gctxt_of_ctxt C) = funas_ctxt C" + by (induct C) (auto simp: funas_gterm_gterm_of_term) + +lemma funas_ctxt_of_gctxt_conv [simp]: + "funas_ctxt (ctxt_of_gctxt C) = funas_gctxt C" + by (induct C) (auto simp flip: funas_gterm_gterm_of_term) + +lemma inj_gctxt_of_ctxt_on_ground: + "inj_on gctxt_of_ctxt (Collect ground_ctxt)" + using gctxt_of_ctxt_inv by (fastforce simp: inj_on_def) + +lemma funas_gterm_ctxt_apply [simp]: + "funas_gterm C\<langle>s\<rangle>\<^sub>G = funas_gctxt C \<union> funas_gterm s" + by (induct C) auto + +lemma funas_gctxt_compose [simp]: + "funas_gctxt (C \<circ>\<^sub>G\<^sub>c D) = funas_gctxt C \<union> funas_gctxt D" + by (induct C arbitrary: D) auto + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/Ground_Terms.thy b/thys/Regular_Tree_Relations/Util/Ground_Terms.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/Ground_Terms.thy @@ -0,0 +1,496 @@ +subsection \<open>Ground constructions\<close> + +theory Ground_Terms + imports Basic_Utils +begin + +subsubsection \<open>Ground terms\<close> + +text \<open>This type serves two purposes. First of all, the encoding definitions and proofs are not +littered by cases for variables. Secondly, we can consider tree domains (usually sets of positions), +which become a special case of ground terms. This enables the construction of a term from a +tree domain and a function from positions to symbols.\<close> + +datatype 'f gterm = + GFun (groot_sym: 'f) (gargs: "'f gterm list") + +lemma gterm_idx_induct[case_names GFun]: + assumes "\<And> f ts. (\<And> i. i < length ts \<Longrightarrow> P (ts ! i)) \<Longrightarrow> P (GFun f ts)" + shows "P t" using assms + by (induct t) auto + +fun term_of_gterm where + "term_of_gterm (GFun f ts) = Fun f (map term_of_gterm ts)" + +fun gterm_of_term where + "gterm_of_term (Fun f ts) = GFun f (map gterm_of_term ts)" + +fun groot where + "groot (GFun f ts) = (f, length ts)" + +lemma groot_sym_groot_conv: + "groot_sym t = fst (groot t)" + by (cases t) auto + +lemma groot_sym_gterm_of_term: + "ground t \<Longrightarrow> groot_sym (gterm_of_term t) = fst (the (root t))" + by (cases t) auto + +lemma length_args_length_gargs [simp]: + "length (args (term_of_gterm t)) = length (gargs t)" + by (cases t) auto + +lemma ground_term_of_gterm [simp]: + "ground (term_of_gterm s)" + by (induct s) auto + +lemma ground_term_of_gterm' [simp]: + "term_of_gterm s = Fun f ss \<Longrightarrow> ground (Fun f ss)" + by (induct s) auto + +lemma term_of_gterm_inv [simp]: + "gterm_of_term (term_of_gterm t) = t" + by (induct t) (auto intro!: nth_equalityI) + +lemma inj_term_of_gterm: + "inj_on term_of_gterm X" + by (metis inj_on_def term_of_gterm_inv) + +lemma gterm_of_term_inv [simp]: + "ground t \<Longrightarrow> term_of_gterm (gterm_of_term t) = t" + by (induct t) (auto 0 0 intro!: nth_equalityI) + +lemma ground_term_to_gtermD: + "ground t \<Longrightarrow> \<exists>t'. t = term_of_gterm t'" + by (metis gterm_of_term_inv) + +lemma map_term_of_gterm [simp]: + "map_term f g (term_of_gterm t) = term_of_gterm (map_gterm f t)" + by (induct t) auto + +lemma map_gterm_of_term [simp]: + "ground t \<Longrightarrow> gterm_of_term (map_term f g t) = map_gterm f (gterm_of_term t)" + by (induct t) auto + +lemma gterm_set_gterm_funs_terms: + "set_gterm t = funs_term (term_of_gterm t)" + by (induct t) auto + +lemma term_set_gterm_funs_terms: + assumes "ground t" + shows "set_gterm (gterm_of_term t) = funs_term t" + using assms by (induct t) auto + +lemma vars_term_of_gterm [simp]: + "vars_term (term_of_gterm t) = {}" + by (induct t) auto + +lemma vars_term_of_gterm_subseteq [simp]: + "vars_term (term_of_gterm t) \<subseteq> Q \<longleftrightarrow> True" + by auto + +context + notes conj_cong [fundef_cong] +begin +fun gposs :: "'f gterm \<Rightarrow> pos set" where + "gposs (GFun f ss) = {[]} \<union> {i # p | i p. i < length ss \<and> p \<in> gposs (ss ! i)}" +end + +lemma gposs_Nil [simp]: "[] \<in> gposs s" + by (cases s) auto + +lemma gposs_map_gterm [simp]: + "gposs (map_gterm f s) = gposs s" + by (induct s) auto + +lemma poss_gposs_conv: + "poss (term_of_gterm t) = gposs t" + by (induct t) auto + +lemma poss_gposs_mem_conv: + "p \<in> poss (term_of_gterm t) \<longleftrightarrow> p \<in> gposs t" + using poss_gposs_conv by auto + +lemma gposs_to_poss: + "p \<in> gposs t \<Longrightarrow> p \<in> poss (term_of_gterm t)" + by (simp add: poss_gposs_mem_conv) + +fun gfun_at :: "'f gterm \<Rightarrow> pos \<Rightarrow> 'f option" where + "gfun_at (GFun f ts) [] = Some f" +| "gfun_at (GFun f ts) (i # p) = (if i < length ts then gfun_at (ts ! i) p else None)" + +abbreviation "exInl \<equiv> case_sum (\<lambda> x. x) (\<lambda> _.undefined)" + +lemma gfun_at_gterm_of_term [simp]: + "ground s \<Longrightarrow> map_option exInl (fun_at s p) = gfun_at (gterm_of_term s) p" +proof (induct p arbitrary: s) + case Nil then show ?case + by (cases s) auto +next + case (Cons i p) then show ?case + by (cases s) auto +qed + +lemmas gfun_at_gterm_of_term' [simp] = gfun_at_gterm_of_term[OF ground_term_of_gterm, unfolded term_of_gterm_inv] + +lemma gfun_at_None_ngposs_iff: "gfun_at s p = None \<longleftrightarrow> p \<notin> gposs s" + by (induct rule: gfun_at.induct) auto + + +lemma gfun_at_map_gterm [simp]: + "gfun_at (map_gterm f t) p = map_option f (gfun_at t p)" + by (induct t arbitrary: p; case_tac p) (auto simp: comp_def) + +lemma set_gterm_gposs_conv: + "set_gterm t = {the (gfun_at t p) | p. p \<in> gposs t}" +proof (induct t) + case (GFun f ts) + note [simp] = gfun_at_gterm_of_term[OF ground_term_of_gterm, unfolded term_of_gterm_inv] + have [simp]: "{the (map_option exInl (fun_at (Fun f (map term_of_gterm ts :: (_, unit) term list)) p)) |p. + \<exists>i pa. p = i # pa \<and> i < length ts \<and> pa \<in> gposs (ts ! i)} = + (\<Union>x\<in>{ts ! i |i. i < length ts}. {the (gfun_at x p) |p. p \<in> gposs x})" (* eww *) + unfolding UNION_eq + proof ((intro set_eqI iffI; elim CollectE exE bexE conjE), goal_cases lr rl) + case (lr x p i pa) then show ?case + by (intro CollectI[of _ x] bexI[of _ "ts ! i"] exI[of _ pa]) (auto intro!: arg_cong[where ?f = the]) + next + case (rl x xa i p) then show ?case + by (intro CollectI[of _ x] exI[of _ "i # p"]) auto + qed + have [simp]: "(\<Union>x\<in>{ts ! i |i. i < length ts}. {the (gfun_at x p) |p. p \<in> gposs x}) = + {the (gfun_at (GFun f ts) p) |p. \<exists>i pa. p = i # pa \<and> i < length ts \<and> pa \<in> gposs (ts ! i)}" + by auto (metis gfun_at.simps(2))+ + show ?case + by (simp add: GFun(1) set_conv_nth conj_disj_distribL ex_disj_distrib Collect_disj_eq) +qed + +text \<open>A @{type gterm} version of lemma @{verbatim eq_term_by_poss_fun_at}.\<close> + +lemma fun_at_gfun_at_conv: + "fun_at (term_of_gterm s) p = fun_at (term_of_gterm t) p \<longleftrightarrow> gfun_at s p = gfun_at t p" +proof (induct p arbitrary: s t) + case Nil then show ?case + by (cases s; cases t) auto +next + case (Cons i p) + obtain f h ss ts where [simp]: "s = GFun f ss" "t = GFun h ts" by (cases s; cases t) auto + have [simp]: "None = fun_at (term_of_gterm (ts ! i)) p \<longleftrightarrow> p \<notin> gposs (ts ! i)" + using fun_at_None_nposs_iff by (metis poss_gposs_mem_conv) + have [simp]:"None = gfun_at (ts ! i) p \<longleftrightarrow> p \<notin> gposs (ts ! i)" + using gfun_at_None_ngposs_iff by force + show ?case using Cons[of "gargs s ! i" "gargs t ! i"] + by (auto simp: poss_gposs_conv gfun_at_None_ngposs_iff fun_at_None_nposs_iff + intro!: iffD2[OF gfun_at_None_ngposs_iff] iffD2[OF fun_at_None_nposs_iff]) +qed + +lemmas eq_gterm_by_gposs_gfun_at = arg_cong[where f = gterm_of_term, + OF eq_term_by_poss_fun_at[of "term_of_gterm s :: (_, unit) term" "term_of_gterm t :: (_, unit) term" for s t], + unfolded term_of_gterm_inv poss_gposs_conv fun_at_gfun_at_conv] + +fun gsubt_at :: "'f gterm \<Rightarrow> pos \<Rightarrow> 'f gterm" where + "gsubt_at s [] = s" | + "gsubt_at (GFun f ss) (i # p) = gsubt_at (ss ! i) p" + +lemma gsubt_at_to_subt_at: + assumes "p \<in> gposs s" + shows "gterm_of_term (term_of_gterm s |_ p) = gsubt_at s p" + using assms by (induct arbitrary: p) (auto simp add: map_idI) + +lemma term_of_gterm_gsubt: + assumes "p \<in> gposs s" + shows "(term_of_gterm s) |_ p = term_of_gterm (gsubt_at s p)" + using assms by (induct arbitrary: p) auto + +lemma gsubt_at_gposs [simp]: + assumes "p \<in> gposs s" + shows "gposs (gsubt_at s p) = {x | x. p @ x \<in> gposs s}" + using assms by (induct s arbitrary: p) auto + +lemma gfun_at_gsub_at [simp]: + assumes "p \<in> gposs s" and "p @ q \<in> gposs s" + shows "gfun_at (gsubt_at s p) q = gfun_at s (p @ q)" + using assms by (induct s arbitrary: p q) auto + +lemma gposs_gsubst_at_subst_at_eq [simp]: + assumes "p \<in> gposs s" + shows "gposs (gsubt_at s p) = poss (term_of_gterm s |_ p)" using assms +proof (induct s arbitrary: p) + case (GFun f ts) + show ?case using GFun(1)[OF nth_mem] GFun(2-) + by (auto simp: poss_gposs_mem_conv) blast+ +qed + +lemma gpos_append_gposs: + assumes "p \<in> gposs t" and "q \<in> gposs (gsubt_at t p)" + shows "p @ q \<in> gposs t" + using assms by auto + + +text \<open>Replace terms at position\<close> + +fun replace_gterm_at ("_[_ \<leftarrow> _]\<^sub>G" [1000, 0, 0] 1000) where + "replace_gterm_at s [] t = t" +| "replace_gterm_at (GFun f ts) (i # ps) t = + (if i < length ts then GFun f (ts[i:=(replace_gterm_at (ts ! i) ps t)]) else GFun f ts)" + +lemma replace_gterm_at_not_poss [simp]: + "p \<notin> gposs s \<Longrightarrow> s[p \<leftarrow> t]\<^sub>G = s" +proof (induct s arbitrary: p) + case (GFun f ts) show ?case using GFun(1)[OF nth_mem] GFun(2) + by (cases p) (auto simp: min_def intro!: nth_equalityI) +qed + +lemma parallel_replace_gterm_commute [ac_simps]: + "p \<bottom> q \<Longrightarrow> s[p \<leftarrow> t]\<^sub>G[q \<leftarrow> u]\<^sub>G = s[q \<leftarrow> u]\<^sub>G[p \<leftarrow> t]\<^sub>G" +proof (induct s arbitrary: p q) + case (GFun f ts) + from GFun(2) have "p \<noteq> []" "q \<noteq> []" by auto + then obtain i j ps qs where [simp]: "p = i # ps" "q = j # qs" + by (cases p; cases q) auto + have "i \<noteq> j \<Longrightarrow> (GFun f ts)[p \<leftarrow> t]\<^sub>G[q \<leftarrow> u]\<^sub>G = (GFun f ts)[q \<leftarrow> u]\<^sub>G[p \<leftarrow> t]\<^sub>G" + by (auto simp: list_update_swap) + then show ?case using GFun(1)[OF nth_mem, of j ps qs] GFun(2) + by (cases "i = j") (auto simp: par_Cons_iff) +qed + +lemma replace_gterm_at_above [simp]: + "p \<le>\<^sub>p q \<Longrightarrow> s[q \<leftarrow> t]\<^sub>G[p \<leftarrow> u]\<^sub>G = s[p \<leftarrow> u]\<^sub>G" +proof (induct p arbitrary: s q) + case (Cons i p) + show ?case using Cons(1)[of "tl q" "gargs s ! i"] Cons(2) + by (cases q; cases s) auto +qed auto + +lemma replace_gterm_at_below [simp]: + "p <\<^sub>p q \<Longrightarrow> s[p \<leftarrow> t]\<^sub>G[q \<leftarrow> u]\<^sub>G = s[p \<leftarrow> t[q -\<^sub>p p \<leftarrow> u]\<^sub>G]\<^sub>G" +proof (induct p arbitrary: s q) + case (Cons i p) + show ?case using Cons(1)[of "tl q" "gargs s ! i"] Cons(2) + by (cases q; cases s) auto +qed auto + +lemma groot_sym_replace_gterm [simp]: + "p \<noteq> [] \<Longrightarrow> groot_sym s[p \<leftarrow> t]\<^sub>G = groot_sym s" + by (cases s; cases p) auto + +lemma replace_gterm_gsubt_at_id [simp]: "s[p \<leftarrow> gsubt_at s p]\<^sub>G = s" +proof (induct p arbitrary: s) + case (Cons i p) then show ?case + by (cases s) auto +qed auto + +lemma replace_gterm_conv: + "p \<in> gposs s \<Longrightarrow> (term_of_gterm s)[p \<leftarrow> (term_of_gterm t)] = term_of_gterm (s[p \<leftarrow> t]\<^sub>G)" +proof (induct p arbitrary: s) + case (Cons i p) then show ?case + by (cases s) (auto simp: nth_list_update intro: nth_equalityI) +qed auto + +subsubsection \<open>Tree domains\<close> + +type_synonym gdomain = "unit gterm" + +abbreviation gdomain where + "gdomain \<equiv> map_gterm (\<lambda>_. ())" + +lemma gdomain_id: + "gdomain t = t" +proof - + have [simp]: "(\<lambda>_. ()) = id" by auto + then show ?thesis by (simp add: gterm.map_id) +qed + +lemma gdomain_gsubt [simp]: + assumes "p \<in> gposs t" + shows "gdomain (gsubt_at t p) = gsubt_at (gdomain t) p" + using assms by (induct t arbitrary: p) auto + +text \<open>Union of tree domains\<close> + +fun gunion :: "gdomain \<Rightarrow> gdomain \<Rightarrow> gdomain" where + "gunion (GFun f ss) (GFun g ts) = GFun () (map (\<lambda>i. + if i < length ss then if i < length ts then gunion (ss ! i) (ts ! i) + else ss ! i else ts ! i) [0..<max (length ss) (length ts)])" + +lemma gposs_gunion [simp]: + "gposs (gunion s t) = gposs s \<union> gposs t" + by (induct s t rule: gunion.induct) (auto simp: less_max_iff_disj split: if_splits) + +lemma gunion_unit [simp]: + "gunion s (GFun () []) = s" "gunion (GFun () []) s = s" + by (cases s, (auto intro!: nth_equalityI)[1])+ + +lemma gunion_gsubt_at_nt_poss1: + assumes "p \<in> gposs s" and "p \<notin> gposs t" + shows "gsubt_at (gunion s t) p = gsubt_at s p" + using assms by (induct s arbitrary: p t) (case_tac p; case_tac t, auto) + + +lemma gunion_gsubt_at_nt_poss2: + assumes "p \<in> gposs t" and "p \<notin> gposs s" + shows "gsubt_at (gunion s t) p = gsubt_at t p" + using assms by (induct t arbitrary: p s) (case_tac p; case_tac s, auto) + +lemma gunion_gsubt_at_poss: + assumes "p \<in> gposs s" and "p \<in> gposs t" + shows "gunion (gsubt_at s p) (gsubt_at t p) = gsubt_at (gunion s t) p" + using assms +proof (induct p arbitrary: s t) + case (Cons a p) + then show ?case by (cases s; cases t) auto +qed auto + +lemma gfun_at_domain: + shows "gfun_at t p = (if p \<in> gposs t then Some () else None)" +proof (induct t arbitrary: p) + case (GFun f ts) then show ?case + by (cases p) auto +qed + +lemma gunion_assoc [ac_simps]: + "gunion s (gunion t u) = gunion (gunion s t) u" + by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gfun_at_domain poss_gposs_mem_conv) + +lemma gunion_commute [ac_simps]: + "gunion s t = gunion t s" + by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gfun_at_domain poss_gposs_mem_conv) + +lemma gunion_idemp [simp]: + "gunion s s = s" + by (intro eq_gterm_by_gposs_gfun_at) (auto simp: gfun_at_domain poss_gposs_mem_conv) + +definition gunions :: "gdomain list \<Rightarrow> gdomain" where + "gunions ts = foldr gunion ts (GFun () [])" + +lemma gunions_append: + "gunions (ss @ ts) = gunion (gunions ss) (gunions ts)" + by (induct ss) (auto simp: gunions_def gunion_assoc) + +lemma gposs_gunions [simp]: + "gposs (gunions ts) = {[]} \<union> \<Union>{gposs t |t. t \<in> set ts}" + by (induct ts) (auto simp: gunions_def) + + +text \<open>Given a tree domain and a function from positions to symbols, we can construct a term.\<close> +context + notes conj_cong [fundef_cong] +begin +fun glabel :: "(pos \<Rightarrow> 'f) \<Rightarrow> gdomain \<Rightarrow> 'f gterm" where + "glabel h (GFun f ts) = GFun (h []) (map (\<lambda>i. glabel (h \<circ> (#) i) (ts ! i)) [0..<length ts])" +end + +lemma map_gterm_glabel: + "map_gterm f (glabel h t) = glabel (f \<circ> h) t" + by (induct t arbitrary: h) (auto simp: comp_def) + +lemma gfun_at_glabel [simp]: + "gfun_at (glabel f t) p = (if p \<in> gposs t then Some (f p) else None)" + by (induct t arbitrary: f p, case_tac p) (auto simp: comp_def) + +lemma gposs_glabel [simp]: + "gposs (glabel f t) = gposs t" + by (induct t arbitrary: f) auto + +lemma glabel_map_gterm_conv: + "glabel (f \<circ> gfun_at t) (gdomain t) = map_gterm (f \<circ> Some) t" + by (induct t) (auto simp: comp_def intro!: nth_equalityI) + +lemma gfun_at_nongposs [simp]: + "p \<notin> gposs t \<Longrightarrow> gfun_at t p = None" + using gfun_at_glabel[of "the \<circ> gfun_at t" "gdomain t" p, unfolded glabel_map_gterm_conv] + by (simp add: comp_def option.map_ident) + +lemma gfun_at_poss: + "p \<in> gposs t \<Longrightarrow> \<exists>f. gfun_at t p = Some f" + using gfun_at_glabel[of "the \<circ> gfun_at t" "gdomain t" p, unfolded glabel_map_gterm_conv] + by (auto simp: comp_def) + +lemma gfun_at_possE: + assumes "p \<in> gposs t" + obtains f where "gfun_at t p = Some f" + using assms gfun_at_poss by blast + +lemma gfun_at_poss_gpossD: + "gfun_at t p = Some f \<Longrightarrow> p \<in> gposs t" + by (metis gfun_at_nongposs option.distinct(1)) + +text \<open>function symbols of a ground term\<close> + +primrec funas_gterm :: "'f gterm \<Rightarrow> ('f \<times> nat) set" where + "funas_gterm (GFun f ts) = {(f, length ts)} \<union> \<Union>(set (map funas_gterm ts))" + +lemma funas_gterm_gterm_of_term: + "ground t \<Longrightarrow> funas_gterm (gterm_of_term t) = funas_term t" + by (induct t) (auto simp: funas_gterm_def) + +lemma funas_term_of_gterm_conv: + "funas_term (term_of_gterm t) = funas_gterm t" + by (induct t) (auto simp: funas_gterm_def) + +lemma funas_gterm_map_gterm: + assumes "funas_gterm t \<subseteq> \<F>" + shows "funas_gterm (map_gterm f t) \<subseteq> (\<lambda> (h, n). (f h, n)) ` \<F>" + using assms by (induct t) (auto simp: funas_gterm_def) + +lemma gterm_of_term_inj: + assumes "\<And> t. t \<in> S \<Longrightarrow> ground t" + shows "inj_on gterm_of_term S" + using assms gterm_of_term_inv by (fastforce simp: inj_on_def) + +lemma funas_gterm_gsubt_at_subseteq: + assumes "p \<in> gposs s" + shows "funas_gterm (gsubt_at s p) \<subseteq> funas_gterm s" using assms + apply (induct s arbitrary: p) apply auto + using nth_mem by blast+ + +lemma finite_funas_gterm: "finite (funas_gterm t)" + by (induct t) auto + +text \<open>ground term set\<close> + +abbreviation gterms where + "gterms \<F> \<equiv> {s. funas_gterm s \<subseteq> \<F>}" + +lemma gterms_mono: + "\<G> \<subseteq> \<F> \<Longrightarrow> gterms \<G> \<subseteq> gterms \<F>" + by auto + +inductive_set \<T>\<^sub>G for \<F> where + const [simp]: "(a, 0) \<in> \<F> \<Longrightarrow> GFun a [] \<in> \<T>\<^sub>G \<F>" +| ind [intro]: "(f, n) \<in> \<F> \<Longrightarrow> length ss = n \<Longrightarrow> (\<And> i. i < length ss \<Longrightarrow> ss ! i \<in> \<T>\<^sub>G \<F>) \<Longrightarrow> GFun f ss \<in> \<T>\<^sub>G \<F>" + +lemma \<T>\<^sub>G_sound: + "s \<in> \<T>\<^sub>G \<F> \<Longrightarrow> funas_gterm s \<subseteq> \<F>" +proof (induct) + case (GFun f ts) + show ?case using GFun(1)[OF nth_mem] GFun(2) + by (fastforce simp: in_set_conv_nth elim!: \<T>\<^sub>G.cases intro: nth_mem) +qed + +lemma \<T>\<^sub>G_complete: + "funas_gterm s \<subseteq> \<F> \<Longrightarrow> s \<in> \<T>\<^sub>G \<F> " + by (induct s) (auto simp: SUP_le_iff) + +lemma \<T>\<^sub>G_funas_gterm_conv: + "s \<in> \<T>\<^sub>G \<F> \<longleftrightarrow> funas_gterm s \<subseteq> \<F>" + using \<T>\<^sub>G_sound \<T>\<^sub>G_complete by auto + +lemma \<T>\<^sub>G_equivalent_def: + "\<T>\<^sub>G \<F> = gterms \<F>" + using \<T>\<^sub>G_funas_gterm_conv by auto + +lemma \<T>\<^sub>G_intersection [simp]: + "s \<in> \<T>\<^sub>G \<F> \<Longrightarrow> s \<in> \<T>\<^sub>G \<G> \<Longrightarrow> s \<in> \<T>\<^sub>G (\<F> \<inter> \<G>)" + by (auto simp: \<T>\<^sub>G_funas_gterm_conv \<T>\<^sub>G_equivalent_def) + +lemma \<T>\<^sub>G_mono: + "\<G> \<subseteq> \<F> \<Longrightarrow> \<T>\<^sub>G \<G> \<subseteq> \<T>\<^sub>G \<F>" + using gterms_mono by (simp add: \<T>\<^sub>G_equivalent_def) + +lemma \<T>\<^sub>G_UNIV [simp]: "s \<in> \<T>\<^sub>G UNIV" + by (induct) auto + +definition funas_grel where + "funas_grel \<R> = \<Union> ((\<lambda> (s, t). funas_gterm s \<union> funas_gterm t) ` \<R>)" + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/Util/Term_Context.thy b/thys/Regular_Tree_Relations/Util/Term_Context.thy new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/Util/Term_Context.thy @@ -0,0 +1,526 @@ +section \<open>Preliminaries\<close> + +theory Term_Context + imports First_Order_Terms.Term + Knuth_Bendix_Order.Subterm_and_Context + Polynomial_Factorization.Missing_List +begin + +subsection \<open>Additional functionality on @{type term} and @{type ctxt}\<close> +subsubsection \<open>Positions\<close> + +type_synonym pos = "nat list" +context + notes conj_cong [fundef_cong] +begin + +fun poss :: "('f, 'v) term \<Rightarrow> pos set" where + "poss (Var x) = {[]}" +| "poss (Fun f ss) = {[]} \<union> {i # p | i p. i < length ss \<and> p \<in> poss (ss ! i)}" +end + +fun hole_pos where + "hole_pos \<box> = []" +| "hole_pos (More f ss D ts) = length ss # hole_pos D" + +definition position_less_eq (infixl "\<le>\<^sub>p" 67) where + "p \<le>\<^sub>p q \<longleftrightarrow> (\<exists> r. p @ r = q)" + +abbreviation position_less (infixl "<\<^sub>p" 67) where + "p <\<^sub>p q \<equiv> p \<noteq> q \<and> p \<le>\<^sub>p q" + +definition position_par (infixl "\<bottom>" 67) where + "p \<bottom> q \<longleftrightarrow> \<not> (p \<le>\<^sub>p q) \<and> \<not> (q \<le>\<^sub>p p)" + +fun remove_prefix where + "remove_prefix (x # xs) (y # ys) = (if x = y then remove_prefix xs ys else None)" +| "remove_prefix [] ys = Some ys" +| "remove_prefix xs [] = None" + +definition pos_diff (infixl "-\<^sub>p" 67) where + "p -\<^sub>p q = the (remove_prefix q p)" + +fun subt_at :: "('f, 'v) term \<Rightarrow> pos \<Rightarrow> ('f, 'v) term" (infixl "|'_" 67) where + "s |_ [] = s" +| "Fun f ss |_ (i # p) = (ss ! i) |_ p" +| "Var x |_ _ = undefined" + +fun ctxt_at_pos where + "ctxt_at_pos s [] = \<box>" +| "ctxt_at_pos (Fun f ss) (i # p) = More f (take i ss) (ctxt_at_pos (ss ! i) p) (drop (Suc i) ss)" +| "ctxt_at_pos (Var x) _ = undefined" + +fun replace_term_at ("_[_ \<leftarrow> _]" [1000, 0, 0] 1000) where + "replace_term_at s [] t = t" +| "replace_term_at (Var x) ps t = (Var x)" +| "replace_term_at (Fun f ts) (i # ps) t = + (if i < length ts then Fun f (ts[i:=(replace_term_at (ts ! i) ps t)]) else Fun f ts)" + +fun fun_at :: "('f, 'v) term \<Rightarrow> pos \<Rightarrow> ('f + 'v) option" where + "fun_at (Var x) [] = Some (Inr x)" +| "fun_at (Fun f ts) [] = Some (Inl f)" +| "fun_at (Fun f ts) (i # p) = (if i < length ts then fun_at (ts ! i) p else None)" +| "fun_at _ _ = None" + +subsubsection \<open>Computing the signature\<close> + +fun funas_term where + "funas_term (Var x) = {}" +| "funas_term (Fun f ts) = insert (f, length ts) (\<Union> (set (map funas_term ts)))" + +fun funas_ctxt where + "funas_ctxt \<box> = {}" +| "funas_ctxt (More f ss C ts) = (\<Union> (set (map funas_term ss))) \<union> + insert (f, Suc (length ss + length ts)) (funas_ctxt C) \<union> (\<Union> (set (map funas_term ts)))" + +subsubsection \<open>Groundness\<close> + +fun ground where + "ground (Var x) = False" +| "ground (Fun f ts) = (\<forall> t \<in> set ts. ground t)" + +fun ground_ctxt where + "ground_ctxt \<box> \<longleftrightarrow> True" +| "ground_ctxt (More f ss C ts) \<longleftrightarrow> (\<forall> t \<in> set ss. ground t) \<and> ground_ctxt C \<and> (\<forall> t \<in> set ts. ground t)" + +subsubsection \<open>Depth\<close> +fun depth where + "depth (Var x) = 0" +| "depth (Fun f []) = 0" +| "depth (Fun f ts) = Suc (Max (depth ` set ts))" + +subsubsection \<open>Type conversion\<close> + +text \<open>We require a function which adapts the type of variables of a term, + so that states of the automaton and variables in the term language can be + chosen independently.\<close> + +abbreviation "map_vars_term f \<equiv> map_term (\<lambda> x. x) f" +abbreviation "map_funs_term f \<equiv> map_term f (\<lambda> x. x)" +abbreviation "map_both f \<equiv> map_prod f f" + +definition adapt_vars :: "('f, 'q) term \<Rightarrow> ('f,'v)term" where + [code del]: "adapt_vars \<equiv> map_vars_term (\<lambda>_. undefined)" + +abbreviation "map_vars_ctxt f \<equiv> map_ctxt (\<lambda>x. x) f" +definition adapt_vars_ctxt :: "('f,'q)ctxt \<Rightarrow> ('f,'v)ctxt" where + [code del]: "adapt_vars_ctxt = map_vars_ctxt (\<lambda>_. undefined)" + + +subsection \<open>Properties of @{type pos}\<close> + +lemma position_less_eq_induct [consumes 1]: + assumes "p \<le>\<^sub>p q" and "\<And> p. P p p" + and "\<And> p q r. p \<le>\<^sub>p q \<Longrightarrow> P p q \<Longrightarrow> P p (q @ r)" + shows "P p q" using assms +proof (induct p arbitrary: q) + case Nil then show ?case + by (metis append_Nil position_less_eq_def) +next + case (Cons a p) + then show ?case + by (metis append_Nil2 position_less_eq_def) +qed + +text \<open>We show the correspondence between the function @{const remove_prefix} and +the order on positions @{const position_less_eq}. Moreover how it can be used to +compute the difference of positions.\<close> + +lemma remove_prefix_Nil [simp]: + "remove_prefix xs xs = Some []" + by (induct xs) auto + +lemma remove_prefix_Some: + assumes "remove_prefix xs ys = Some zs" + shows "ys = xs @ zs" using assms +proof (induct xs arbitrary: ys) + case (Cons x xs) + show ?case using Cons(1)[of "tl ys"] Cons(2) + by (cases ys) (auto split: if_splits) +qed auto + +lemma remove_prefix_append: + "remove_prefix xs (xs @ ys) = Some ys" + by (induct xs) auto + +lemma remove_prefix_iff: + "remove_prefix xs ys = Some zs \<longleftrightarrow> ys = xs @ zs" + using remove_prefix_Some remove_prefix_append + by blast + +lemma position_less_eq_remove_prefix: + "p \<le>\<^sub>p q \<Longrightarrow> remove_prefix p q \<noteq> None" + by (induct rule: position_less_eq_induct) (auto simp: remove_prefix_iff) + +text \<open>Simplification rules on @{const position_less_eq}, @{const pos_diff}, + and @{const position_par}.\<close> + +lemma position_less_refl [simp]: "p \<le>\<^sub>p p" + by (auto simp: position_less_eq_def) + +lemma position_less_eq_Cons [simp]: + "(i # ps) \<le>\<^sub>p (j # qs) \<longleftrightarrow> i = j \<and> ps \<le>\<^sub>p qs" + by (auto simp: position_less_eq_def) + +lemma position_less_Nil_is_bot [simp]: "[] \<le>\<^sub>p p" + by (auto simp: position_less_eq_def) + +lemma position_less_Nil_is_bot2 [simp]: "p \<le>\<^sub>p [] \<longleftrightarrow> p = []" + by (auto simp: position_less_eq_def) + +lemma position_diff_Nil [simp]: "q -\<^sub>p [] = q" + by (auto simp: pos_diff_def) + +lemma position_diff_Cons [simp]: + "(i # ps) -\<^sub>p (i # qs) = ps -\<^sub>p qs" + by (auto simp: pos_diff_def) + +lemma Nil_not_par [simp]: + "[] \<bottom> p \<longleftrightarrow> False" + "p \<bottom> [] \<longleftrightarrow> False" + by (auto simp: position_par_def) + +lemma par_not_refl [simp]: "p \<bottom> p \<longleftrightarrow> False" + by (auto simp: position_par_def) + +lemma par_Cons_iff: + "(i # ps) \<bottom> (j # qs) \<longleftrightarrow> (i \<noteq> j \<or> ps \<bottom> qs)" + by (auto simp: position_par_def) + + +text \<open>Simplification rules on @{const poss}.\<close> + +lemma Nil_in_poss [simp]: "[] \<in> poss t" + by (cases t) auto + +lemma poss_Cons [simp]: + "i # p \<in> poss t \<Longrightarrow> [i] \<in> poss t" + by (cases t) auto + +lemma poss_Cons_poss: + "i # q \<in> poss t \<longleftrightarrow> i < length (args t) \<and> q \<in> poss (args t ! i)" + by (cases t) auto + +lemma poss_append_poss: + "p @ q \<in> poss t \<longleftrightarrow> p \<in> poss t \<and> q \<in> poss (t |_ p)" +proof (induct p arbitrary: t) + case (Cons i p) + from Cons[of "args t ! i"] show ?case + by (cases t) auto +qed auto + + +text \<open>Simplification rules on @{const hole_pos}\<close> + +lemma hole_pos_map_vars [simp]: + "hole_pos (map_vars_ctxt f C) = hole_pos C" + by (induct C) auto + +lemma hole_pos_in_ctxt_apply [simp]: "hole_pos C \<in> poss C\<langle>u\<rangle>" + by (induct C) auto + +subsection \<open>Properties of @{const ground} and @{const ground_ctxt}\<close> + +lemma ground_vars_term_empty [simp]: + "ground t \<Longrightarrow> vars_term t = {}" + by (induct t) auto + +lemma ground_map_term [simp]: + "ground (map_term f h t) = ground t" + by (induct t) auto + +lemma ground_ctxt_apply [simp]: + "ground C\<langle>t\<rangle> \<longleftrightarrow> ground_ctxt C \<and> ground t" + by (induct C) auto + +lemma ground_ctxt_comp [intro]: + "ground_ctxt C \<Longrightarrow> ground_ctxt D \<Longrightarrow> ground_ctxt (C \<circ>\<^sub>c D)" + by (induct C) auto + +lemma ctxt_comp_n_pres_ground [intro]: + "ground_ctxt C \<Longrightarrow> ground_ctxt (C^n)" + by (induct n arbitrary: C) auto + +lemma subterm_eq_pres_ground: + assumes "ground s" and "s \<unrhd> t" + shows "ground t" using assms(2,1) + by (induct) auto + +lemma ground_substD: + "ground (l \<cdot> \<sigma>) \<Longrightarrow> x \<in> vars_term l \<Longrightarrow> ground (\<sigma> x)" + by (induct l) auto + +lemma ground_substI: + "(\<And> x. x \<in> vars_term s \<Longrightarrow> ground (\<sigma> x)) \<Longrightarrow> ground (s \<cdot> \<sigma>)" + by (induct s) auto + + +subsection \<open>Properties on signature induced by a term @{type term}/context @{type ctxt}\<close> + +lemma funas_ctxt_apply [simp]: + "funas_term C\<langle>t\<rangle> = funas_ctxt C \<union> funas_term t" + by (induct C) auto + +lemma funas_term_map [simp]: + "funas_term (map_term f h t) = (\<lambda> (g, n). (f g, n)) ` funas_term t" + by (induct t) auto + +lemma funas_term_subst: + "funas_term (l \<cdot> \<sigma>) = funas_term l \<union> (\<Union> (funas_term ` \<sigma> ` vars_term l))" + by (induct l) auto + +lemma funas_ctxt_comp [simp]: + "funas_ctxt (C \<circ>\<^sub>c D) = funas_ctxt C \<union> funas_ctxt D" + by (induct C) auto + +lemma ctxt_comp_n_funas [simp]: + "(f, v) \<in> funas_ctxt (C^n) \<Longrightarrow> (f, v) \<in> funas_ctxt C" + by (induct n arbitrary: C) auto + +lemma ctxt_comp_n_pres_funas [intro]: + "funas_ctxt C \<subseteq> \<F> \<Longrightarrow> funas_ctxt (C^n) \<subseteq> \<F>" + by (induct n arbitrary: C) auto + +subsection \<open>Properties on subterm at given position @{const subt_at}\<close> + +lemma subt_at_Cons_comp: + "i # p \<in> poss s \<Longrightarrow> (s |_ [i]) |_ p = s |_ (i # p)" + by (cases s) auto + +lemma ctxt_at_pos_subt_at_pos: + "p \<in> poss t \<Longrightarrow> (ctxt_at_pos t p)\<langle>u\<rangle> |_ p = u" +proof (induct p arbitrary: t) + case (Cons i p) + then show ?case using id_take_nth_drop + by (cases t) (auto simp: nth_append) +qed auto + +lemma ctxt_at_pos_subt_at_id: + "p \<in> poss t \<Longrightarrow> (ctxt_at_pos t p)\<langle>t |_ p\<rangle> = t" +proof (induct p arbitrary: t) + case (Cons i p) + then show ?case using id_take_nth_drop + by (cases t) force+ +qed auto + +lemma subst_at_ctxt_at_eq_termD: + assumes "s = t" "p \<in> poss t" + shows "s |_ p = t |_ p \<and> ctxt_at_pos s p = ctxt_at_pos t p" using assms + by auto + +lemma subst_at_ctxt_at_eq_termI: + assumes "p \<in> poss s" "p \<in> poss t" + and "s |_p = t |_ p" + and "ctxt_at_pos s p = ctxt_at_pos t p" + shows "s = t" using assms + by (metis ctxt_at_pos_subt_at_id) + +lemma subt_at_subterm_eq [intro!]: + "p \<in> poss t \<Longrightarrow> t \<unrhd> t |_ p" +proof (induct p arbitrary: t) + case (Cons i p) + from Cons(1)[of "args t ! i"] Cons(2) show ?case + by (cases t) force+ +qed auto + +lemma subt_at_subterm [intro!]: + "p \<in> poss t \<Longrightarrow> p \<noteq> [] \<Longrightarrow> t \<rhd> t |_ p" +proof (induct p arbitrary: t) + case (Cons i p) + from Cons(1)[of "args t ! i"] Cons(2) show ?case + by (cases t) force+ +qed auto + + +lemma ctxt_at_pos_hole_pos [simp]: "ctxt_at_pos C\<langle>s\<rangle> (hole_pos C) = C" + by (induct C) auto + +subsection \<open>Properties on replace terms at a given position + @{const replace_term_at}\<close> + +lemma replace_term_at_not_poss [simp]: + "p \<notin> poss s \<Longrightarrow> s[p \<leftarrow> t] = s" +proof (induct s arbitrary: p) + case (Var x) then show ?case by (cases p) auto +next + case (Fun f ts) show ?case using Fun(1)[OF nth_mem] Fun(2) + by (cases p) (auto simp: min_def intro!: nth_equalityI) +qed + +lemma replace_term_at_replace_at_conv: + "p \<in> poss s \<Longrightarrow> (ctxt_at_pos s p)\<langle>t\<rangle> = s[p \<leftarrow> t]" + by (induct s arbitrary: p) (auto simp: upd_conv_take_nth_drop) + +lemma parallel_replace_term_commute [ac_simps]: + "p \<bottom> q \<Longrightarrow> s[p \<leftarrow> t][q \<leftarrow> u] = s[q \<leftarrow> u][p \<leftarrow> t]" +proof (induct s arbitrary: p q) + case (Var x) then show ?case + by (cases p; cases q) auto +next + case (Fun f ts) + from Fun(2) have "p \<noteq> []" "q \<noteq> []" by auto + then obtain i j ps qs where [simp]: "p = i # ps" "q = j # qs" + by (cases p; cases q) auto + have "i \<noteq> j \<Longrightarrow> (Fun f ts)[p \<leftarrow> t][q \<leftarrow> u] = (Fun f ts)[q \<leftarrow> u][p \<leftarrow> t]" + by (auto simp: list_update_swap) + then show ?case using Fun(1)[OF nth_mem, of j ps qs] Fun(2) + by (cases "i = j") (auto simp: par_Cons_iff) +qed + +lemma replace_term_at_above [simp]: + "p \<le>\<^sub>p q \<Longrightarrow> s[q \<leftarrow> t][p \<leftarrow> u] = s[p \<leftarrow> u]" +proof (induct p arbitrary: s q) + case (Cons i p) + show ?case using Cons(1)[of "tl q" "args s ! i"] Cons(2) + by (cases q; cases s) auto +qed auto + +lemma replace_term_at_below [simp]: + "p <\<^sub>p q \<Longrightarrow> s[p \<leftarrow> t][q \<leftarrow> u] = s[p \<leftarrow> t[q -\<^sub>p p \<leftarrow> u]]" +proof (induct p arbitrary: s q) + case (Cons i p) + show ?case using Cons(1)[of "tl q" "args s ! i"] Cons(2) + by (cases q; cases s) auto +qed auto + +lemma replace_at_hole_pos [simp]: "C\<langle>s\<rangle>[hole_pos C \<leftarrow> t] = C\<langle>t\<rangle>" + by (induct C) auto + +subsection \<open>Properties on @{const adapt_vars} and @{const adapt_vars_ctxt}\<close> + +lemma adapt_vars2: + "adapt_vars (adapt_vars t) = adapt_vars t" + by (induct t) (auto simp add: adapt_vars_def) + +lemma adapt_vars_simps[code, simp]: "adapt_vars (Fun f ts) = Fun f (map adapt_vars ts)" + by (induct ts, auto simp: adapt_vars_def) + +lemma adapt_vars_reverse: "ground t \<Longrightarrow> adapt_vars t' = t \<Longrightarrow> adapt_vars t = t'" + unfolding adapt_vars_def +proof (induct t arbitrary: t') + case (Fun f ts) + then show ?case by (cases t') (auto simp add: map_idI) +qed auto + +lemma ground_adapt_vars [simp]: "ground (adapt_vars t) = ground t" + by (simp add: adapt_vars_def) +lemma funas_term_adapt_vars[simp]: "funas_term (adapt_vars t) = funas_term t" by (simp add: adapt_vars_def) + +lemma adapt_vars_adapt_vars[simp]: fixes t :: "('f,'v)term" + assumes g: "ground t" + shows "adapt_vars (adapt_vars t :: ('f,'w)term) = t" +proof - + let ?t' = "adapt_vars t :: ('f,'w)term" + have gt': "ground ?t'" using g by auto + from adapt_vars_reverse[OF gt', of t] show ?thesis by blast +qed + +lemma adapt_vars_inj: + assumes "adapt_vars x = adapt_vars y" "ground x" "ground y" + shows "x = y" + using adapt_vars_adapt_vars assms by metis + +lemma adapt_vars_ctxt_simps[simp, code]: + "adapt_vars_ctxt (More f bef C aft) = More f (map adapt_vars bef) (adapt_vars_ctxt C) (map adapt_vars aft)" + "adapt_vars_ctxt Hole = Hole" unfolding adapt_vars_ctxt_def adapt_vars_def by auto + +lemma adapt_vars_ctxt[simp]: "adapt_vars (C \<langle> t \<rangle> ) = (adapt_vars_ctxt C) \<langle> adapt_vars t \<rangle>" + by (induct C, auto) + +lemma adapt_vars_subst[simp]: "adapt_vars (l \<cdot> \<sigma>) = l \<cdot> (\<lambda> x. adapt_vars (\<sigma> x))" + unfolding adapt_vars_def + by (induct l) auto + +lemma adapt_vars_gr_map_vars [simp]: + "ground t \<Longrightarrow> map_vars_term f t = adapt_vars t" + by (induct t) auto + + +lemma adapt_vars_gr_ctxt_of_map_vars [simp]: + "ground_ctxt C \<Longrightarrow> map_vars_ctxt f C = adapt_vars_ctxt C" + by (induct C) auto + +subsubsection \<open>Equality on ground terms/contexts by positions and symbols\<close> + +lemma fun_at_def': + "fun_at t p = (if p \<in> poss t then + (case t |_ p of Var x \<Rightarrow> Some (Inr x) | Fun f ts \<Rightarrow> Some (Inl f)) else None)" + by (induct t p rule: fun_at.induct) auto + +lemma fun_at_None_nposs_iff: + "fun_at t p = None \<longleftrightarrow> p \<notin> poss t" + by (auto simp: fun_at_def') (meson term.case_eq_if) + +lemma eq_term_by_poss_fun_at: + assumes "poss s = poss t" "\<And>p. p \<in> poss s \<Longrightarrow> fun_at s p = fun_at t p" + shows "s = t" + using assms +proof (induct s arbitrary: t) + case (Var x) then show ?case + by (cases t) simp_all +next + case (Fun f ss) note Fun' = this + show ?case + proof (cases t) + case (Var x) show ?thesis using Fun'(3)[of "[]"] by (simp add: Var) + next + case (Fun g ts) + have *: "length ss = length ts" + using Fun'(3) arg_cong[OF Fun'(2), of "\<lambda>P. card {i |i p. i # p \<in> P}"] + by (auto simp: Fun exI[of "\<lambda>x. x \<in> poss _", OF Nil_in_poss]) + then have "i < length ss \<Longrightarrow> poss (ss ! i) = poss (ts ! i)" for i + using arg_cong[OF Fun'(2), of "\<lambda>P. {p. i # p \<in> P}"] by (auto simp: Fun) + then show ?thesis using * Fun'(2) Fun'(3)[of "[]"] Fun'(3)[of "_ # _ :: pos"] + by (auto simp: Fun intro!: nth_equalityI Fun'(1)[OF nth_mem, of n "ts ! n" for n]) + qed +qed + +lemma eq_ctxt_at_pos_by_poss: + assumes "p \<in> poss s" "p \<in> poss t" + and "\<And> q. \<not> (p \<le>\<^sub>p q) \<Longrightarrow> q \<in> poss s \<longleftrightarrow> q \<in> poss t" + and "(\<And> q. q \<in> poss s \<Longrightarrow> \<not> (p \<le>\<^sub>p q) \<Longrightarrow> fun_at s q = fun_at t q)" + shows "ctxt_at_pos s p = ctxt_at_pos t p" using assms +proof (induct p arbitrary: s t) + case (Cons i p) + from Cons(2, 3) Cons(4, 5)[of "[]"] obtain f ss ts where [simp]: "s = Fun f ss" "t = Fun f ts" + by (cases s; cases t) auto + have flt: "j j # q \<in> poss s \<Longrightarrow> fun_at s (j # q) = fun_at t (j # q)" for j q + by (intro Cons(5)) auto + have fgt: "i < j \<Longrightarrow> j # q \<in> poss s \<Longrightarrow> fun_at s (j # q) = fun_at t (j # q)" for j q + by (intro Cons(5)) auto + have lt: "j j # q \<in> poss s \<longleftrightarrow> j # q \<in> poss t" for j q by (intro Cons(4)) auto + have gt: "i < j \<Longrightarrow> j # q \<in> poss s \<longleftrightarrow> j # q \<in> poss t" for j q by (intro Cons(4)) auto + from this[of _ "[]"] have "i < j \<Longrightarrow> j < length ss \<longleftrightarrow> j < length ts" for j by auto + from this Cons(2, 3) have l: "length ss = length ts" by auto (meson nat_neq_iff) + have "ctxt_at_pos (ss ! i) p = ctxt_at_pos (ts ! i) p" using Cons(2, 3) Cons(4-)[of "i # q" for q] + by (intro Cons(1)[of "ss ! i" "ts ! i"]) auto + moreover have "take i ss = take i ts" using l lt Cons(2, 3) flt + by (intro nth_equalityI) (auto intro!: eq_term_by_poss_fun_at) + moreover have "drop (Suc i) ss = drop (Suc i) ts" using l Cons(2, 3) fgt gt[of "Suc i + j" for j] + by (intro nth_equalityI) (auto simp: nth_map intro!: eq_term_by_poss_fun_at, fastforce+) + ultimately show ?case by auto +qed auto + + +subsection \<open>Misc\<close> + +lemma fun_at_hole_pos_ctxt_apply [simp]: + "fun_at C\<langle>t\<rangle> (hole_pos C) = fun_at t []" + by (induct C) auto + +lemma vars_term_ctxt_apply [simp]: + "vars_term C\<langle>t\<rangle> = vars_ctxt C \<union> vars_term t" + by (induct C arbitrary: t) auto + +lemma map_vars_term_ctxt_apply: + "map_vars_term f C\<langle>t\<rangle> = (map_vars_ctxt f C)\<langle>map_vars_term f t\<rangle>" + by (induct C) auto + +lemma map_term_replace_at_dist: + "p \<in> poss s \<Longrightarrow> (map_term f g s)[p \<leftarrow> (map_term f g t)] = map_term f g (s[p \<leftarrow> t])" +proof (induct p arbitrary: s) + case (Cons i p) then show ?case + by (cases s) (auto simp: nth_list_update intro!: nth_equalityI) +qed auto + +end \ No newline at end of file diff --git a/thys/Regular_Tree_Relations/document/root.bib b/thys/Regular_Tree_Relations/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/document/root.bib @@ -0,0 +1,71 @@ +@string{lipics = "Leibniz International Proceedings in Informatics"} +@string{proc = "Proc.\ "} +@string{lics = "{IEEE} Symposium on Logic in Computer Science"} +@string{cpp = "ACM SIGPLAN International Conference on Certified Programs + and Proofs"} + +@inbook{KGTM, +author = {Kucherov, Gregory and Tajine, Mohamed}, +year = {2006}, +month = {01}, +pages = {272-286}, +title = {Decidability of Regularity and Related Properties of Ground Normal Form Languages}, +volume = {118}, +isbn = {978-3-540-56393-8}, +journal = {Information and Computation}, +doi = {10.1007/3-540-56393-8_20} +} + +@inproceedings{DT90, + author = "Max Dauchet and Sophie Tison", + title = "The Theory of Ground Rewrite Systems is Decidable", + booktitle = proc # "5th " # lics, + pages = "242--248", + year = 1990, + doi = "10.1109/LICS.1990.113750" +} + +@article{Collections-AFP, + author = {Peter Lammich}, + title = {Collections Framework}, + journal = {Archive of Formal Proofs}, + month = nov, + year = 2009, + note = {\url{https://isa-afp.org/entries/Collections.html}, + Formal proof development}, + ISSN = {2150-914x}, +} + +@inproceedings{LMMF21, + author = "Alexander Lochmann and Aart Middeldorp and + Fabian Mitterwallner and Bertram Felgenhauer", + title = "A Verified Decision Procedure for the First-Order Theory of + Rewriting for Linear Variable-Separated Rewrite Systems + in {Isabelle/HOL}", + booktitle = proc # "10th " # cpp, + editor = "Cătălin Hriţcu and Andrei Popescu", + pages = "250--263", + year = 2021, + doi = "10.1145/3437992.3439918" +} + +@Misc{tata2007, + author = {H. Comon and M. Dauchet and R. Gilleron and C. L\"oding +and F. Jacquemard +and D. Lugiez and S. Tison and M. Tommasi}, + title = {Tree Automata Techniques and Applications}, + howpublished = {Available on: \url{http://www.grappa.univ-lille3.fr/tata}}, + note = {release October, 12th 2007}, + year = 2007 +} + +@article{Tree-Automata-AFP, + author = {Peter Lammich}, + title = {Tree Automata}, + journal = {Archive of Formal Proofs}, + month = nov, + year = 2009, + note = {\url{https://isa-afp.org/entries/Tree-Automata.html}, + Formal proof development}, + ISSN = {2150-914x}, +} diff --git a/thys/Regular_Tree_Relations/document/root.tex b/thys/Regular_Tree_Relations/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Regular_Tree_Relations/document/root.tex @@ -0,0 +1,86 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +\usepackage{url} +\usepackage{amssymb} +\usepackage{xspace} + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +\newcommand\isafor{\textsf{Isa\kern-0.15exF\kern-0.15exo\kern-0.15exR}} +\newcommand\ceta{\textsf{C\kern-0.15exe\kern-0.45exT\kern-0.45exA}} + +\begin{document} + + +\title{A Formalization of Tree Automaton, (Anchord) Ground Tree Transducers, and Regular Relations\footnote{Supported by FWF (Austrian Science Fund) projects P30301 and Y757.}} +\author{Alexander Lochmann \and Bertram Felgenhauer \and Christian Sternagel \and Ren\'e Thiemann \and Thomas Sternagel} +\maketitle + +\begin{abstract} +Tree automata have good closure properties and therefore a commonly +used to prove/disprove properties. This formalization contains +among other things the proofs of many closure properties of tree automata +(anchored) ground tree transducers and regular relations. +Additionally it includes the well known pumping lemma and a lifting of +the Myhill Nerode theorem for regular languages to tree languages. + +We want to mention the existence of a tree automata APF-entry developed by +Peter Lammich. His work is based on epsilon free top-down tree automata, +while this entry builds on bottom-up tree auotamta with epsilon transitions. +Moreover our formalization relies on the Collections Framework also by Peter +Lammich \cite{Collections-AFP} to obtain efficient code. +All proven constructions of the closure properties are exportable using +the Isabelle/HOL code generation facilities. +\end{abstract} + +\tableofcontents + +\section{Introduction} + +Tree automata characterize a computable subset of term languages +which are called regular tree languages. These languages are closed +under union, intersection, and complement. Due to their nice closure +properties tree automata techniques are frequently used to prove/disprove +properties. + +As an example consider the field of rewriting. +Dauchet and Tison showed that the theory of ground rewrite systems is decidable \cite{DT90}. +As another example, Kucherov et.al. proved that the regularity of the normal forms +induced by a rewrite system is decidable \cite{KGTM}. + +In this formalization we also consider (anchored) ground tree transducers ((A)GTTs) +and regular relations. The first allows to reason about relations on +regular tree languages and the latter to reason about tuples of arbitrary size +over regular tree languages. We distinguish them as they have different +closure properties. While (anchored) ground tree transducers are closed +under transitivity, regular relations are not. Additional information about +these constructions and their closure properties can be found in \cite{LMMF21}. + +This APF-entry provides a formalization of the general tree automata theory, GTTs, +and regular relations. Moreover it contains a newly developed theory on the topic of +AGTTs (construction is equivalent to the definition of $Rec_2$ in TATA \cite[Chapter~3]{tata2007}) +and how they are related to regular GTTs. + +We want to mention the existence of a tree automata APF-entry developed by +Peter Lammich \cite{Tree-Automata-AFP}. The main reason for developing +a new tree automata theory instead of working on top of his work was +the underlying tree automata definition. Whereas our formalization defines +bottom-up tree automaton with epsilon transitions, Peter Lammichs defines +top-down tree automaton without epsilon transitions. These definitions do not differ +in expressibility (i.e. a language is recognized by a bottom-up tree automaton +if and only if it is recognized by a top-down tree automaton), however the +use of epsilon transitions simplifies many constructions. + +\input{session} + +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + diff --git a/thys/Roth_Arithmetic_Progressions/ROOT b/thys/Roth_Arithmetic_Progressions/ROOT new file mode 100644 --- /dev/null +++ b/thys/Roth_Arithmetic_Progressions/ROOT @@ -0,0 +1,11 @@ +chapter AFP + +session Roth_Arithmetic_Progressions (AFP) = "HOL-Probability" + + options [timeout = 600] + sessions + Girth_Chromatic Szemeredi_Regularity Random_Graph_Subgraph_Threshold Ergodic_Theory + theories + Roth_Arithmetic_Progressions + document_files + "root.tex" + diff --git a/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy b/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy new file mode 100644 --- /dev/null +++ b/thys/Roth_Arithmetic_Progressions/Roth_Arithmetic_Progressions.thy @@ -0,0 +1,1862 @@ +section\<open>Roth's Theorem on Arithmetic Progressions\<close> + +theory Roth_Arithmetic_Progressions + imports Szemeredi_Regularity.Szemeredi + "Random_Graph_Subgraph_Threshold.Subgraph_Threshold" + "Ergodic_Theory.Asymptotic_Density" + "HOL-Library.Ramsey" "HOL-Library.Nat_Bijection" + +begin + + +subsection \<open>For the Library\<close> + +declare prod_encode_eq [simp] +declare prod_decode_eq [simp] + +lemma mult_mod_cancel_right: + fixes m :: "'a::{euclidean_ring_cancel,semiring_gcd}" + assumes eq: "(a * n) mod m = (b * n) mod m" and "coprime m n" + shows "a mod m = b mod m" +proof - + have "m dvd (a*n - b*n)" + using eq mod_eq_dvd_iff by blast + then have "m dvd a-b" + by (metis \<open>coprime m n\<close> coprime_dvd_mult_left_iff left_diff_distrib') + then show ?thesis + using mod_eq_dvd_iff by blast +qed + +lemma mult_mod_cancel_left: + fixes m :: "'a::{euclidean_ring_cancel,semiring_gcd}" + assumes "(n * a) mod m = (n * b) mod m" and "coprime m n" + shows "a mod m = b mod m" + by (metis assms mult.commute mult_mod_cancel_right) + +(*Stronger than the one in Szemeredi [now installed in AFP_devel] *) +lemma edge_density_le1: "edge_density X Y G \<le> 1" +proof (cases "finite X \<and> finite Y") + case True + then show ?thesis + using of_nat_mono [OF max_all_edges_between, of X Y] + by (fastforce simp add: edge_density_def divide_simps) +qed (auto simp: edge_density_def) + +lemma card_3_iff: "card S = 3 \<longleftrightarrow> (\<exists>x y z. S = {x,y,z} \<and> x \<noteq> y \<and> y \<noteq> z \<and> x \<noteq> z)" + by (fastforce simp: card_Suc_eq numeral_eq_Suc) + +subsection \<open>Miscellaneous Preliminaries\<close> + +lemma sum_prod_le_prod_sum: + fixes a :: "'a \<Rightarrow> 'b::linordered_idom" + assumes "\<And>i. i \<in> I \<Longrightarrow> a i \<ge> 0 \<and> b i \<ge> 0" + shows "(\<Sum>i\<in>I. \<Sum>j\<in>I. a i * b j) \<le> (\<Sum>i\<in>I. a i) * (\<Sum>i\<in>I. b i)" + using assms + by (induction I rule: infinite_finite_induct) (auto simp add: algebra_simps sum.distrib sum_distrib_left) + +lemma real_mult_gt_cube: "A \<ge> (X ::real) \<Longrightarrow> B \<ge> X \<Longrightarrow> C \<ge> X \<Longrightarrow> X \<ge> 0 \<Longrightarrow> A * B * C \<ge> X^3" + by (simp add: mult_mono' power3_eq_cube) + +lemma min_card_fin_X_elem: "finite X \<Longrightarrow> x \<in> X \<Longrightarrow> card X \<ge> 1" + using card.remove by fastforce + +lemma card_or_filter_max: + assumes "finite A" + shows "card {a \<in> A . P a \<or> Q a} \<le> card {a \<in> A . P a} + card {a \<in> A . Q a}" +proof - + have fin: "finite {a \<in> A . P a}" "finite {a \<in> A . Q a}" + by(simp_all add: assms) + have equiv: "{a \<in> A . P a \<or> Q a} = {a \<in> A . P a} \<union> {a \<in> A . Q a}" by auto + then have "card {a \<in> A . P a} + card {a \<in> A . Q a} = card ({a \<in> A . P a} \<union> {a \<in> A . Q a}) + card ({a \<in> A . P a} \<inter> {a \<in> A . Q a})" + using card_Un_Int fin by auto + thus ?thesis using equiv + by presburger +qed + +lemma triple_sigma_rewrite_card: + assumes "finite X" "finite Y" "finite Z" + shows "card {(x, y, z) . x \<in> X \<and> (y, z) \<in> Y \<times> Z \<and> P x y z} = (\<Sum>x\<in> X . card {(y,z) \<in> Y \<times> Z. P x y z})" +proof - + define W where "W \<equiv> \<lambda>x. {(y,z) \<in> Y \<times> Z. P x y z}" + have "W x \<subseteq> Y \<times> Z" for x + by (auto simp: W_def) + then have [simp]: "finite (W x)" for x + by (meson assms finite_SigmaI infinite_super) + have eq: "{(x, y, z) . x \<in> X \<and> (y, z) \<in> Y \<times> Z \<and> P x y z} = (\<Union>x\<in>X. \<Union>(y, z)\<in>W x. {(x,y,z)})" + by (auto simp: W_def) + show ?thesis + unfolding eq by (simp add: disjoint_iff assms card_UN_disjoint) (simp add: W_def) +qed + +lemma all_edges_between_Union1: + "all_edges_between (Union \<X>) Y G = (\<Union>X\<in>\<X>. all_edges_between X Y G)" + by (auto simp: all_edges_between_def) + +lemma all_edges_between_Union2: + "all_edges_between X (Union \<Y>) G = (\<Union>Y\<in>\<Y>. all_edges_between X Y G)" + by (auto simp: all_edges_between_def) + +lemma all_edges_between_disjoint1: + assumes "disjoint R" + shows "disjoint ((\<lambda>X. all_edges_between X Y G) ` R)" + using assms by (auto simp: all_edges_between_def disjoint_def) + +lemma all_edges_between_disjoint2: + assumes "disjoint R" + shows "disjoint ((\<lambda>Y. all_edges_between X Y G) ` R)" + using assms by (auto simp: all_edges_between_def disjoint_def) + +lemma all_edges_between_disjoint_family_on1: + assumes "disjoint R" + shows "disjoint_family_on (\<lambda>X. all_edges_between X Y G) R" + by (metis (no_types, lifting) all_edges_between_disjnt1 assms disjnt_def disjoint_family_on_def pairwiseD) + +lemma all_edges_between_disjoint_family_on2: + assumes "disjoint R" + shows "disjoint_family_on (\<lambda>Y. all_edges_between X Y G) R" + by (metis (no_types, lifting) all_edges_between_disjnt2 assms disjnt_def disjoint_family_on_def pairwiseD) + +lemma all_edges_between_mono1: + "Y \<subseteq> Z \<Longrightarrow> all_edges_between Y X G \<subseteq> all_edges_between Z X G" + by (auto simp: all_edges_between_def) + +lemma all_edges_between_mono2: + "Y \<subseteq> Z \<Longrightarrow> all_edges_between X Y G \<subseteq> all_edges_between X Z G" + by (auto simp: all_edges_between_def) + +lemma inj_on_mk_uedge: "X \<inter> Y = {} \<Longrightarrow> inj_on mk_uedge (all_edges_between X Y G)" + by (auto simp: inj_on_def doubleton_eq_iff all_edges_between_def) + +lemma uwellformed_alt: + assumes "uwellformed G" "{x, y} \<in> uedges G" + shows "{x, y} \<subseteq> uverts G" + using uwellformed_def assms by auto + +lemma uwellformed_alt_fst: + assumes "uwellformed G" "{x, y} \<in> uedges G" + shows "x \<in> uverts G" + using uwellformed_alt assms by simp + +lemma uwellformed_alt_snd: + assumes "uwellformed G" "{x, y} \<in> uedges G" + shows "y \<in> uverts G" + using uwellformed_alt assms by simp + +lemma all_edges_between_subset_times: "all_edges_between X Y G \<subseteq> (X \<inter> \<Union>(uedges G)) \<times> (Y \<inter> \<Union>(uedges G))" + by (auto simp: all_edges_between_def) + +lemma finite_all_edges_between': + assumes "finite (uverts G)" "uwellformed G" + shows "finite (all_edges_between X Y G)" +proof - + have "finite (\<Union>(uedges G))" + by (meson Pow_iff all_edges_subset_Pow assms finite_Sup subsetD wellformed_all_edges) + with all_edges_between_subset_times show ?thesis + by (metis finite_Int finite_SigmaI finite_subset) +qed + +lemma card_all_edges_between: + assumes "finite Y" "finite (uverts G)" "uwellformed G" + shows "card (all_edges_between X Y G) = (\<Sum>y\<in>Y. card (all_edges_between X {y} G))" +proof - + have "all_edges_between X Y G = (\<Union>y\<in>Y. all_edges_between X {y} G)" + by (auto simp: all_edges_between_def) + moreover have "disjoint_family_on (\<lambda>y. all_edges_between X {y} G) Y" + unfolding disjoint_family_on_def + by (auto simp: disjoint_family_on_def all_edges_between_def) + ultimately show ?thesis + by (simp add: card_UN_disjoint' assms finite_all_edges_between') +qed + +lemma max_edges_graph: + assumes "uwellformed G" "finite (uverts G)" + shows "card (uedges G) \<le> (card (uverts G))^2" +proof - + have "card (uedges G) \<le> card (uverts G) choose 2" + by (metis all_edges_finite assms card_all_edges card_mono wellformed_all_edges) + thus ?thesis + by (metis binomial_le_pow le0 neq0_conv order.trans zero_less_binomial_iff) +qed + +lemma all_edges_between_ss_uedges: "mk_uedge ` (all_edges_between X Y G) \<subseteq> uedges G" + by (auto simp: all_edges_between_def) + +lemma all_edges_betw_D1: "(x, y) \<in> all_edges_between X Y G \<Longrightarrow> x \<in> X" + by (simp add: all_edges_between_def) + +lemma all_edges_betw_D2: "(x, y) \<in> all_edges_between X Y G \<Longrightarrow> y \<in> Y" + by (simp add: all_edges_between_def) + +lemma all_edges_betw_D3: "(x, y) \<in> all_edges_between X Y G \<Longrightarrow> {x, y} \<in> uedges G" + by (simp add: all_edges_between_def) + +lemma all_edges_betw_I: "x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> {x, y} \<in> uedges G \<Longrightarrow> (x, y) \<in> all_edges_between X Y G" + by (simp add: all_edges_between_def) + +lemma all_edges_between_E_diff: + "all_edges_between X Y (V,E-E') = all_edges_between X Y (V,E) - all_edges_between X Y (V,E')" + by (auto simp: all_edges_between_def) + +lemma all_edges_between_E_Un: + "all_edges_between X Y (V,E\<union>E') = all_edges_between X Y (V,E) \<union> all_edges_between X Y (V,E')" + by (auto simp: all_edges_between_def) + +lemma all_edges_between_E_UN: + "all_edges_between X Y (V, \<Union>i\<in>I. E i) = (\<Union>i\<in>I. all_edges_between X Y (V,E i))" + by (auto simp: all_edges_between_def) + +lemma all_edges_betw_prod_def: "all_edges_between X Y G = {(x, y) \<in> X \<times> Y . {x, y} \<in> uedges G}" + by (simp add: all_edges_between_def) + +thm in_mk_uedge_img +lemma in_mk_uedge_img_iff: "{a,b} \<in> mk_uedge ` A \<longleftrightarrow> (a,b) \<in> A \<or> (b,a) \<in> A" + by (auto simp: doubleton_eq_iff intro: rev_image_eqI) + +lemma all_edges_preserved: "\<lbrakk>all_edges_between A B G' = all_edges_between A B G; X \<subseteq> A; Y \<subseteq> B\<rbrakk> + \<Longrightarrow> all_edges_between X Y G' = all_edges_between X Y G" + by (auto simp: all_edges_between_def) + +lemma subgraph_edge_wf: + assumes "uwellformed G" "uverts H = uverts G" "uedges H \<subseteq> uedges G" + shows "uwellformed H" + by (metis assms subsetD uwellformed_def) + + +subsection \<open>Preliminaries on Neighbors in Graphs\<close> + + +definition neighbor_in_graph:: " uvert \<Rightarrow> uvert \<Rightarrow> ugraph \<Rightarrow> bool" + where "neighbor_in_graph x y G \<equiv> (x \<in> (uverts G) \<and> y \<in> (uverts G) \<and> {x,y} \<in> (uedges G))" + +definition neighbors :: "uvert \<Rightarrow> ugraph \<Rightarrow> uvert set" where + "neighbors x G \<equiv> {y \<in> uverts G . neighbor_in_graph x y G}" + +definition neighbors_ss:: "uvert \<Rightarrow> uvert set \<Rightarrow> ugraph \<Rightarrow> uvert set" where + "neighbors_ss x Y G \<equiv> {y \<in> Y . neighbor_in_graph x y G}" + + +lemma all_edges_betw_prod_def_neighbors: "uwellformed G \<Longrightarrow> + all_edges_between X Y G = {(x, y) \<in> X \<times> Y . neighbor_in_graph x y G}" + by (auto simp: neighbor_in_graph_def uwellformed_alt_fst uwellformed_alt_snd all_edges_between_def) + +lemma all_edges_betw_sigma_neighbor: +"uwellformed G \<Longrightarrow> all_edges_between X Y G = (SIGMA x:X. neighbors_ss x Y G)" + by (auto simp add: all_edges_between_def neighbors_ss_def neighbor_in_graph_def + uwellformed_alt_fst uwellformed_alt_snd) + +lemma card_all_edges_betw_neighbor: + assumes "finite X" "finite Y" "uwellformed G" + shows "card (all_edges_between X Y G) = (\<Sum>x\<in>X. card (neighbors_ss x Y G))" + using all_edges_betw_sigma_neighbor assms by (simp add: neighbors_ss_def) + + + +subsection \<open>Preliminaries on Triangles in Graphs\<close> + + +definition triangle_in_graph:: "uvert \<Rightarrow> uvert \<Rightarrow> uvert \<Rightarrow> ugraph \<Rightarrow> bool" + where "triangle_in_graph x y z G + \<equiv> ({x,y} \<in> uedges G) \<and> ({y,z} \<in> uedges G) \<and> ({x,z} \<in> uedges G)" + +definition triangle_triples + where "triangle_triples X Y Z G \<equiv> {(x,y,z) \<in> X \<times> Y \<times> Z. triangle_in_graph x y z G}" + +lemma card_triangle_triples_rotate: "card (triangle_triples X Y Z G) = card (triangle_triples Y Z X G)" +proof - + have "triangle_triples Y Z X G = (\<lambda>(x,y,z). (y,z,x)) ` triangle_triples X Y Z G" + by (auto simp: triangle_triples_def case_prod_unfold image_iff insert_commute triangle_in_graph_def) + moreover have "inj_on (\<lambda>(x, y, z). (y, z, x)) (triangle_triples X Y Z G)" + by (auto simp: inj_on_def) + ultimately show ?thesis + by (simp add: card_image) +qed + +lemma triangle_commu1: + assumes "triangle_in_graph x y z G" + shows "triangle_in_graph y x z G" + using assms triangle_in_graph_def by (auto simp add: insert_commute) + +lemma triangle_vertices_distinct1: + assumes wf: "uwellformed G" + assumes tri: "triangle_in_graph x y z G" + shows "x \<noteq> y" +proof (rule ccontr) + assume a: "\<not> x \<noteq> y" + have "card {x, y} = 2" using tri wf triangle_in_graph_def + using uwellformed_def by blast + thus False using a by simp +qed + +lemma triangle_vertices_distinct2: + assumes "uwellformed G" "triangle_in_graph x y z G" + shows "y \<noteq> z" + by (metis assms triangle_vertices_distinct1 triangle_in_graph_def) + +lemma triangle_vertices_distinct3: + assumes "uwellformed G" "triangle_in_graph x y z G" + shows "z \<noteq> x" + by (metis assms triangle_vertices_distinct1 triangle_in_graph_def) + +lemma triangle_in_graph_edge_point: + assumes "uwellformed G" + shows "triangle_in_graph x y z G \<longleftrightarrow> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G" + by (auto simp add: triangle_in_graph_def neighbor_in_graph_def assms uwellformed_alt_fst uwellformed_alt_snd) + +definition + "unique_triangles G + \<equiv> \<forall>e \<in> uedges G. \<exists>!T. \<exists>x y z. T = {x,y,z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> T" + +definition triangle_free_graph:: "ugraph \<Rightarrow> bool" + where "triangle_free_graph G \<equiv> \<not>(\<exists> x y z. triangle_in_graph x y z G )" + +lemma triangle_free_graph_empty: "uedges G = {} \<Longrightarrow> triangle_free_graph G" + by (simp add: triangle_free_graph_def triangle_in_graph_def) + +lemma edge_vertices_not_equal: + assumes "uwellformed G" "{x,y} \<in> uedges G" + shows "x \<noteq> y" + using assms triangle_in_graph_def triangle_vertices_distinct1 by blast + +lemma edge_btw_vertices_not_equal: + assumes "uwellformed G" "(x, y) \<in> all_edges_between X Y G" + shows "x \<noteq> y" + using edge_vertices_not_equal all_edges_between_def + by (metis all_edges_betw_D3 assms) + +lemma mk_triangle_from_ss_edges: +assumes "(x, y) \<in> all_edges_between X Y G" and "(x, z) \<in> all_edges_between X Z G" and "(y, z) \<in> all_edges_between Y Z G" +shows "(triangle_in_graph x y z G)" + by (meson all_edges_betw_D3 assms triangle_in_graph_def) + +lemma triangle_in_graph_verts: + assumes "uwellformed G" + assumes "triangle_in_graph x y z G" + shows "x \<in> uverts G" "y \<in> uverts G" "z\<in> uverts G" +proof - + have 1: "{x, y} \<in> uedges G" using triangle_in_graph_def + using assms(2) by auto + then show "x \<in> uverts G" using uwellformed_alt_fst assms by blast + then show "y \<in> uverts G" using 1 uwellformed_alt_snd assms by blast + have "{x, z} \<in> uedges G" using triangle_in_graph_def assms(2) by auto + then show "z \<in> uverts G" using uwellformed_alt_snd assms by blast +qed + + +definition triangle_set :: "ugraph \<Rightarrow> uvert set set" + where "triangle_set G \<equiv> { {x,y,z} | x y z. triangle_in_graph x y z G}" + + +fun mk_triangle_set :: "(uvert \<times> uvert \<times> uvert) \<Rightarrow> uvert set" + where "mk_triangle_set (x, y, z) = {x,y,z}" + +lemma convert_triangle_rep_ss: + fixes G :: "ugraph" + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" + shows "mk_triangle_set ` {(x, y, z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)} \<subseteq> triangle_set G" + by (auto simp add: subsetI triangle_set_def) (auto) + +lemma finite_triangle_set: + fixes G :: "ugraph" + assumes fin: "finite (uverts G)" and wf: "uwellformed G" + shows "finite (triangle_set G)" +proof - + have "triangle_set G \<subseteq> Pow (uverts G)" + using insert_iff local.wf triangle_in_graph_def triangle_set_def uwellformed_def by auto + then show ?thesis + by (meson fin finite_Pow_iff infinite_super) +qed + +lemma card_triangle_3: + fixes G :: "ugraph" + assumes "t \<in> triangle_set G" "uwellformed G" + shows "card t = 3" + using assms by (auto simp: triangle_set_def edge_vertices_not_equal triangle_in_graph_def) + +lemma triangle_set_power_set_ss: "uwellformed G \<Longrightarrow> triangle_set G \<subseteq> Pow (uverts G)" + by (auto simp add: triangle_set_def triangle_in_graph_def uwellformed_alt_fst uwellformed_alt_snd) + +lemma triangle_set_finite: + assumes "finite (uverts G)" + assumes "uwellformed G" + shows "finite (triangle_set G)" + using triangle_set_power_set_ss assms + by (meson finite_Pow_iff rev_finite_subset) + +lemma triangle_in_graph_ss: + fixes G :: "ugraph" and Gnew :: "ugraph" + assumes "uedges Gnew \<subseteq> uedges G" + assumes "triangle_in_graph x y z Gnew" + shows "triangle_in_graph x y z G" +proof - + have "{x, y} \<in> uedges G" using assms triangle_in_graph_def by auto + have "{y, z} \<in> uedges G" using assms triangle_in_graph_def by auto + have "{x, z} \<in> uedges G" using assms triangle_in_graph_def by auto + thus ?thesis + by (simp add: \<open>{x, y} \<in> uedges G\<close> \<open>{y, z} \<in> uedges G\<close> triangle_in_graph_def) +qed + +lemma triangle_set_graph_edge_ss: + fixes G :: "ugraph" and Gnew :: "ugraph" + assumes "uwellformed G" + assumes "uedges Gnew \<subseteq> uedges G" + assumes "uverts Gnew = uverts G" + shows "(triangle_set Gnew) \<subseteq> (triangle_set G)" +proof (intro subsetI) + fix t assume "t \<in> triangle_set Gnew" + then obtain x y z where "t = {x,y,z}" and "triangle_in_graph x y z Gnew" + using triangle_set_def assms mem_Collect_eq by auto + then have "triangle_in_graph x y z G" using assms triangle_in_graph_ss by simp + thus "t \<in> triangle_set G" using triangle_set_def assms + using \<open>t = {x,y,z}\<close> by auto +qed + +lemma triangle_set_graph_edge_ss_bound: + fixes G :: "ugraph" and Gnew :: "ugraph" + assumes "uwellformed G" + assumes "finite (uverts G)" + assumes "uedges Gnew \<subseteq> uedges G" + assumes "uverts Gnew = uverts G" + shows "card (triangle_set G) \<ge> card (triangle_set Gnew)" + using triangle_set_graph_edge_ss triangle_set_finite + by (simp add: assms card_mono) + + +subsection \<open>The Triangle Counting Lemma and the Triangle Removal Lemma\<close> + +text\<open>We begin with some more auxiliary material to be used in the main lemmas.\<close> + +lemma regular_pairI: + fixes \<epsilon> :: real and G :: "ugraph" and X :: "uvert set" and Y ::"uvert set" + assumes "\<epsilon> > 0" and "regular_pair X Y G \<epsilon>" and xss: "X' \<subseteq> X" and yss: "Y' \<subseteq> Y" and "card X' \<ge> \<epsilon> * card X" and "(card Y' \<ge> \<epsilon> * card Y)" + shows "\<bar> edge_density X' Y' G - edge_density X Y G \<bar> \<le> \<epsilon>" + using regular_pair_def assms by meson + +lemma edge_density_zero: "Y = {} \<Longrightarrow> edge_density X Y G = 0" + by (simp add: edge_density_def) + +lemma regular_pair_neighbor_bound: + fixes \<epsilon>::real + assumes finG: "finite (uverts G)" + assumes xss: "X \<subseteq> uverts G" and yss: "Y \<subseteq> uverts G" and "card X > 0" + and wf: "uwellformed G" + and eg0: "\<epsilon> > 0" and "regular_pair X Y G \<epsilon>" and ed: "edge_density X Y G \<ge> 2*\<epsilon>" + shows "card{x \<in> X. card (neighbors_ss x Y G) < (edge_density X Y G - \<epsilon>)* card (Y)} < \<epsilon> * card X" + (is "card (?X') < \<epsilon> * _") +proof (cases "?X' = {}") + case True + then show ?thesis + by (simp add: True \<open>card X > 0\<close> eg0) + next + case False + show ?thesis + proof (rule ccontr) + assume "\<not> (card (?X') < \<epsilon> * card X) " + then have a: "(card(?X') \<ge> \<epsilon> * card X) " by simp + have fin: "finite X" "finite Y" using assms finite_subset by auto + have ebound: "\<epsilon> \<le> 1/2" + by (metis ed edge_density_le1 le_divide_eq_numeral1(1) mult.commute order_trans) + have finx: "finite ?X'" using fin by simp + have "\<And> x. x \<in> ?X'\<Longrightarrow> (card (neighbors_ss x Y G)) < (edge_density X Y G - \<epsilon>) * (card Y)" + by blast + then have "(\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) < (\<Sum>x\<in>?X'. ((edge_density X Y G - \<epsilon>)* (card Y)))" + using False sum_strict_mono + by (smt (verit, del_insts) finx of_nat_sum) + then have upper: "(\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) < (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y))" + by (simp add: sum_bounded_above) + have sumge0: "(\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) \<ge> 0" + by blast + have xge0: "card X > 0" + using fin(1) False by fastforce + have yge0: "card Y > 0" + using False by fastforce + then have xyge0: "card X * card Y > 0" using xge0 by simp + then have xyne0: "card X * card Y \<noteq> 0" by simp + have fracg0:"(1/(card ?X' * card Y)) > 0" + using card_0_eq finx False yge0 by fastforce + then have upper2: "(1/(card ?X' * card Y)) * (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) < (1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y))" + using upper mult_less_cancel_left_pos[of "(1/(card ?X' * card Y))" "(\<Sum>x\<in>?X'. card (neighbors_ss x Y G))" "(card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y))"] + by linarith + have minuse: "(1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y)) = (edge_density X Y G - \<epsilon>)" + proof - + have "(1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y)) = (1/(card ?X' * card Y)) * ((card ?X')* (card Y))*(edge_density X Y G - \<epsilon>)" + by (smt (z3) divide_divide_eq_right of_nat_mult times_divide_eq_left) + also have "\<dots> = ((card ?X'* card Y)/(card ?X' * card Y)) * (edge_density X Y G - \<epsilon>)" by simp + also have "\<dots> = 1 * (edge_density X Y G - \<epsilon>)" + using divide_eq_1_iff[of "(card ?X'* card Y)" "(card ?X'* card Y)"] xyne0 + using finx False by force + finally have "(1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y)) = (edge_density X Y G - \<epsilon>)" by simp + thus ?thesis by simp + qed + then have edlt1: "(1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y)) < edge_density X Y G" + using eg0 + by linarith + then have edlt2: "(1/(card ?X' * card Y))* (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) < edge_density X Y G" + using upper2 by linarith + then have "\<bar>edge_density X Y G - (1/(card ?X' * card Y))* (\<Sum>x\<in>?X'. card (neighbors_ss x Y G))\<bar> = edge_density X Y G - (1/(card ?X' * card Y))* (\<Sum>x\<in>?X'. card (neighbors_ss x Y G))" + by linarith + have "(edge_density X Y G - (1/(card ?X' * card Y))* (\<Sum>x\<in>?X'. card (neighbors_ss x Y G))) > (edge_density X Y G - (1/(card ?X' * card Y)) * (card ?X')* ((edge_density X Y G - \<epsilon>)* (card Y)))" + using edlt1 edlt2 upper2 + by linarith + then have "edge_density X Y G - (1/(card ?X' * card Y)) * (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) > edge_density X Y G - (edge_density X Y G - \<epsilon>)" + using minuse by linarith + then have con: "edge_density X Y G - (1/(card ?X' * card Y)) * (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) > \<epsilon>" by simp + have ye: "card Y \<ge> \<epsilon> * (card Y)" using ebound by (simp add: yge0) + have xe': "card ?X' \<ge> \<epsilon> * (card X)" using a by fastforce + have "?X' \<subseteq> X" by simp + then have "\<bar> edge_density ?X' Y G - edge_density X Y G \<bar> \<le> \<epsilon>" + using regular_pairI[of "\<epsilon>" "X" "Y" "G" "?X'" "Y"] assms ye xe' by simp + then have "\<bar> (card (all_edges_between ?X' Y G))/ (card ?X' * card Y) - edge_density X Y G \<bar> \<le> \<epsilon>" + by (simp add: edge_density_def) + then have "\<bar> (1/(card ?X' * card Y)) * (card (all_edges_between ?X' Y G)) - edge_density X Y G \<bar> \<le> \<epsilon>" + by simp + then have "\<bar>(1/(card ?X' * card Y)) * (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) - edge_density X Y G \<bar> \<le> \<epsilon>" + using card_all_edges_betw_neighbor fin wf by simp + then have lt: "\<bar>edge_density X Y G - (1/(card ?X' * card Y)) * (\<Sum>x\<in>?X'. card (neighbors_ss x Y G)) \<bar> \<le> \<epsilon>" + by simp + thus False using lt con by linarith + qed (* Following Gowers's proof - more in depth with reasoning on contradiction *) +qed + +lemma neighbor_set_meets_e_reg_cond: + fixes \<epsilon>::real + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and enot0: "\<epsilon> > 0" + and fin: "finite X" "finite Y" and "uwellformed G" + and rp1: "regular_pair X Y G \<epsilon>" + and ed1: "edge_density X Y G \<ge> 2*\<epsilon>" + and "card (neighbors_ss x Y G) \<ge> (edge_density X Y G - \<epsilon>) * card Y" +shows "card (neighbors_ss x Y G) \<ge> \<epsilon> * card (Y)" +proof - + have "card (neighbors_ss x Y G) \<ge> (edge_density X Y G - \<epsilon>) * card Y" using assms by simp + thus ?thesis + by (smt (verit, ccfv_SIG) mult_right_mono of_nat_less_0_iff ed1 enot0) +qed + + +lemma all_edges_btwn_neighbour_sets_lower_bound: + fixes \<epsilon>::real + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" and "\<epsilon> > 0" + and finG: "finite (uverts G)" + and wf: "uwellformed G" and fin: "finite X" "finite Y" "finite Z" + and rp1: "regular_pair X Y G \<epsilon> " and rp2: "regular_pair Y Z G \<epsilon>" and rp3: "regular_pair X Z G \<epsilon>" + and ed1: "edge_density X Y G \<ge> 2*\<epsilon>" and ed2: "edge_density X Z G \<ge> 2*\<epsilon>" and ed3: "edge_density Y Z G \<ge> 2*\<epsilon>" + and cond1: "card (neighbors_ss x Y G) \<ge> (edge_density X Y G - \<epsilon>) * card Y" + and cond2: "card (neighbors_ss x Z G) \<ge> (edge_density X Z G - \<epsilon>) * card Z" + and "x \<in> X" + shows "card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G) + \<ge> (edge_density Y Z G - \<epsilon>) * card (neighbors_ss x Y G) * card (neighbors_ss x Z G)" + (is "card (all_edges_between ?Y' ?Z' G) \<ge> (edge_density Y Z G - \<epsilon>) * card ?Y' * card ?Z'") +proof - + have yss': "?Y' \<subseteq> Y" using neighbors_ss_def by simp + have zss': "?Z' \<subseteq> Z" using neighbors_ss_def by simp + have min_sizeY: "card ?Y' \<ge> \<epsilon> * card Y" using neighbor_set_meets_e_reg_cond cond1 assms fin by meson + have min_sizeZ: "card ?Z' \<ge> \<epsilon> * card Z" using neighbor_set_meets_e_reg_cond cond2 assms fin by meson + then have "\<bar> edge_density ?Y' ?Z' G - edge_density Y Z G \<bar> \<le> \<epsilon>" + using min_sizeY regular_pairI[of "\<epsilon>" "Y" "Z" "G" "?Y'" "?Z'"] yss' zss' assms by simp + then have "-\<epsilon> \<le> ( edge_density ?Y' ?Z' G - edge_density Y Z G)" + by linarith + then have "edge_density Y Z G - \<epsilon> \<le> edge_density ?Y' ?Z' G" by linarith + then have "edge_density Y Z G - \<epsilon> \<le> (card (all_edges_between ?Y' ?Z' G)/(card ?Y' * card ?Z'))" using edge_density_def by simp + then have "(card ?Y' * card ?Z') * (edge_density Y Z G - \<epsilon>) \<le> (card (all_edges_between ?Y' ?Z' G))" + by (metis abs_of_nat division_ring_divide_zero le_divide_eq mult_of_nat_commute of_nat_0_le_iff times_divide_eq_right zero_less_abs_iff) + then show ?thesis + by (metis (no_types, lifting) ab_semigroup_mult_class.mult_ac(1) mult_of_nat_commute of_nat_mult) +qed + + +lemma edge_density_implies_edge_exists: + fixes \<epsilon>::real + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "\<epsilon> > 0" and "uwellformed G" + assumes "edge_density X Y G \<ge> \<epsilon>" + obtains e where "e \<in> all_edges_between X Y G" +proof - + have "edge_density X Y G = card (all_edges_between X Y G) / (card X * card Y)" by (simp add: edge_density_def) + then have "card (all_edges_between X Y G) \<noteq> 0" + using assms divide_eq_0_iff by fastforce + thus ?thesis + by (metis card.empty empty_subsetI subsetI subset_antisym that) +qed + +text\<open>We are now ready to show the Triangle Counting Lemma (Theorem 3.13 in Zhao's notes):\<close> + +theorem triangle_counting_lemma: + fixes \<epsilon>::real + assumes xss: "X \<subseteq> uverts G" and yss: "Y \<subseteq> uverts G" and zss: "Z \<subseteq> uverts G" and en0: "\<epsilon> > 0" + and finG: "finite (uverts G)" and wf: "uwellformed G" + and rp1: "regular_pair X Y G \<epsilon> " and rp2: "regular_pair Y Z G \<epsilon>" and rp3: "regular_pair X Z G \<epsilon>" + and ed1: "edge_density X Y G \<ge> 2*\<epsilon>" and ed2: "edge_density X Z G \<ge> 2*\<epsilon>" and ed3: "edge_density Y Z G \<ge> 2*\<epsilon>" + shows "card (triangle_triples X Y Z G) + \<ge> (1-2*\<epsilon>)*((edge_density X Y G) - \<epsilon>)*((edge_density X Z G) - \<epsilon>) *((edge_density Y Z G) - \<epsilon>)* + (card X)*(card Y)* (card Z)" +proof - + let ?T_all = "{(x,y,z) \<in> X \<times> Y \<times> Z. (triangle_in_graph x y z G)}" + define XF where "XF \<equiv> \<lambda>Y. {x \<in> X. card(neighbors_ss x Y G) < ((edge_density X Y G) - \<epsilon>) * card Y}" + have fin: "finite X" "finite Y" "finite Z" using finG rev_finite_subset xss yss zss by auto + have "card X > 0" + using card_0_eq ed1 edge_density_def en0 fin(1) by fastforce + have ebound: "\<epsilon> \<le> 1/2" + using ed1 edge_density_le1 fin + by (metis le_divide_eq_numeral1(1) mult.commute order_trans) + then have ebound2: "1 - 2*\<epsilon> \<ge> 0" + by linarith + + text\<open> Obtain a subset of @{term X} where all elements meet minimum numbers for neighborhood size +in @{term Y} and @{term Z}.\<close> + + define X2 where "X2 \<equiv> X - (XF Y \<union> XF Z)" + have xss: "X2 \<subseteq> X" + by (simp add: X2_def) + have finx2: "finite X2" + by (simp add: X2_def fin) + + text \<open>Reasoning on the minimum size of @{term X2}:\<close> + + have part1: "(XF Y \<union> XF Z) \<union> X2 = X" + by (auto simp: XF_def X2_def) + have card_XFY: "card (XF Y) < \<epsilon> * card X" + using regular_pair_neighbor_bound assms \<open>card X > 0\<close> by (simp add: XF_def) + + text\<open> We now repeat the same argument as above to the regular pair @{term X} @{term Z} in @{term G}.\<close> + + have card_XFZ: "card (XF Z) < \<epsilon> * card X" + using regular_pair_neighbor_bound assms \<open>card X > 0\<close> by (simp add: XF_def) + have "card (XF Y \<union> XF Z) \<le> 2 * \<epsilon> * (card X)" + by (smt (verit) card_XFY card_XFZ card_Un_le comm_semiring_class.distrib of_nat_add of_nat_mono) + then have minx2help: "card X2 \<ge> card X - 2 * \<epsilon> * card X" using part1 + by (smt (verit, del_insts) card_Un_le of_nat_add of_nat_mono) + then have minx2: "card X2 \<ge> (1 - 2 * \<epsilon>) * card X" + by (metis mult.commute mult_cancel_left2 right_diff_distrib) + have edmultbound: "((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z) \<ge> 0" + using ed3 ed1 ed2 assms(4) by auto + + text \<open>Reasoning on the minimum number of edges between neighborhoods of @{term X} in @{term Y} +and @{term Z}.\<close> + + have edyzgt0: "((edge_density Y Z G) - \<epsilon>) > 0" + and edxygt0: "((edge_density X Y G) - \<epsilon>) > 0" using ed1 ed3 \<open>\<epsilon> > 0\<close> by linarith+ + have cardnzgt0: "card (neighbors_ss x Z G) \<ge> 0" and cardnygt0: "card (neighbors_ss x Y G) \<ge> 0" + if "x \<in> X2" for x + by auto + have card_y_bound: "\<And>x. x \<in> X2 \<Longrightarrow> (card (neighbors_ss x Y G)) \<ge> (edge_density X Y G - \<epsilon>) * (card Y)" + by (auto simp: XF_def X2_def) + have card_z_bound: "\<And>x. x \<in> X2 \<Longrightarrow> (card (neighbors_ss x Z G)) \<ge> (edge_density X Z G - \<epsilon>) * (card Z)" + by (auto simp: XF_def X2_def) + have card_y_bound': + "(\<Sum>x\<in> X2. ((edge_density Y Z G) - \<epsilon>) * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G))) \<ge> + (\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (card (neighbors_ss x Z G)))" + by (rule sum_mono) (smt (verit, best) Groups.mult_ac(3) card_y_bound edyzgt0 mult.commute mult_right_mono of_nat_0_le_iff) + have x2_card: "\<And>x. x \<in> X2 \<Longrightarrow> ((edge_density Y Z G) - \<epsilon>) * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G)) + \<le> card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G)" + by (meson all_edges_btwn_neighbour_sets_lower_bound assms(1) card_y_bound card_z_bound ed1 ed2 ed3 en0 fin finG local.wf rp1 rp2 rp3 subsetD xss yss zss) + have card_z_bound': + "(\<Sum>x\<in> X2. ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (card (neighbors_ss x Z G))) \<ge> + (\<Sum>x\<in> X2. ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z))" + using card_z_bound mult_left_mono edxygt0 edyzgt0 by (fastforce intro!: sum_mono) + have eq_set: "\<And> x. x \<in> X \<Longrightarrow> card {(y, z) . y \<in> Y \<and> z \<in> Z \<and> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G } = +card {(y, z) . y \<in> (neighbors_ss x Y G) \<and> z \<in> (neighbors_ss x Z G) \<and> {y, z} \<in> uedges G }" + by (metis (no_types, lifting) mem_Collect_eq neighbors_ss_def) + have "card ?T_all = (\<Sum>x\<in> X . card {(y,z) \<in> Y \<times> Z. triangle_in_graph x y z G})" + using triple_sigma_rewrite_card fin by force + also have "\<dots> = (\<Sum>x\<in> X . card {(y,z) \<in> Y \<times> Z. {y,z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G })" + using triangle_in_graph_edge_point assms by auto + also have "\<dots> = (\<Sum>x\<in> X . card {(y, z). y \<in> Y \<and> z \<in> Z \<and> {y, z} \<in> uedges G \<and> neighbor_in_graph x y G \<and> neighbor_in_graph x z G })" + by simp + finally have "card ?T_all = (\<Sum>x\<in> X . card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G))" + using eq_set by (auto simp: all_edges_between_def) + then have l: "card ?T_all \<ge> (\<Sum>x\<in> X2 . card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G))" + by (simp add: fin xss sum_mono2) + have "(\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G))) \<le> + (\<Sum>x\<in> X2. real (card (all_edges_between (neighbors_ss x Y G) (neighbors_ss x Z G) G)))" + by (meson x2_card finx2 sum_mono) + then have "card ?T_all \<ge> (\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (card (neighbors_ss x Y G)) * (card (neighbors_ss x Z G)))" + using l of_nat_le_iff [symmetric, where 'a=real] by force + then have "card ?T_all \<ge> (\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (card (neighbors_ss x Z G)))" + using card_y_bound' by simp + then have tall_gt: "card ?T_all \<ge> (\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z))" + using card_z_bound' by simp + have "(\<Sum>x\<in> X2 . ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z)) = + card X2 * ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z)" + by simp + then have "of_real (card ?T_all) \<ge> card X2 * ((edge_density Y Z G) - \<epsilon>) * (edge_density X Y G - \<epsilon>)* + (card Y) * (edge_density X Z G - \<epsilon>)* (card Z)" + using tall_gt + by force + then have "of_real (card ?T_all) \<ge> ((1 - 2 * \<epsilon>) * card X) * ((edge_density Y Z G) - \<epsilon>) * + (edge_density X Y G - \<epsilon>)* (card Y) * (edge_density X Z G - \<epsilon>)* (card Z)" + using minx2 edmultbound dual_order.trans mult.commute ordered_comm_semiring_class.comm_mult_left_mono + by (smt (verit, ccfv_SIG) assms(4) ed1 ed2 mult_cancel_right mult_less_cancel_right +mult_pos_neg2 of_nat_0_eq_iff of_nat_le_0_iff) + then show ?thesis by (simp add: triangle_triples_def mult.commute mult.left_commute) +qed + +definition regular_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool" + where "regular_graph P G \<epsilon> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> regular_pair R S G \<epsilon>" for \<epsilon>::real + +text \<open>A minimum density, but empty edge sets are excluded.\<close> + +definition edge_dense :: "nat set \<Rightarrow> nat set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool" + where "edge_dense X Y G \<epsilon> \<equiv> all_edges_between X Y G = {} \<or> edge_density X Y G \<ge> \<epsilon>" + +definition dense_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool" + where "dense_graph P G \<epsilon> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> edge_dense R S G \<epsilon>" for \<epsilon>::real + +definition decent :: "nat set \<Rightarrow> nat set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool" + where "decent X Y G \<eta> \<equiv> all_edges_between X Y G = {} \<or> (real (card X) \<ge> \<eta> \<and> real (card Y) \<ge> \<eta>)" + +definition decent_graph :: "uvert set set \<Rightarrow> ugraph \<Rightarrow> real \<Rightarrow> bool" + where "decent_graph P G \<eta> \<equiv> \<forall>R S. R\<in>P \<longrightarrow> S\<in>P \<longrightarrow> decent R S G \<eta>" for \<epsilon>::real + +text \<open>The proof of the triangle counting lemma requires ordered triples. For each unordered triple +there are six permutations, hence the factor of $1/6$ here. This is mentioned briefly on pg 57 of +Zhao's notes towards the end of the proof.\<close> + +lemma card_convert_triangle_rep: + fixes G :: "ugraph" + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" and fin: "finite (uverts G)" +and wf: "uwellformed G" + shows "card (triangle_set G) \<ge> 1/6 * card {(x, y, z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)}" + (is "_ \<ge> 1/6 * card ?TT") +proof - + define tofl where "tofl \<equiv> \<lambda>l::nat list. (hd l, hd(tl l), hd(tl(tl l)))" + have in_tofl: "(x, y, z) \<in> tofl ` permutations_of_set {x,y,z}" if "x\<noteq>y" "y\<noteq>z" "x\<noteq>z" for x y z + proof - + have "distinct[x,y,z]" + using that by simp + then show ?thesis + unfolding tofl_def image_iff + by (smt (verit, best) list.sel(1) list.sel(3) list.simps(15) permutations_of_setI set_empty) + qed + have "?TT \<subseteq> {(x, y, z). (triangle_in_graph x y z G)}" + by auto + also have "\<dots> \<subseteq> (\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)" + proof (clarsimp simp: triangle_set_def) + fix u v w + assume t: "triangle_in_graph u v w G" + then have "(u, v, w) \<in> tofl ` permutations_of_set {u,v,w}" + by (metis in_tofl local.wf triangle_commu1 triangle_vertices_distinct1 triangle_vertices_distinct2) + with t show "\<exists>t. (\<exists>x y z. t = {x, y, z} \<and> triangle_in_graph x y z G) \<and> (u, v, w) \<in> tofl ` permutations_of_set t" + by blast + qed + finally have "?TT \<subseteq> (\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)" . + then have "card ?TT \<le> card(\<Union>t \<in> triangle_set G. tofl ` permutations_of_set t)" + by (intro card_mono finite_UN_I finite_triangle_set) (auto simp: assms) + also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. card (tofl ` permutations_of_set t))" + using card_UN_le fin finite_triangle_set local.wf by blast + also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. card (permutations_of_set t))" + by (meson card_image_le finite_permutations_of_set sum_mono) + also have "\<dots> \<le> (\<Sum>t \<in> triangle_set G. fact 3)" + apply (rule sum_mono) + by (metis card.infinite card_permutations_of_set card_triangle_3 eq_refl local.wf nat.simps(3) numeral_3_eq_3) + also have "\<dots> = 6 * card (triangle_set G)" + by (simp add: eval_nat_numeral) + finally have "card ?TT \<le> 6 * card (triangle_set G)" . + then show ?thesis + by (simp add: divide_simps) +qed + +lemma card_convert_triangle_rep_bound: + fixes G :: "ugraph" and t :: real + assumes "card {(x, y, z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)} \<ge> t" + assumes "X \<subseteq> uverts G" and "Y \<subseteq> uverts G" and "Z \<subseteq> uverts G" and fin: "finite (uverts G)" +and wf: "uwellformed G" + shows "card (triangle_set G) \<ge> 1/6 *t" +proof - + define t' where "t' \<equiv> card {(x, y, z) \<in> X \<times> Y \<times> Z . (triangle_in_graph x y z G)}" + have "t' \<ge> t" using assms t'_def by simp + then have tgt: "1/6 * t' \<ge> 1/6 * t" by simp + have "card (triangle_set G) \<ge> 1/6 *t'" using t'_def card_convert_triangle_rep assms by simp + thus ?thesis using tgt by linarith +qed + + lemma edge_density_eq0: + assumes "all_edges_between A B G = {}" and "X \<subseteq> A" "Y \<subseteq> B" + shows "edge_density X Y G = 0" +proof - + have "all_edges_between X Y G = {}" + by (metis all_edges_between_mono1 all_edges_between_mono2 assms subset_empty) + then show ?thesis + by (auto simp: edge_density_def) +qed + +text\<open>The following is the Triangle Removal Lemma (Theorem 3.15 in Zhao's notes).\<close> + +theorem triangle_removal_lemma: + fixes \<epsilon> :: real + assumes egt: "\<epsilon> > 0" + shows "\<exists>\<delta>::real > 0. \<forall>G. card(uverts G) > 0 \<longrightarrow> uwellformed G \<longrightarrow> + card (triangle_set G) \<le> \<delta> * card(uverts G) ^ 3 \<longrightarrow> + (\<exists>Gnew. triangle_free_graph Gnew \<and> uverts Gnew = uverts G \<and> (uedges Gnew \<subseteq> uedges G) \<and> + card (uedges G - uedges Gnew) \<le> \<epsilon> * (card (uverts G))\<^sup>2)" + (is "\<exists>\<delta>::real > 0. \<forall>G. _ \<longrightarrow> _ \<longrightarrow> _ \<longrightarrow> (\<exists>Gnew. ?\<Phi> G Gnew)") +proof (cases "\<epsilon> < 1") + case False + define Gnew where "Gnew \<equiv> \<lambda>G. ((uverts G), {}::uedge set)" + show ?thesis + proof (intro exI conjI strip) + fix G + assume G: "uwellformed G" "card(uverts G) > 0" + then show "triangle_free_graph (Gnew G)" "uverts (Gnew G) = uverts G" "uedges (Gnew G) \<subseteq> uedges G" + by (auto simp: Gnew_def triangle_free_graph_empty) + have "real (card (uedges G)) \<le> (card (uverts G))\<^sup>2" + by (meson G card_gt_0_iff max_edges_graph of_nat_le_iff) + also have "\<dots> \<le> \<epsilon> * (card (uverts G))\<^sup>2" + using False mult_le_cancel_right1 by fastforce + finally show "real (card (uedges G - uedges (Gnew G))) \<le> \<epsilon> * real ((card (uverts G))\<^sup>2)" + by (simp add: Gnew_def) + qed (rule zero_less_one) +next + case True + have e4gt: "\<epsilon>/4 > 0" using \<open>\<epsilon> > 0\<close> by auto + then obtain M0 where + M0: "\<And>G. card (uverts G) > 0 \<Longrightarrow> \<exists>P. regular_partition (\<epsilon>/4) G P \<and> card P \<le> M0" + and "M0>0" + by (metis Szemeredi_Regularity_Lemma le0 neq0_conv not_le not_numeral_le_zero) + define D0 where "D0 \<equiv> 1/6 *(1-(\<epsilon>/2))*((\<epsilon>/4)^3)*((\<epsilon> /(4*M0))^3)" + have "D0 > 0" + using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>M0 > 0\<close> by (simp add: D0_def zero_less_mult_iff) + then obtain \<delta>:: "real" where \<delta>: "0 < \<delta>" "\<delta> < D0" + by (meson dense) + show ?thesis + proof (rule exI, intro conjI strip) + fix G + assume "card(uverts G) > 0" and wf: "uwellformed G" + then have fin: "finite (uverts G)" + by (simp add: card_gt_0_iff) + + text\<open>Assume that, for a yet to be determined $\delta$, we have:\<close> + assume ineq: "real (card (triangle_set G)) \<le> \<delta> * card (uverts G) ^ 3" + + text\<open>Step 1: Partition: Using Szemer\'{e}di's Regularity Lemma, we get an $\epsilon/4$ partition. \<close> + + let ?n = "card (uverts G)" + have vne: "uverts G \<noteq> {}" + using \<open>0 < card (uverts G)\<close> by force + then have ngt0: "?n > 0" + by (simp add: fin card_gt_0_iff) + with M0 obtain P where M: "regular_partition (\<epsilon>/4) G P" and "card P \<le> M0" + by blast + define M where "M \<equiv> card P" + have "finite P" + by (meson M fin finite_elements regular_partition_def) + with M0 have "M > 0" + unfolding M_def + by (metis M card_gt_0_iff partition_onD1 partition_on_empty regular_partition_def vne) + let ?e4M = "\<epsilon> / (4 * real M)" + define D where "D \<equiv> 1/6 *(1-(\<epsilon>/2)) * ((\<epsilon>/4)^3) * ?e4M^3" + have "D > 0" + using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>M > 0\<close> by (simp add: D_def zero_less_mult_iff) + have "D0 \<le> D" + unfolding D0_def D_def using \<open>0 < \<epsilon>\<close> \<open>\<epsilon> < 1\<close> \<open>card P \<le> M0\<close> \<open>M > 0\<close> + by (intro mult_mono) (auto simp: frac_le M_def) + (* a reminder: as it is implied we have: *) + have fin_part: "finite_graph_partition (uverts G) P M" + using M unfolding regular_partition_def finite_graph_partition_def + by (metis M_def \<open>0 < M\<close> card_gt_0_iff) + then have fin_P: "finite R" and card_P_gt0: "card R > 0" if "R\<in>P" for R + using fin finite_graph_partition_finite finite_graph_partition_gt0 that by auto + have card_P_le: "card R \<le> ?n" if "R\<in>P" for R + using fin fin_part finite_graph_partition_le that by meson + have P_disjnt: "\<And>R S. \<lbrakk>R \<noteq> S; R \<in> P; S \<in> P\<rbrakk> \<Longrightarrow> R \<inter> S = {}" + using fin_part + by (metis disjnt_def finite_graph_partition_def insert_absorb pairwise_insert partition_on_def) + have sum_card_P: "(\<Sum>R\<in>P. card R) = ?n" + using card_finite_graph_partition fin fin_part by meson + + text\<open>Step 2. Cleaning. For each ordered pair of parts $(P_i,P_j)$, remove all edges between + $P_i$ and $P_j$ if (a) it is an irregular pair, (b) its edge density ${} < \epsilon/2$, + (c) either $P_i$ or $P_j$ is small (${}\le(\epsilon/4M)n$) + Process (a) removes at most $(\epsilon/4)n^2$ edges. + Process (b) removes at most $(\epsilon/2)n^2$ edges. + Process (c) removes at most $(\epsilon/4)n^2$ edges. + The remaining graph is triangle-free for some choice of $\delta$. + We call the graph obtained after this process @{term Gnew}. \<close> + + define edge where "edge \<equiv> \<lambda>R S. mk_uedge ` (all_edges_between R S G)" + have edge_commute: "edge R S = edge S R" for R S + by (force simp add: edge_def all_edges_between_swap [of S] split: prod.split) + have card_edge_le_card: "card (edge R S) \<le> card (all_edges_between R S G)" for R S + by (simp add: card_image_le edge_def fin finite_all_edges_between' local.wf) + have card_edge_le: "card (edge R S) \<le> card R * card S" if "R\<in>P" "S\<in>P" for R S + by (meson card_edge_le_card fin_P le_trans max_all_edges_between that) + + text \<open>Obtain the set of edges meeting condition (a).\<close> + + define irreg_pairs where "irreg_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> irregular_pair R S G (\<epsilon>/4)}" + define Ea where "Ea \<equiv> (\<Union>(R,S) \<in> irreg_pairs. edge R S)" + + text \<open>Obtain the set of edges meeting condition (b).\<close> + + define low_density_pairs + where "low_density_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> \<not> edge_dense R S G (\<epsilon>/2)}" + define Eb where "Eb \<equiv> (\<Union>(i,j) \<in> low_density_pairs. edge i j)" + + text \<open>Obtain the set of edges meeting condition (c).\<close> + + define small where "small \<equiv> \<lambda>R. R \<in> P \<and> card R \<le> ?e4M * ?n" + let ?SMALL = "Collect small" + define small_pairs where "small_pairs \<equiv> {(R,S). R \<in> P \<and> S \<in> P \<and> (small R \<or> small S)}" + define Ec where "Ec \<equiv> (\<Union>R \<in> ?SMALL. \<Union>S \<in> P. edge R S)" + have Ec_def': "Ec = (\<Union>(i,j) \<in> small_pairs. edge i j)" + by (force simp: edge_commute small_pairs_def small_def Ec_def) + have eabound: "card Ea \<le> (\<epsilon>/4) * ?n^2" \<comment>\<open>Count the edge bound for @{term Ea}\<close> + proof - + have \<section>: "\<And>R S. \<lbrakk>R \<in> P; S \<in> P\<rbrakk> \<Longrightarrow> card (edge R S) \<le> card R * card S" + unfolding edge_def + by (meson card_image_le fin_P finite_all_edges_between max_all_edges_between order_trans) + have "irreg_pairs \<subseteq> P \<times> P" + by (auto simp: irreg_pairs_def) + then have "finite irreg_pairs" + by (meson \<open>finite P\<close> finite_SigmaI finite_subset) + have "card Ea \<le> (\<Sum>(R,S)\<in>irreg_pairs. card (edge R S))" + by (simp add: Ea_def card_UN_le [OF \<open>finite irreg_pairs\<close>] case_prod_unfold) + also have "\<dots> \<le> (\<Sum>(R,S) \<in> {(R,S). R\<in>P \<and> S\<in>P \<and> irregular_pair R S G (\<epsilon>/4)}. card R * card S)" + unfolding irreg_pairs_def using \<section> by (force intro: sum_mono) + also have "\<dots> = (\<Sum>(R,S) \<in> irregular_set (\<epsilon>/4) G P. card R * card S)" + by (simp add: irregular_set_def) + finally have "card Ea \<le> (\<Sum>(R,S) \<in> irregular_set (\<epsilon>/4) G P. card R * card S)" . + with M show ?thesis + unfolding regular_partition_def by linarith + qed + have ebbound: "card Eb \<le> (\<epsilon>/2) * (?n^2)" \<comment>\<open>Count the edge bound for @{term Eb}.\<close> + proof - + have subs: "low_density_pairs \<subseteq> P \<times> P" + by (auto simp: low_density_pairs_def) + then have "finite low_density_pairs" + by (metis \<open>finite P\<close> finite_SigmaI finite_subset) + have "real (card Eb) \<le> (\<Sum>(i,j)\<in>low_density_pairs. real (card (edge i j)))" + unfolding Eb_def + by (smt (verit, ccfv_SIG) \<open>finite low_density_pairs\<close> card_UN_le of_nat_mono of_nat_sum + case_prod_unfold sum_mono) + also have "\<dots> \<le> (\<Sum>(R,S)\<in>low_density_pairs. \<epsilon>/2 * card R * card S)" + apply (rule sum_mono) + apply(auto simp add: divide_simps card_P_gt0 low_density_pairs_def edge_density_def + edge_dense_def) + by (smt (verit, best) card_edge_le_card of_nat_le_iff mult.assoc) + also have "\<dots> \<le> (\<Sum>(R,S)\<in>P \<times> P. \<epsilon>/2 * card R * card S)" + using subs \<open>\<epsilon> > 0\<close> by (intro sum_mono2) (auto simp: \<open>finite P\<close>) + also have "\<dots> = \<epsilon>/2 * (\<Sum>(R,S)\<in>P \<times> P. card R * card S)" + by (simp add: sum_distrib_left case_prod_unfold mult_ac) + also have "\<dots> \<le> (\<epsilon>/2) * (?n^2)" + using \<open>\<epsilon>>0\<close> sum_prod_le_prod_sum + by (simp add: power2_eq_square sum_product flip: sum.cartesian_product sum_card_P) + finally show ?thesis . + qed + have ecbound: "card Ec \<le> (\<epsilon>/4) * (?n^2)" \<comment>\<open>Count the edge bound for @{term Ec}.\<close> + proof - + have edge_bound: "(card (edge R S)) \<le> ?e4M * ?n^2" + if "S \<in> P" "small R" for R S + proof - + have "real (card R) \<le> \<epsilon> * ?n / (4 * real M)" + using that by (simp add: small_def) + with card_P_le [OF \<open>S\<in>P\<close>] + have *: "real (card R) * real (card S) \<le> \<epsilon> * card (uverts G) / (4 * real M) * ?n" + by (meson mult_mono of_nat_0_le_iff of_nat_mono order.trans) + also have "\<dots> = ?e4M * ?n^2" + by (simp add: power2_eq_square) + finally show ?thesis + by (smt (verit) card_edge_le of_nat_mono of_nat_mult small_def that) + qed + have subs: "?SMALL \<subseteq> P" + by (auto simp: small_def) + then obtain card_sp: "card (?SMALL) \<le> M" and "finite ?SMALL" + using M_def \<open>finite P\<close> card_mono by (metis finite_subset) + have "real (card Ec) \<le> (\<Sum>R \<in> ?SMALL. real (card (\<Union>S \<in> P. edge R S)))" + unfolding Ec_def + by (smt (verit, ccfv_SIG) \<open>finite ?SMALL\<close> card_UN_le of_nat_mono of_nat_sum case_prod_unfold sum_mono) + also have "\<dots> \<le> (\<Sum>R \<in> ?SMALL. ?e4M * ?n^2)" + proof (intro sum_mono) + fix R assume i: "R \<in> Collect small" + then have "R\<in>P" and card_Pi: "card R \<le> ?e4M * ?n" + by (auto simp: small_def) + let ?UE = "\<Union>(edge R ` (P))" + have *: "real (card ?UE) \<le> real (card R * ?n)" + proof - + have "?UE \<subseteq> mk_uedge ` (all_edges_between R (uverts G) G)" + apply (simp add: edge_def UN_subset_iff Ball_def) + by (meson all_edges_between_mono2 fin_part finite_graph_partition_subset image_mono) + then have "card ?UE \<le> card (all_edges_between R (uverts G) G)" + by (meson card_image_le card_mono fin finite_all_edges_between' finite_imageI wf le_trans) + then show ?thesis + by (meson of_nat_mono fin fin_P max_all_edges_between order.trans \<open>R\<in>P\<close>) + qed + also have "\<dots> \<le> ?e4M * real (?n\<^sup>2)" + using card_Pi \<open>M > 0\<close> \<open>?n > 0\<close> by (force simp add: divide_simps power2_eq_square) + finally show "real (card ?UE) \<le> ?e4M * real (?n\<^sup>2)" . + qed + also have "\<dots> \<le> card ?SMALL * (?e4M * ?n^2)" + by simp + also have "\<dots> \<le> M * (?e4M * ?n^2)" + using egt by (intro mult_right_mono) (auto simp add: card_sp) + also have "\<dots> \<le> (\<epsilon>/4) * (?n^2)" + using \<open>M > 0\<close> by simp + finally show ?thesis . + qed + \<comment>\<open>total count\<close> + have prev1: "card (Ea \<union> Eb \<union> Ec) \<le> card (Ea \<union> Eb) + card Ec" by (simp add: card_Un_le) + also have "\<dots> \<le> card Ea + card Eb + card Ec" by (simp add: card_Un_le) + also have prev: "\<dots> \<le> (\<epsilon>/4)*(?n^2) + (\<epsilon>/2)*(?n^2) + (\<epsilon>/4)*(?n^2)" + using eabound ebbound ecbound by linarith + finally have cutedgesbound: "card (Ea \<union> Eb \<union> Ec) \<le> \<epsilon> * (?n^2)" by simp + + define Gnew where "Gnew \<equiv> (uverts G, uedges G - (Ea \<union> Eb \<union> Ec))" + show "\<exists>Gnew. ?\<Phi> G Gnew" + proof (intro exI conjI) + show verts: "uverts Gnew = uverts G" by (simp add: Gnew_def) + have allij: "\<And>R S. edge R S \<subseteq> uedges G" + using all_edges_between_ss_uedges edge_def by presburger + then have eae: "Ea \<subseteq> uedges G" by (auto simp: Ea_def) + have eab: "Eb \<subseteq> uedges G" using allij by (auto simp: Eb_def) + have "Ec \<subseteq> uedges G" using allij by (auto simp: Ec_def) + then have diffedges: "(Ea \<union> Eb \<union> Ec) \<subseteq> uedges G" + using eae eab by auto + then show edges: "uedges Gnew \<subseteq> uedges G" + by (simp add: Gnew_def) + then have "uedges G - (uedges Gnew) = uedges G \<inter> (Ea \<union> Eb \<union> Ec) " + by (simp add: Gnew_def Diff_Diff_Int) + then have "uedges G - (uedges Gnew) = (Ea \<union> Eb \<union> Ec)" using diffedges + by (simp add: Int_absorb1) + then have cardbound: "card (uedges G - uedges Gnew) \<le> \<epsilon> * (?n^2)" + using cutedgesbound by simp + have graph_partition_new: "finite_graph_partition (uverts Gnew) P M" using verts + by (simp add: fin_part) + have new_wf: "uwellformed Gnew" using subgraph_edge_wf verts edges wf by simp + have new_fin: "finite (uverts Gnew)" using verts fin by simp + + text\<open> The notes by Bell and Grodzicki are quite useful for understanding the lines below. + See pg 4 in the middle after the summary of the min edge counts.\<close> + + have irreg_pairs_swap: "(R,S) \<in> irreg_pairs \<longleftrightarrow> (S, R) \<in> irreg_pairs" for R S + by (auto simp: irreg_pairs_def regular_pair_commute) + have low_density_pairs_swap: "(R,S) \<in> low_density_pairs \<longleftrightarrow> (S,R) \<in> low_density_pairs" for R S + by (simp add: low_density_pairs_def edge_density_commute edge_dense_def) + (use all_edges_between_swap in blast) + have small_pairs_swap: "(R,S) \<in> small_pairs \<longleftrightarrow> (S,R) \<in> small_pairs" for R S + by (auto simp: small_pairs_def) + + have all_edges_if: + "all_edges_between R S Gnew + = (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then {} + else all_edges_between R S G)" + (is "?lhs = ?rhs") + if ij: "R \<in> P" "S \<in> P" for R S + proof + show "?lhs \<subseteq> ?rhs" + using that fin_part unfolding Gnew_def Ea_def Eb_def Ec_def' + apply (simp add: all_edges_between_E_diff all_edges_between_E_Un all_edges_between_E_UN) + apply (auto simp: edge_def in_mk_uedge_img_iff all_edges_between_def) + done + next + have Ea: "all_edges_between R S (V, Ea) = {}" + if "(R,S) \<notin> irreg_pairs" for V + using ij that P_disjnt + by (auto simp: Ea_def doubleton_eq_iff edge_def all_edges_between_def irreg_pairs_def; + metis regular_pair_commute disjoint_iff_not_equal) + have Eb: "all_edges_between R S (V, Eb) = {}" + if "(R,S) \<notin> low_density_pairs" for V + using ij that + apply (auto simp: Eb_def edge_def all_edges_between_def low_density_pairs_def edge_dense_def) + apply metis + by (metis IntI P_disjnt doubleton_eq_iff edge_density_commute equals0D) + have Ec: "all_edges_between R S (V, Ec) = {}" + if "(R,S) \<notin> small_pairs" for V + using ij that + by (auto simp: Ec_def' doubleton_eq_iff edge_def all_edges_between_def small_pairs_def; + metis P_disjnt disjoint_iff) + show "?rhs \<subseteq> ?lhs" + by (auto simp add: Gnew_def Ea Eb Ec all_edges_between_E_diff all_edges_between_E_Un) + qed + + have rp: "regular_pair R S Gnew (\<epsilon>/4)" if ij: "R \<in> P" "S \<in> P" for R S + proof (cases "(R,S) \<in> irreg_pairs") + case False + have ed: "edge_density X Y Gnew = + (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then 0 + else edge_density X Y G)" + if "X \<subseteq> R" "Y \<subseteq> S" for X Y + using all_edges_if that ij False by (smt (verit) all_edges_preserved edge_density_eq0 +edge_density_def) + show ?thesis + using that False \<open>\<epsilon> > 0\<close> + by (auto simp add: irreg_pairs_def regular_pair_def less_le ed) + next + case True + then have ed: "edge_density X Y Gnew = 0" if "X \<subseteq> R" "Y \<subseteq> S" for X Y + by (meson edge_density_eq0 all_edges_if that \<open>R \<in> P\<close> \<open>S \<in> P\<close> UnCI) + with egt that show ?thesis + by (auto simp: regular_pair_def ed) + qed + then have reg_pairs: "regular_graph P Gnew (\<epsilon>/4)" + by (meson regular_graph_def) + + have "edge_dense R S Gnew (\<epsilon>/2)" + if "R \<in> P" "S \<in> P" for R S + proof (cases "(R,S) \<in> low_density_pairs") + case False + have ed: "edge_density R S Gnew = + (if (R,S) \<in> irreg_pairs \<union> low_density_pairs \<union> small_pairs then 0 + else edge_density R S G)" + using all_edges_if that that by (simp add: edge_density_def) + with that \<open>\<epsilon> > 0\<close> False show ?thesis + by (auto simp: low_density_pairs_def edge_dense_def all_edges_if) + next + case True + then have "edge_density R S Gnew = 0" + by (simp add: all_edges_if edge_density_def that) + with \<open>\<epsilon> > 0\<close> that show ?thesis + by (simp add: True all_edges_if edge_dense_def) + qed + then have density_bound: "dense_graph P Gnew (\<epsilon>/2)" + by (meson dense_graph_def) + + have min_subset_size: "decent_graph P Gnew (?e4M * ?n)" + using \<open>\<epsilon> > 0\<close> + by (auto simp: decent_graph_def small_pairs_def small_def decent_def all_edges_if) + show "triangle_free_graph Gnew" + proof (rule ccontr) + assume non: "\<not>?thesis" + then obtain x y z where trig_ex: "triangle_in_graph x y z Gnew" + using triangle_free_graph_def non by auto + then have xin: "x \<in> (uverts Gnew)" and yin: "y \<in> (uverts Gnew)" and zin: "z \<in> (uverts Gnew)" + using triangle_in_graph_verts new_wf by auto + then obtain R where xinp: "x \<in> R" and ilt: "R\<in>P" + using graph_partition_new finite_graph_partition_obtain xin by metis + then obtain S where yinp: "y \<in> S" and jlt: "S\<in>P" + using graph_partition_new finite_graph_partition_obtain yin by metis + then obtain T where zinp: "z \<in> T" and klt: "T\<in>P" + using graph_partition_new finite_graph_partition_obtain zin by metis + have finitesubsets: "finite R" "finite S" "finite T" + using ilt jlt klt new_fin fin_part finite_graph_partition_finite fin by auto + have subsets: "R \<subseteq> uverts Gnew" "S \<subseteq> uverts Gnew" "T \<subseteq> uverts Gnew" + using finite_graph_partition_subset ilt jlt klt graph_partition_new by auto + have min_sizes: "card R \<ge> ?e4M*?n" "card S \<ge> ?e4M*?n" "card T \<ge> ?e4M*?n" + using trig_ex min_subset_size xinp yinp zinp ilt jlt klt + by (auto simp: triangle_in_graph_def decent_graph_def decent_def all_edges_between_def) + have min_dens: "edge_density R S Gnew \<ge> \<epsilon>/2" "edge_density R T Gnew \<ge> \<epsilon>/2" +"edge_density S T Gnew \<ge> \<epsilon>/2" + using density_bound subsets ilt jlt klt xinp yinp zinp unfolding dense_graph_def edge_dense_def + by (metis all_edges_betw_I equals0D triangle_in_graph_def trig_ex)+ + then have min_dens_diff: + "edge_density R S Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" "edge_density R T Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" +"edge_density S T Gnew - \<epsilon>/4 \<ge> \<epsilon>/4" + by auto + have mincard0: "(card R)*(card S)* (card T) \<ge> 0" by simp + have gtcube: "((edge_density R S Gnew) - \<epsilon>/4)*((edge_density R T Gnew) - \<epsilon>/4) *((edge_density S T Gnew) - \<epsilon>/4) \<ge> (\<epsilon>/4)^3" + using min_dens_diff e4gt real_mult_gt_cube by auto + then have c1: "((edge_density R S Gnew) - \<epsilon>/4)*((edge_density R T Gnew) - \<epsilon>/4) *((edge_density S T Gnew) - \<epsilon>/4) \<ge> 0" + by (smt (verit) e4gt zero_less_power) + have "?e4M * ?n \<ge> 0" + using egt by force + then have "card R * card S * card T \<ge> (?e4M * ?n)*(?e4M * ?n) * (?e4M * ?n)" + by (metis (no_types) of_nat_0_le_iff of_nat_mult min_sizes mult_mono) + then have "(card R)*(card S)* (card T) \<ge> (?e4M* ?n)^3" + by (simp add: power3_eq_cube) + then have cardgtbound:"card R * card S * card T \<ge> ?e4M^ 3 * ?n^3" + by (metis of_nat_power power_mult_distrib) + + have "(1-\<epsilon>/2) * (\<epsilon>/4)^3 * (\<epsilon>/(4*M))^3 * ?n^3 \<le> (1-\<epsilon>/2) * (\<epsilon>/4)^3 * card R * card S * card T" + using cardgtbound ordered_comm_semiring_class.comm_mult_left_mono True e4gt by fastforce + also have "... \<le> (1-2*(\<epsilon>/4)) * (edge_density R S Gnew - \<epsilon>/4)*(edge_density R T Gnew - \<epsilon>/4) * (edge_density S T Gnew - \<epsilon>/4) * card R * card S * card T" + using gtcube c1 \<open>\<epsilon> < 1\<close> mincard0 by (simp add: mult.commute mult.left_commute mult_left_mono) + also have "... \<le> card (triangle_triples R S T Gnew)" + by (smt (verit, best) e4gt ilt jlt klt min_dens_diff new_fin new_wf rp + subsets triangle_counting_lemma) + finally have "card (triangle_set Gnew) \<ge> D * ?n^3" + using card_convert_triangle_rep_bound new_wf new_fin subsets + by (auto simp: triangle_triples_def D_def) + then have g_tset_bound: "card (triangle_set G) \<ge> D * ?n^3" + using triangle_set_graph_edge_ss_bound by (smt (verit) edges fin local.wf of_nat_mono verts) + have "card (triangle_set G) > \<delta> * ?n^3" + proof - + have "?n^3 > 0" + by (simp add: \<open>uverts G \<noteq> {}\<close> card_gt_0_iff fin) + with \<delta> \<open>D0 \<le> D\<close> have "D * ?n^3 > \<delta> * ?n^3" + by force + thus "card (triangle_set G) > \<delta> * ?n ^3" + using g_tset_bound unfolding D_def by linarith + qed + thus False + using ineq by linarith + qed + show "real (card (uedges G - uedges Gnew)) \<le> \<epsilon> * real ((card (uverts G))\<^sup>2)" + using cardbound edges verts by blast + qed + qed (rule \<open>0 < \<delta>\<close>) +qed + +subsection \<open>Roth's Theorem\<close> + +text\<open>We will first need the following corollary of the Triangle Removal Lemma. +This is Corollary 3.18 in Zhao's notes:\<close> + +corollary corollary_triangle_removal: + fixes \<epsilon> :: real + assumes "0 < \<epsilon>" + shows "\<exists>N>0. \<forall>G. card(uverts G) > N \<longrightarrow> uwellformed G \<longrightarrow> unique_triangles G \<longrightarrow> + card (uedges G) \<le> \<epsilon> * (card (uverts G))\<^sup>2" +proof - + have "\<epsilon>/3 > 0" + using assms by auto + then obtain \<delta>::real where "\<delta> > 0" + and \<delta>: "\<And>G. \<lbrakk>card(uverts G) > 0; uwellformed G; + card (triangle_set G) \<le> \<delta> * card(uverts G) ^ 3\<rbrakk> \<Longrightarrow> + (\<exists>Gnew. triangle_free_graph Gnew \<and> uverts Gnew = uverts G \<and> (uedges Gnew \<subseteq> uedges G) \<and> + card (uedges G - uedges Gnew) \<le> \<epsilon>/3 * (card (uverts G))\<^sup>2)" + using triangle_removal_lemma by metis + obtain N::nat where N: "real N \<ge> 1 / (3*\<delta>)" + by (meson real_arch_simple) + show ?thesis + proof (intro exI conjI strip) + show "N > 0" + using N \<open>0 < \<delta>\<close> zero_less_iff_neq_zero by fastforce + fix G + let ?n = "card (uverts G)" + assume G_gt_N: "N < ?n" + and wf: "uwellformed G" + and uniq: "unique_triangles G" + have G_ne: "?n > 0" + using G_gt_N by linarith + obtain TF where TF: "\<And>e. e \<in> uedges G \<Longrightarrow> \<exists>x y z. TF e = {x,y,z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> TF e" + using uniq unfolding unique_triangles_def by metis + let ?TWO = "(\<lambda>t. [t]\<^bsup>2\<^esup>)" + have tri_nsets_2: "[{x,y,z}]\<^bsup>2\<^esup> = {{x,y},{y,z},{x,z}}" if "triangle_in_graph x y z G" for x y z + using that unfolding nsets_def triangle_in_graph_def card_2_iff doubleton_eq_iff + by (blast dest!: edge_vertices_not_equal [OF wf]) + have tri_nsets_3: "{{x,y},{y,z},{x,z}} \<in> [uedges G]\<^bsup>3\<^esup>" if "triangle_in_graph x y z G" for x y z + using that + by (simp add: nsets_def card_3_iff triangle_in_graph_def) (metis doubleton_eq_iff +edge_vertices_not_equal [OF wf]) + have sub: "?TWO ` triangle_set G \<subseteq> [uedges G]\<^bsup>3\<^esup>" + using tri_nsets_2 tri_nsets_3 triangle_set_def by auto + have "\<And>i. i \<in> triangle_set G \<Longrightarrow> ?TWO i \<noteq> {}" + using tri_nsets_2 triangle_set_def by auto + moreover have dfam: "disjoint_family_on ?TWO (triangle_set G)" + using sub [unfolded image_subset_iff] uniq + unfolding disjoint_family_on_def triangle_set_def nsets_def unique_triangles_def + by (smt (verit) disjoint_iff_not_equal insert_subset mem_Collect_eq mk_disjoint_insert ) + ultimately have inj: "inj_on ?TWO (triangle_set G)" + by (simp add: disjoint_family_on_iff_disjoint_image) + have \<section>: "\<exists>T\<in>triangle_set G. e \<in> [T]\<^bsup>2\<^esup>" if "e \<in> uedges G" for e + using uniq [unfolded unique_triangles_def] that local.wf + apply (simp add: triangle_set_def triangle_in_graph_def nsets_def uwellformed_def) + by (metis (mono_tags, lifting) finite.emptyI finite.insertI finite_subset) + with sub have "\<Union>(?TWO ` triangle_set G) = uedges G" + by (auto simp: image_subset_iff nsets_def) + then have "card (\<Union>(?TWO ` triangle_set G)) = card (uedges G)" + by simp + moreover have "card (\<Union>(?TWO ` triangle_set G)) = 3 * card (triangle_set G)" + proof (subst card_UN_disjoint' [OF dfam]) + show "finite ([i]\<^bsup>2\<^esup>)" if "i \<in> triangle_set G" for i + using that tri_nsets_2 triangle_set_def by fastforce + show "finite (triangle_set G)" + by (meson G_ne card_gt_0_iff local.wf triangle_set_finite) + have "card ([i]\<^bsup>2\<^esup>) = 3" if "i \<in> triangle_set G" for i + using that wf + unfolding triangle_set_def triangle_in_graph_def uwellformed_def + by (smt (z3) image_subset_iff mem_Collect_eq nsets_def sub that) + then show "(\<Sum>i\<in>triangle_set G. card ([i]\<^bsup>2\<^esup>)) = 3 * card (triangle_set G)" + by simp + qed + ultimately have A: "3 * card (triangle_set G) = card (uedges G)" + by auto + have "card (uedges G) \<le> card (all_edges(uverts G))" + by (meson G_ne all_edges_finite card_gt_0_iff card_mono local.wf wellformed_all_edges) + also have "\<dots> = card (uverts G) choose 2" + by (metis G_ne card_all_edges card_eq_0_iff not_less0) + also have "\<dots> = card (uverts G) * (card (uverts G) - 1) div 2" + by (meson n_choose_2_nat) + also have "\<dots> < (card (uverts G))\<^sup>2" + by (simp add: G_ne less_imp_diff_less less_mult_imp_div_less power2_eq_square) + finally have B: "card (uedges G) < (card (uverts G))\<^sup>2" . + + have "card (triangle_set G) \<le> (card (uverts G))\<^sup>2 / 3" + using A B by linarith + also have "\<dots> \<le> \<delta> * card(uverts G) ^ 3" + proof - + have "1 \<le> 3 * \<delta> * N" + using N \<open>\<delta> > 0\<close> by (simp add: field_simps) + also have "\<dots> \<le> 3 * \<delta> * ?n" + using G_gt_N \<open>0 < \<delta>\<close> by force + finally have "1 * ?n^2 \<le> (3 * \<delta> * ?n) * ?n^2" + by (simp add: G_ne) + then show ?thesis + by (simp add: eval_nat_numeral mult_ac) + qed + finally have "card (triangle_set G) \<le> \<delta> * ?n ^ 3" . + then obtain Gnew where Gnew: "triangle_free_graph Gnew" "uverts Gnew = uverts G" + "uedges Gnew \<subseteq> uedges G" and card_edge_diff: "card (uedges G - uedges Gnew) \<le> \<epsilon>/3 * ?n\<^sup>2" + using G_ne \<delta> local.wf by meson + + text\<open>Deleting an edge removes at most one triangle from the graph by assumption, + so the number of edges removed in this process is at least the number of triangles.\<close> + + have False + if non: "\<And>e. e \<in> uedges G - uedges Gnew \<Longrightarrow> {x,y,z} \<noteq> TF e" + and tri: "triangle_in_graph x y z G" for x y z + proof - + have "\<not> triangle_in_graph x y z Gnew" + using Gnew triangle_free_graph_def by blast + with tri obtain e where eG: "e \<in> uedges G - uedges Gnew" and esub: "e \<subseteq> {x,y,z}" + using insert_commute triangle_in_graph_def by auto + then show False + by (metis DiffD1 TF tri uniq unique_triangles_def non [OF eG]) + qed + then have "triangle_set G \<subseteq> TF ` (uedges G - uedges Gnew)" + unfolding triangle_set_def by blast + moreover have "finite (uedges G - uedges Gnew)" + by (meson G_ne card_gt_0_iff finite_Diff finite_graph_def wf wellformed_finite) + ultimately have "card (triangle_set G) \<le> card (uedges G - uedges Gnew)" + by (meson surj_card_le) + then show "card (uedges G) \<le> \<epsilon> * ?n\<^sup>2" + using A card_edge_diff by linarith + qed +qed + +text\<open>We are now ready to proceed to the proof of Roth's Theorem for Arithmetic Progressions. \<close> + +definition progression3 :: "'a::comm_monoid_add \<Rightarrow> 'a \<Rightarrow> 'a set" + where "progression3 k d \<equiv> {k, k+d, k+d+d}" + +lemma p3_int_iff: "progression3 (int k) (int d) \<subseteq> int ` A \<longleftrightarrow> progression3 k d \<subseteq> A" + apply (simp add: progression3_def image_iff) + by (smt (verit, best) int_plus of_nat_eq_iff) + +text\<open>We assume that a set of naturals $A \subseteq \{...<N \}$ does not have any arithmetic progression. +We will then show that @{term A} is of cardinality $o(N)$.\<close> + +lemma RothArithmeticProgressions_aux: + fixes \<epsilon>::real + assumes "\<epsilon> > 0" + obtains X where "\<forall>N \<ge> X. \<forall>A \<subseteq> {..<N}. (\<nexists>k d. d>0 \<and> progression3 k d \<subseteq> A) \<longrightarrow> card A < \<epsilon> * real N" +proof - + obtain X where "X>0" + and X: "\<And>G. \<lbrakk>card(uverts G) > X; uwellformed G; unique_triangles G\<rbrakk> + \<Longrightarrow> card (uedges G) \<le> \<epsilon>/12 * (card (uverts G))\<^sup>2" + by (metis assms corollary_triangle_removal less_divide_eq_numeral1(1) mult_eq_0_iff) + show thesis + proof (intro strip that) + fix N A + assume "X \<le> N" and A: "A \<subseteq> {..<N}" + and non: "\<nexists>k d. 0 < d \<and> progression3 k d \<subseteq> A" + then have "N > 0" using \<open>0 < X\<close> by linarith + define M where "M \<equiv> Suc (2*N)" + have M_mod_bound[simp]: "x mod M < M" for x + by (simp add: M_def) + have "odd M" "M>0" "N<M" by (auto simp: M_def) + have "coprime M (Suc N)" + unfolding M_def + by (metis add.commute coprime_Suc_right_nat coprime_mult_right_iff mult_2 nat_arith.suc1) + then have cop: "coprime M (1 + int N)" + by (metis coprime_int_iff of_nat_Suc) + have A_sub_M: "int ` A \<subseteq> {..<M}" + using A by (force simp: M_def) + have non_img_A: "\<nexists>k d. d > 0 \<and> progression3 k d \<subseteq> int ` A" + by (metis p3_int_iff non pos_int_cases zero_le_imp_eq_int imageE insert_subset of_nat_0_le_iff +progression3_def) + + text\<open>Construct a tripartite graph @{term G} whose three parts are copies of @{text"\<int>/M\<int>"}.\<close> + + define part_of where "part_of \<equiv> \<lambda>\<xi>. (\<lambda>i. prod_encode (\<xi>,i)) ` {..<M}" + define label_of_part where "label_of_part \<equiv> \<lambda>p. fst (prod_decode p)" + define from_part where "from_part \<equiv> \<lambda>p. snd (prod_decode p)" + have enc_iff [simp]: "prod_encode (a,i) \<in> part_of a' \<longleftrightarrow> a'=a \<and> i<M" for a a' i + using \<open>0 < M\<close> by (clarsimp simp: part_of_def image_iff Bex_def) presburger + have part_of_M: "p \<in> part_of a \<Longrightarrow> from_part p < M" for a p + using from_part_def part_of_def by fastforce + have disjnt_part_of: "a \<noteq> b \<Longrightarrow> disjnt (part_of a) (part_of b)" for a b + by (auto simp: part_of_def disjnt_iff) + have from_enc [simp]: "from_part (prod_encode (a,i)) = i" for a i + by (simp add: from_part_def) + have finpart [iff]: "finite (part_of a)" for a + by (simp add: part_of_def \<open>0 < M\<close>) + have cardpart [simp]: "card (part_of a) = M" for a + using \<open>0 < M\<close> + by (simp add: part_of_def eq_nat_nat_iff inj_on_def card_image) + let ?X = "part_of 0" + let ?Y = "part_of (Suc 0)" + let ?Z = "part_of (Suc (Suc 0))" + define diff where "diff \<equiv> \<lambda>a b. (int a - int b) mod (int M)" + have inj_on_diff: "inj_on (\<lambda>x. diff x a) {..<M}" for a + apply (clarsimp simp: diff_def inj_on_def) + by (metis diff_add_cancel mod_add_left_eq mod_less nat_int of_nat_mod) + have eq_mod_M: "(x - y) mod int M = (x' - y) mod int M \<Longrightarrow> x mod int M = x' mod int M" for x x' y + by (simp add: mod_eq_dvd_iff) + + have diff_invert: "diff y x = int a \<longleftrightarrow> y = (x + a) mod M" if "y < M" "a\<in>A" for x y a + proof - + have "a < M" + using A \<open>N < M\<close> that by auto + show ?thesis + proof + assume "diff y x = int a" + with that \<open>a<M\<close> have "int y = int (x+a) mod int M" + unfolding diff_def by (smt (verit, ccfv_SIG) eq_mod_M mod_less of_nat_add zmod_int) + with that show "y = (x + a) mod M" + by (metis nat_int zmod_int) + qed (simp add: \<open>a < M\<close> diff_def mod_diff_left_eq zmod_int) + qed + + define diff2 where "diff2 \<equiv> \<lambda>a b. ((int a - int b) * int(Suc N)) mod (int M)" + have inj_on_diff2: "inj_on (\<lambda>x. diff2 x a) {..<M}" for a + apply (clarsimp simp: diff2_def inj_on_def) + by (metis eq_mod_M mult_mod_cancel_right [OF _ cop] int_int_eq mod_less zmod_int) + have [simp]: "(1 + int N) mod int M = 1 + int N" + using M_def \<open>0 < N\<close> by auto + have diff2_by2: "(diff2 a b * 2) mod M = diff a b" for a b + proof - + have "int M dvd ((int a - int b) * int M)" + by simp + then have "int M dvd ((int a - int b) * int (Suc N) * 2 - (int a - int b))" + by (auto simp: M_def algebra_simps) + then show ?thesis + by (metis diff2_def diff_def mod_eq_dvd_iff mod_mult_left_eq) + qed + have diff2_invert: "diff2 (((x + a) mod M + a) mod M) x = int a" if "a\<in>A" for x a + proof - + have 1: "((x + a) mod M + a) mod M = (x + 2*a) mod M" + by (metis group_cancel.add1 mod_add_left_eq mult_2) + have "(int ((x + 2*a) mod M) - int x) * (1 + int N) mod int M + = (int (x + 2*a) - int x) * (1 + int N) mod int M" + by (metis mod_diff_left_eq mod_mult_cong of_nat_mod) + also have "\<dots> = int (a * (Suc M)) mod int M" + by (simp add: algebra_simps M_def) + also have "\<dots> = int a mod int M" + by simp + also have "\<dots> = int a" + using A M_def subsetD that by auto + finally show ?thesis + using that by (auto simp: 1 diff2_def) + qed + + define Edges where "Edges \<equiv> \<lambda>X Y df. {{x,y}| x y. x \<in> X \<and> y \<in> Y \<and> df(from_part y) (from_part x) \<in> int ` A}" + have Edges_subset: "Edges X Y df \<subseteq> Pow (X \<union> Y)" for X Y df + by (auto simp: Edges_def) + define XY where "XY \<equiv> Edges ?X ?Y diff" + define YZ where "YZ \<equiv> Edges ?Y ?Z diff" + define XZ where "XZ \<equiv> Edges ?X ?Z diff2" + obtain [simp]: "finite XY" "finite YZ" "finite XZ" + using Edges_subset unfolding XY_def YZ_def XZ_def + by (metis finite_Pow_iff finite_UnI finite_subset finpart) + define G where "G \<equiv> (?X \<union> ?Y \<union> ?Z, XY \<union> YZ \<union> XZ)" + have finG: "finite (uverts G)" and cardG: "card (uverts G) = 3*M" + by (simp_all add: G_def card_Un_disjnt disjnt_part_of) + then have "card(uverts G) > X" + using M_def \<open>X \<le> N\<close> by linarith + have "uwellformed G" + by (fastforce simp: card_insert_if part_of_def G_def XY_def YZ_def XZ_def Edges_def uwellformed_def) + have [simp]: "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> XY" + "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> YZ" + "{prod_encode (\<xi>,x), prod_encode (\<xi>,y)} \<notin> XZ" for x y \<xi> + by (auto simp: XY_def YZ_def XZ_def Edges_def doubleton_eq_iff) + have label_ne_XY [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> XY" for p q + using that by (auto simp add: XY_def part_of_def Edges_def doubleton_eq_iff label_of_part_def) + then have [simp]: "{p} \<notin> XY" for p + by (metis insert_absorb2) + have label_ne_YZ [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> YZ" for p q + using that by (auto simp add: YZ_def part_of_def Edges_def doubleton_eq_iff label_of_part_def) + then have [simp]: "{p} \<notin> YZ" for p + by (metis insert_absorb2) + have label_ne_XZ [simp]: "label_of_part p \<noteq> label_of_part q" if "{p,q} \<in> XZ" for p q + using that by (auto simp add: XZ_def part_of_def Edges_def doubleton_eq_iff label_of_part_def) + then have [simp]: "{p} \<notin> XZ" for p + by (metis insert_absorb2) + have label012: "label_of_part v < 3" if "v \<in> uverts G" for v + using that by (auto simp add: G_def eval_nat_numeral part_of_def label_of_part_def) + + have Edges_distinct: "\<And>p q r \<xi> \<zeta> \<gamma> \<beta> df df'. \<lbrakk>{p,q} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df; + {q,r} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df; + {p,r} \<in> Edges (part_of \<gamma>) (part_of \<beta>) df'; \<xi> \<noteq> \<zeta>; \<gamma> \<noteq> \<beta>\<rbrakk> \<Longrightarrow> False" + apply (auto simp: disjnt_iff Edges_def doubleton_eq_iff conj_disj_distribR ex_disj_distrib) + apply (metis disjnt_iff disjnt_part_of)+ + done + have uniq: "\<exists>i<M. \<exists>d\<in>A. \<exists>x \<in> {p,q,r}. \<exists>y \<in> {p,q,r}. \<exists>z \<in> {p,q,r}. + x = prod_encode(0, i) + \<and> y = prod_encode(1, (i+d) mod M) + \<and> z = prod_encode(2, (i+d+d) mod M)" + if T: "triangle_in_graph p q r G" for p q r + proof - + obtain x y z where xy: "{x,y} \<in> XY" and yz: "{y,z} \<in> YZ" and xz: "{x,z} \<in> XZ" + and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}" + using T apply (simp add: triangle_in_graph_def G_def XY_def YZ_def XZ_def) + by (smt (verit, ccfv_SIG) Edges_distinct Zero_not_Suc insert_commute n_not_Suc_n) + then have "x \<in> ?X" "y \<in> ?Y" "z \<in> ?Z" + by (auto simp: XY_def YZ_def XZ_def Edges_def doubleton_eq_iff; metis disjnt_iff disjnt_part_of)+ + then obtain i j k where i: "x = prod_encode(0,i)" and j: "y = prod_encode(1,j)" +and k: "z = prod_encode(2,k)" + by (metis One_nat_def Suc_1 enc_iff prod_decode_aux.cases prod_decode_inverse) + obtain a1 where "a1 \<in> A" and a1: "(int j - int i) mod int M = int a1" + using xy \<open>x \<in> ?X\<close> i j by (auto simp add: XY_def Edges_def doubleton_eq_iff diff_def) + obtain a3 where "a3 \<in> A" and a3: "(int k - int j) mod int M = int a3" + using yz \<open>x \<in> ?X\<close> j k by (auto simp add: YZ_def Edges_def doubleton_eq_iff diff_def) + obtain a2 where "a2 \<in> A" and a2: "(int k - int i) mod int M = int (a2 * 2) mod int M" + using xz \<open>x \<in> ?X\<close> i k apply (auto simp add: XZ_def Edges_def doubleton_eq_iff) + by (metis diff2_by2 diff_def int_plus mult_2_right) + obtain "a1<N" "a2<N" "a3<N" + using A \<open>a1 \<in> A\<close> \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> by blast + then obtain "a1+a3 < M" "a2 * 2 < M" + by (simp add: M_def) + then have "int (a2 * 2) = int (a2 * 2) mod M" + by force + also have "\<dots> = int (a1 + a3) mod int M" + using a1 a2 a3 by (smt (verit, del_insts) int_plus mod_add_eq) + also have "\<dots> = int (a1+a3)" + using \<open>a1 + a3 < M\<close> by force + finally have "a2*2 = a1+a3" + by presburger + then obtain equal: "a3 - a2 = a2 - a1" "a2 - a3 = a1 - a2" + by (metis Nat.diff_cancel diff_cancel2 mult_2_right) + with \<open>a1 \<in> A\<close> \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> have "progression3 a1 (a2 - a1) \<subseteq> A" + apply (clarsimp simp: progression3_def) + by (metis diff_is_0_eq' le_add_diff_inverse nle_le) + with non equal have "a2 = a1" + unfolding progression3_def + by (metis \<open>a2 \<in> A\<close> \<open>a3 \<in> A\<close> add.right_neutral diff_is_0_eq insert_subset +le_add_diff_inverse not_gr_zero) + then have "a3 = a2" + using \<open>a2 * 2 = a1 + a3\<close> by force + have k_minus_j: "(int k - int j) mod int M = int a1" + by (simp add: \<open>a2 = a1\<close> \<open>a3 = a2\<close> a3) + have i_to_j: "j mod M = (i+a1) mod M" + by (metis a1 add_diff_cancel_left' add_diff_eq mod_add_right_eq nat_int of_nat_add of_nat_mod) + have j_to_k: "k mod M = (j+a1) mod M" + by (metis \<open>a2 = a1\<close> \<open>a3 = a2\<close> a3 add_diff_cancel_left' add_diff_eq mod_add_right_eq +nat_int of_nat_add of_nat_mod) + have "i<M" + using \<open>x \<in> ?X\<close> i by simp + then show ?thesis + using i j k x y z \<open>a1 \<in> A\<close> + by (metis \<open>y \<in> ?Y\<close> \<open>z \<in>?Z\<close> enc_iff i_to_j j_to_k mod_add_left_eq mod_less) + qed + + text\<open>Every edge of the graph G lies in exactly one triangle.\<close> + +have "unique_triangles G" + unfolding unique_triangles_def + proof (intro strip) + fix e + assume "e \<in> uedges G" + then consider "e \<in> XY" | "e \<in> YZ" | "e \<in> XZ" + using G_def by fastforce + then show "\<exists>!T. \<exists>x y z. T = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> T" + proof cases + case 1 + then obtain i j a where eeq: "e = {prod_encode(0,i), prod_encode(1,j)}" + and "i<M" and "j<M" + and df: "diff j i = int a" and "a \<in> A" + by (auto simp: XY_def Edges_def part_of_def) + let ?x = "prod_encode (0, i)" + let ?y = "prod_encode (1, j)" + let ?z = "prod_encode (2, (j+a) mod M)" + have yeq: "j = (i+a) mod M" + using diff_invert using \<open>a \<in> A\<close> df \<open>j<M\<close> by blast + with \<open>a \<in> A\<close> \<open>j<M\<close> have "{?y,?z} \<in> YZ" + by (fastforce simp: YZ_def Edges_def image_iff diff_invert) + moreover have "{?x,?z} \<in> XZ" + using \<open>a \<in> A\<close> by (fastforce simp: XZ_def Edges_def yeq diff2_invert \<open>i<M\<close>) + ultimately have T: "triangle_in_graph ?x ?y ?z G" + using \<open>e \<in> uedges G\<close> by (force simp add: G_def eeq triangle_in_graph_def) + show ?thesis + proof (intro ex1I) + show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}" + using T eeq by blast + fix T + assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T" + then obtain p q r where Teq: "T = {p,q,r}" + and tri: "triangle_in_graph p q r G" and "e \<subseteq> T" + by blast + with uniq + obtain i' a' x y z where "i'<M" "a' \<in> A" + and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}" + and xeq: "x = prod_encode(0, i')" + and yeq: "y = prod_encode(1, (i'+a') mod M)" + and zeq: "z = prod_encode(2, (i'+a'+a') mod M)" + by metis + then have sets_eq: "{x,y,z} = {p,q,r}" by auto + with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast + have "a' < M" + using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto + obtain "?x \<in> e" "?y \<in> e" using eeq by force + then have "x = ?x" + using esub' eeq yeq zeq by simp + then have "y = ?y" + using esub' eeq zeq by simp + obtain eq': "i' = i" "(i'+a') mod M = j" + using \<open>x = ?x\<close> xeq using \<open>y =?y\<close> yeq by auto + then have "diff (i'+a') i' = int a'" + by (simp add: diff_def \<open>a' < M\<close>) + then have "a' = a" + by (metis eq' df diff_def mod_diff_left_eq nat_int zmod_int) + then have "z = ?z" + by (metis \<open>y = ?y\<close> mod_add_left_eq prod_encode_eq snd_conv yeq zeq) + then show "T = {?x,?y,?z}" + using Teq \<open>x = ?x\<close> \<open>y = ?y\<close> sets_eq by presburger + qed + next + case 2 + then obtain j k a where eeq: "e = {prod_encode(1,j), prod_encode(2,k)}" + and "j<M" "k<M" + and df: "diff k j = int a" and "a \<in> A" + by (auto simp: YZ_def Edges_def part_of_def numeral_2_eq_2) + let ?x = "prod_encode (0, (M+j-a) mod M)" + let ?y = "prod_encode (1, j)" + let ?z = "prod_encode (2, k)" + have zeq: "k = (j+a) mod M" + using diff_invert using \<open>a \<in> A\<close> df \<open>k<M\<close> by blast + with \<open>a \<in> A\<close> \<open>k<M\<close> have "{?x,?z} \<in> XZ" + unfolding XZ_def Edges_def image_iff + apply (clarsimp simp: mod_add_left_eq doubleton_eq_iff conj_disj_distribR ex_disj_distrib) + apply (smt (verit, ccfv_threshold) A \<open>N < M\<close> diff2_invert le_add_diff_inverse2 lessThan_iff +linorder_not_less mod_add_left_eq + mod_add_self1 not_add_less1 order.strict_trans subsetD) + done + moreover + have "a < N" using A \<open>a \<in> A\<close> by blast + with \<open>N < M\<close> have "((M + j - a) mod M + a) mod M = j mod M" + by (simp add: mod_add_left_eq) + then have "{?x,?y} \<in> XY" + using \<open>a \<in> A\<close> \<open>j<M\<close> + by (force simp add: XY_def Edges_def zeq image_iff diff_invert +doubleton_eq_iff ex_disj_distrib) + ultimately have T: "triangle_in_graph ?x ?y ?z G" + using \<open>e \<in> uedges G\<close> by (auto simp: G_def eeq triangle_in_graph_def) + show ?thesis + proof (intro ex1I) + show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}" + using T eeq by blast + fix T + assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T" + then obtain p q r where Teq: "T = {p,q,r}" and tri: "triangle_in_graph p q r G" and "e \<subseteq> T" + by blast + with uniq + obtain i' a' x y z where "i'<M" "a' \<in> A" + and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}" + and xeq: "x = prod_encode(0, i')" + and yeq: "y = prod_encode(1, (i'+a') mod M)" + and zeq: "z = prod_encode(2, (i'+a'+a') mod M)" + by metis + then have sets_eq: "{x,y,z} = {p,q,r}" by auto + with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast + have "a' < M" + using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto + obtain "?y \<in> e" "?z \<in> e" + using eeq by force + then have "y = ?y" + using esub' eeq xeq zeq by simp + then have "z = ?z" + using esub' eeq xeq by simp + obtain eq': "(i'+a') mod M = j" "(i'+a'+a') mod M = k" + using \<open>y = ?y\<close> yeq using \<open>z =?z\<close> zeq by auto + then have "diff (i'+a'+a') (i'+a') = int a'" + by (simp add: diff_def \<open>a' < M\<close>) + then have "a' = a" + by (metis M_mod_bound \<open>a' \<in> A\<close> df diff_invert eq' mod_add_eq mod_if of_nat_eq_iff) + have "(M + ((i'+a') mod M) - a') mod M = i'" + by (metis Nat.add_diff_assoc2 \<open>a' < M\<close> \<open>i' < M\<close> add.left_commute add_implies_diff +less_imp_le_nat mod_add_right_eq mod_add_self2 mod_less) + with \<open>a' = a\<close> eq' have "(M + j - a) mod M = i'" + by force + with xeq have "x = ?x" by blast + then show "T = {?x,?y,?z}" + using Teq \<open>z = ?z\<close> \<open>y = ?y\<close> sets_eq by presburger + qed + next + case 3 + then obtain i k a where eeq: "e = {prod_encode(0,i), prod_encode(2,k)}" + and "i<M" and "k<M" + and df: "diff2 k i = int a" and "a \<in> A" + by (auto simp: XZ_def Edges_def part_of_def eval_nat_numeral) + let ?x = "prod_encode (0, i)" + let ?y = "prod_encode (1, (i+a) mod M)" + let ?z = "prod_encode (2, k)" + have keq: "k = (i+a+a) mod M" + using diff2_invert [OF \<open>a \<in> A\<close>, of i] df \<open>k<M\<close> using inj_on_diff2 [of i] + by (simp add: inj_on_def Ball_def mod_add_left_eq) + with \<open>a \<in> A\<close> have "{?x,?y} \<in> XY" + using \<open>a \<in> A\<close> \<open>i<M\<close> \<open>k<M\<close> apply (auto simp: XY_def Edges_def) + by (metis M_mod_bound diff_invert enc_iff from_enc imageI) + moreover have "{?y,?z} \<in> YZ" + apply (auto simp: YZ_def Edges_def image_iff eval_nat_numeral) + by (metis M_mod_bound \<open>a \<in> A\<close> diff_invert enc_iff from_enc mod_add_left_eq keq) + ultimately have T: "triangle_in_graph ?x ?y ?z G" + using \<open>e \<in> uedges G\<close> by (force simp add: G_def eeq triangle_in_graph_def) + show ?thesis + proof (intro ex1I) + show "\<exists>x y z. {?x,?y,?z} = {x, y, z} \<and> triangle_in_graph x y z G \<and> e \<subseteq> {?x,?y,?z}" + using T eeq by blast + fix T + assume "\<exists>p q r. T = {p, q, r} \<and> triangle_in_graph p q r G \<and> e \<subseteq> T" + then obtain p q r where Teq: "T = {p,q,r}" and tri: "triangle_in_graph p q r G" and "e \<subseteq> T" + by blast + with uniq obtain i' a' x y z where "i'<M" "a' \<in> A" + and x: "x \<in> {p,q,r}" and y: "y \<in> {p,q,r}" and z: "z \<in> {p,q,r}" + and xeq: "x = prod_encode(0, i')" + and yeq: "y = prod_encode(1, (i'+a') mod M)" + and zeq: "z = prod_encode(2, (i'+a'+a') mod M)" + by metis + then have sets_eq: "{x,y,z} = {p,q,r}" by auto + with Teq \<open>e \<subseteq> T\<close> have esub': "e \<subseteq> {x,y,z}" by blast + have "a' < M" + using A \<open>N < M\<close> \<open>a' \<in> A\<close> by auto + obtain "?x \<in> e" "?z \<in> e" using eeq by force + then have "x = ?x" + using esub' eeq yeq zeq by simp + then have "z = ?z" + using esub' eeq yeq by simp + obtain eq': "i' = i" "(i'+a'+a') mod M = k" + using \<open>x = ?x\<close> xeq using \<open>z =?z\<close> zeq by auto + then have "diff (i'+a') i' = int a'" + by (simp add: diff_def \<open>a' < M\<close>) + then have "a' = a" + by (metis \<open>a' \<in> A\<close> add.commute df diff2_invert eq' mod_add_right_eq nat_int) + then have "y = ?y" + by (metis \<open>x = ?x\<close> prod_encode_eq snd_conv yeq xeq) + then show "T = {?x,?y,?z}" + using Teq \<open>x = ?x\<close> \<open>z = ?z\<close> sets_eq by presburger + qed + qed + qed + have *: "card (uedges G) \<le> \<epsilon>/12 * (card (uverts G))\<^sup>2" + using X \<open>X < card (uverts G)\<close> \<open>unique_triangles G\<close> \<open>uwellformed G\<close> by blast + + have diff_cancel: "\<exists>j<M. diff j i = int a" if "a \<in> A" for i a + proof - + have "int a < int M" + using A M_def that by auto + then have "(int ((i + a) mod M) - int i) mod int M = int a" + by (simp add: mod_diff_left_eq of_nat_mod) + then show ?thesis + using \<open>0 < M\<close> diff_def mod_less_divisor by blast + qed + have diff2_cancel: "\<exists>j<M. diff2 j i = int a" if "a \<in> A" "i<M" for i a + proof - + have "a<M" + using that M_def A by auto + have "(int ((i + 2*a) mod M) - int i) * (1 + int N) mod int M = + (((int i + 2 * int a) mod M) - int i) * (1 + int N) mod int M" + by (simp add: zmod_int) + also have "\<dots> = 2 * int a * (1 + int N) mod int M" + by (smt (verit) mod_diff_left_eq mod_mult_eq mod_mult_right_eq) + also have "\<dots> = int a mod int M" + proof - + have "(2 * int a * (1 + int N) - int a) = M * a" + by (simp add: M_def algebra_simps) + then have "M dvd (2 * int a * (1 + int N) - int a)" + by simp + then show ?thesis + using mod_eq_dvd_iff by blast + qed + also have "\<dots> = a" by (simp add: \<open>a < M\<close>) + finally show ?thesis + by (metis \<open>0 < M\<close> diff2_def mod_less_divisor of_nat_Suc) + qed + + have card_Edges: "card (Edges (part_of \<xi>) (part_of \<zeta>) df) = M * card A" (is "card ?E = _") + if "\<xi> \<noteq> \<zeta>" and df_cancel: "\<forall>a\<in>A. \<forall>i<M. \<exists>j<M. df j i = int a" + and df_inj: "\<forall>a. inj_on (\<lambda>x. df x a) {..<M}" for \<xi> \<zeta> df + proof - + define R where "R \<equiv> \<lambda>\<xi> Y df u p. \<exists>x y i a. u = {x,y} \<and> p = (i,a) \<and> x = prod_encode (\<xi>,i) + \<and> y \<in> Y \<and> a \<in> A \<and> df(from_part y) (from_part x) = int a" + have R_uniq: "\<lbrakk>R \<xi> (part_of \<zeta>) df u p; R \<xi> (part_of \<zeta>) df u p'; \<xi> \<noteq> \<zeta>\<rbrakk> \<Longrightarrow> p' = p" for u p p' \<xi> \<zeta> df + by (auto simp add: R_def doubleton_eq_iff) + define f where "f \<equiv> \<lambda>\<xi> Y df u. @p. R \<xi> Y df u p" + have f_if_R: "f \<xi> (part_of \<zeta>) df u = p" if "R \<xi> (part_of \<zeta>) df u p" "\<xi> \<noteq> \<zeta>" for u p \<xi> \<zeta> df + using R_uniq f_def that by blast + have "bij_betw (f \<xi> (part_of \<zeta>) df) ?E ({..<M} \<times> A)" + unfolding bij_betw_def inj_on_def + proof (intro conjI strip) + fix u u' + assume "u \<in> ?E" and "u' \<in> ?E" + and eq: "f \<xi> (part_of \<zeta>) df u = f \<xi> (part_of \<zeta>) df u'" + obtain x y a where u: "u = {x,y}" "x \<in> part_of \<xi>" "y \<in> part_of \<zeta>" "a \<in> A" + and df: "df (from_part y) (from_part x) = int a" + using \<open>u \<in> ?E\<close> + by (force simp add: Edges_def image_iff) + then obtain i where i: "x = prod_encode (\<xi>,i)" + using part_of_def by blast + with u df R_def f_if_R that have fu: "f \<xi> (part_of \<zeta>) df u = (i,a)" + by blast + obtain x' y' a' where u': "u' = {x',y'}" "x' \<in> part_of \<xi>" "y' \<in> part_of \<zeta>" "a'\<in>A" + and df': "df (from_part y') (from_part x') = int a'" + using \<open>u' \<in> ?E\<close> by (force simp add: Edges_def image_iff) + then obtain i' where i': "x' = prod_encode (\<xi>,i')" + using part_of_def by blast + with u' df' R_def f_if_R that have fu': "f \<xi> (part_of \<zeta>) df u' = (i',a')" + by blast + have "i'=i" "a' = a" + using fu fu' eq by auto + with i i' have "x = x'" + by meson + moreover have "from_part y = from_part y'" + using df df' \<open>x = x'\<close> \<open>a' = a\<close> df_inj u'(3) u(3) + by (clarsimp simp add: inj_on_def) (metis part_of_M lessThan_iff) + then have "y = y'" + using part_of_def u'(3) u(3) by fastforce + ultimately show "u = u'" + using u'(1) u(1) by force + next + have "f \<xi> (part_of \<zeta>) df ` ?E \<subseteq> {..<M} \<times> A" + proof (clarsimp simp: Edges_def) + fix i a x y b + assume "x \<in> part_of \<xi>" "y \<in> part_of \<zeta>" "df (from_part y) (from_part x) = int b" + "b \<in> A" and feq: "(i, a) = f \<xi> (part_of \<zeta>) df {x, y}" + then have "R \<xi> (part_of \<zeta>) df {x,y} (from_part x, b)" + by (auto simp: R_def doubleton_eq_iff part_of_def) + then have "(from_part x, b) = (i, a)" + by (simp add: f_if_R feq from_part_def that) + then show "i < M \<and> a \<in> A" + using \<open>x \<in> part_of \<xi>\<close> \<open>b \<in> A\<close> part_of_M by fastforce + qed + moreover have "{..<M} \<times> A \<subseteq> f \<xi> (part_of \<zeta>) df ` ?E" + proof clarsimp + fix i a assume "a \<in> A" and "i < M" + then obtain j where "j<M" and j: "df j i = int a" + using df_cancel by metis + then have fj: "f \<xi> (part_of \<zeta>) df {prod_encode (\<xi>, i), prod_encode (\<zeta>, j)} = (i,a)" + by (metis R_def \<open>a \<in> A\<close> enc_iff f_if_R from_enc \<open>\<xi> \<noteq> \<zeta>\<close>) + then have "{prod_encode (\<xi>,i), prod_encode (\<zeta>, j mod M)} \<in> Edges (part_of \<xi>) (part_of \<zeta>) df" + apply (clarsimp simp: Edges_def doubleton_eq_iff) + by (metis \<open>a \<in> A\<close> \<open>i < M\<close> \<open>j < M\<close> enc_iff from_enc image_eqI j mod_if) + then show "(i,a) \<in> f \<xi> (part_of \<zeta>) df ` Edges (part_of \<xi>) (part_of \<zeta>) df" + using \<open>j < M\<close> fj image_iff by fastforce + qed + ultimately show "f \<xi> (part_of \<zeta>) df ` ?E = {..<M} \<times> A" by blast + qed + then show ?thesis + by (simp add: bij_betw_same_card card_cartesian_product) + qed + have [simp]: "disjnt XY YZ" "disjnt XY XZ" "disjnt YZ XZ" + using disjnt_part_of unfolding XY_def YZ_def XZ_def Edges_def disjnt_def + by (clarsimp simp add: disjoint_iff doubleton_eq_iff, meson disjnt_iff n_not_Suc_n nat.discI)+ + have [simp]: "card XY = M * card A" "card YZ = M * card A" + by (simp_all add: XY_def YZ_def card_Edges diff_cancel inj_on_diff) + have [simp]: "card XZ = M * card A" + by (simp_all add: XZ_def card_Edges diff2_cancel inj_on_diff2) + have card_edges: "card (uedges G) = 3 * M * card A" + by (simp add: G_def card_Un_disjnt) + have "card A \<le> \<epsilon> * (real M / 4)" + using * \<open>0 < M\<close> by (simp add: cardG card_edges power2_eq_square) + also have "\<dots> < \<epsilon> * N" + using \<open>N>0\<close> by (simp add: M_def assms) + finally show "card A < \<epsilon> * N" . + qed +qed + +text\<open>We finally present the main statement formulated using the upper asymptotic density condition.\<close> + +theorem RothArithmeticProgressions: + assumes "upper_asymptotic_density A > 0" + shows "\<exists>k d. d>0 \<and> progression3 k d \<subseteq> A" +proof (rule ccontr) + assume non: "\<nexists>k d. 0 < d \<and> progression3 k d \<subseteq> A" + obtain X where X: "\<forall>N \<ge> X. \<forall>A' \<subseteq> {..<N}. (\<nexists>k d. d>0 \<and> progression3 k d \<subseteq> A') + \<longrightarrow> card A' < upper_asymptotic_density A / 2 * real N" + by (metis half_gt_zero RothArithmeticProgressions_aux assms) + then have "\<forall>N \<ge> X. card (A \<inter> {..<N}) < upper_asymptotic_density A / 2 * N" + by (meson order_trans inf_le1 inf_le2 non) + then have "upper_asymptotic_density A \<le> upper_asymptotic_density A / 2" + by (force simp add: eventually_sequentially less_eq_real_def intro!: upper_asymptotic_densityI) + with assms show False by linarith +qed + +end + + + diff --git a/thys/Roth_Arithmetic_Progressions/document/root.tex b/thys/Roth_Arithmetic_Progressions/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Roth_Arithmetic_Progressions/document/root.tex @@ -0,0 +1,48 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[T1]{fontenc} +\usepackage{amssymb} +\usepackage{isabelle,isabellesym} +\usepackage[english]{babel} % for guillemots + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +\begin{document} + +\title{Roth's Theorem on Arithmetic Progressions} +\author{Chelsea Edmonds, Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson\\ +Computer Laboratory, University of Cambridge CB3 0FD\\ +\texttt{\{cle47,ak2110,lp15\}@cam.ac.uk}} + +\maketitle + +\begin{abstract} +We formalise a proof of Roth's Theorem on Arithmetic Progressions, a major result in additive +combinatorics on the existence of 3-term arithmetic progressions in subsets of natural numbers. +To this end, we follow a proof using graph regularity. We employ our recent formalisation of Szemer\'{e}di's +Regularity Lemma, a major result in extremal graph theory, which we use here to prove +the Triangle Counting Lemma and the Triangle Removal Lemma. +Our sources are Yufei Zhao's MIT lecture notes ``Graph Theory and Additive Combinatorics''% +\footnote{\url{https://ocw.mit.edu/courses/mathematics/18-217-graph-theory-and-additive-combinatorics-fall-2019/lecture-notes/MIT18_217F19_ch3.pdf} and \url{https://yufeizhao.com/gtac/gtac17.pdf}} +and W.T. Gowers's Cambridge lecture notes ``Topics in Combinatorics''.% +\footnote{\url{https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf}} +We also refer to the University of Georgia notes by Stephanie Bell and Will Grodzicki +``Using Szemerédi's Regularity Lemma to Prove Roth's Theorem''.% +\footnote{\url{http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327}} +\end{abstract} + +\tableofcontents + +\subsection*{Acknowledgements} +The authors were supported by the ERC Advanced Grant ALEXANDRIA (Project 742178) funded by the European Research Council. + +\newpage + +% include generated text of all theories +\input{session} + +\end{document} diff --git a/web/entries/Abstract-Rewriting.html b/web/entries/Abstract-Rewriting.html --- a/web/entries/Abstract-Rewriting.html +++ b/web/entries/Abstract-Rewriting.html @@ -1,287 +1,287 @@ <!DOCTYPE html> <html lang="en"> <head> <meta charset="utf-8"> <title>Abstract Rewriting - Archive of Formal Proofs

Abstract Rewriting

Title:	Abstract Rewriting
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2010-06-14
Abstract:	We present an Isabelle formalization of abstract rewriting (see, e.g., the book by Baader and Nipkow). First, we define standard relations like joinability, meetability, conversion, etc. Then, we formalize important properties of abstract rewrite systems, e.g., confluence and strong normalization. Our main concern is on strong normalization, since this formalization is the basis of CeTA (which is mainly about strong normalization of term rewrite systems). Hence lemmas involving strong normalization constitute by far the biggest part of this theory. One of those is Newman's lemma.
Change history:	[2010-09-17]: Added theories defining several (ordered) semirings related to strong normalization and giving some standard instances. [2013-10-16]: Generalized delta-orders from rationals to Archimedean fields.
BibTeX:	@article{Abstract-Rewriting-AFP, author = {Christian Sternagel and René Thiemann}, title = {Abstract Rewriting}, journal = {Archive of Formal Proofs}, month = jun, year = 2010, note = {\url{https://isa-afp.org/entries/Abstract-Rewriting.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Regular-Sets
Used by:	Decreasing-Diagrams, Decreasing-Diagrams-II, First_Order_Terms, Matrix, Minsky_Machines, Myhill-Nerode, Polynomial_Factorization, Polynomials, Rewriting_Z, Well_Quasi_Orders

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Abstract-Rewriting-2021-02-23.tar.gz
Isabelle 2020: afp-Abstract-Rewriting-2020-04-18.tar.gz
Isabelle 2019: afp-Abstract-Rewriting-2019-06-11.tar.gz
Isabelle 2018: afp-Abstract-Rewriting-2018-08-16.tar.gz
Isabelle 2017: afp-Abstract-Rewriting-2017-10-10.tar.gz
Isabelle 2016-1: afp-Abstract-Rewriting-2016-12-17.tar.gz
Isabelle 2016: afp-Abstract-Rewriting-2016-02-22.tar.gz
Isabelle 2015: afp-Abstract-Rewriting-2015-05-27.tar.gz
Isabelle 2014: afp-Abstract-Rewriting-2014-08-28.tar.gz
Isabelle 2013-2: afp-Abstract-Rewriting-2013-12-11.tar.gz
Isabelle 2013-1: afp-Abstract-Rewriting-2013-11-17.tar.gz
Isabelle 2013: afp-Abstract-Rewriting-2013-02-16.tar.gz
Isabelle 2012: afp-Abstract-Rewriting-2012-05-24.tar.gz
Isabelle 2011-1: afp-Abstract-Rewriting-2011-10-11.tar.gz
Isabelle 2011: afp-Abstract-Rewriting-2011-02-11.tar.gz
Isabelle 2009-2: afp-Abstract-Rewriting-2010-06-30.tar.gz
Isabelle 2009-1: afp-Abstract-Rewriting-2010-06-17.tar.gz

\ No newline at end of file diff --git a/web/entries/Algebraic_Numbers.html b/web/entries/Algebraic_Numbers.html --- a/web/entries/Algebraic_Numbers.html +++ b/web/entries/Algebraic_Numbers.html @@ -1,246 +1,246 @@ Algebraic Numbers in Isabelle/HOL - Archive of Formal Proofs

Algebraic Numbers in Isabelle/HOL

Title:	Algebraic Numbers in Isabelle/HOL
Authors:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at), + René Thiemann, Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp) and Sebastiaan Joosten
Contributor:	Manuel Eberl
Submission date:	2015-12-22
Abstract:	Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version. To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain.
Change history:	[2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization [2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm
BibTeX:	@article{Algebraic_Numbers-AFP, author = {René Thiemann and Akihisa Yamada and Sebastiaan Joosten}, title = {Algebraic Numbers in Isabelle/HOL}, journal = {Archive of Formal Proofs}, month = dec, year = 2015, note = {\url{https://isa-afp.org/entries/Algebraic_Numbers.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Berlekamp_Zassenhaus, Sturm_Sequences
Used by:	BenOr_Kozen_Reif, Cubic_Quartic_Equations, Factor_Algebraic_Polynomial, Hermite_Lindemann, LLL_Basis_Reduction

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Algebraic_Numbers-2021-02-23.tar.gz
Isabelle 2020: afp-Algebraic_Numbers-2020-04-18.tar.gz
Isabelle 2019: afp-Algebraic_Numbers-2019-06-11.tar.gz
Isabelle 2018: afp-Algebraic_Numbers-2018-08-16.tar.gz
Isabelle 2017: afp-Algebraic_Numbers-2017-10-10.tar.gz
Isabelle 2016-1: afp-Algebraic_Numbers-2016-12-17.tar.gz
Isabelle 2016: afp-Algebraic_Numbers-2016-02-22.tar.gz
Isabelle 2015: afp-Algebraic_Numbers-2015-12-22.tar.gz

\ No newline at end of file diff --git a/web/entries/Amicable_Numbers.html b/web/entries/Amicable_Numbers.html --- a/web/entries/Amicable_Numbers.html +++ b/web/entries/Amicable_Numbers.html @@ -1,197 +1,197 @@ Amicable Numbers - Archive of Formal Proofs

Amicable Numbers

Title:	Amicable Numbers
Author:	- Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki
Submission date:	2020-08-04
Abstract:	This is a formalisation of Amicable Numbers, involving some relevant material including Euler's sigma function, some relevant definitions, results and examples as well as rules such as Thābit ibn Qurra's Rule, Euler's Rule, te Riele's Rule and Borho's Rule with breeders.
BibTeX:	@article{Amicable_Numbers-AFP, author = {Angeliki Koutsoukou-Argyraki}, title = {Amicable Numbers}, journal = {Archive of Formal Proofs}, month = aug, year = 2020, note = {\url{https://isa-afp.org/entries/Amicable_Numbers.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Polynomial_Factorization, Pratt_Certificate

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Amicable_Numbers-2021-02-23.tar.gz
Isabelle 2020: afp-Amicable_Numbers-2020-08-15.tar.gz

\ No newline at end of file diff --git a/web/entries/Aristotles_Assertoric_Syllogistic.html b/web/entries/Aristotles_Assertoric_Syllogistic.html --- a/web/entries/Aristotles_Assertoric_Syllogistic.html +++ b/web/entries/Aristotles_Assertoric_Syllogistic.html @@ -1,208 +1,208 @@ Aristotle's Assertoric Syllogistic - Archive of Formal Proofs

Aristotle's Assertoric Syllogistic

Title:	Aristotle's Assertoric Syllogistic
Author:	- Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki
Submission date:	2019-10-08
Abstract:	We formalise with Isabelle/HOL some basic elements of Aristotle's assertoric syllogistic following the article from the Stanford Encyclopedia of Philosophy by Robin Smith. To this end, we use a set theoretic formulation (covering both individual and general predication). In particular, we formalise the deductions in the Figures and after that we present Aristotle's metatheoretical observation that all deductions in the Figures can in fact be reduced to either Barbara or Celarent. As the formal proofs prove to be straightforward, the interest of this entry lies in illustrating the functionality of Isabelle and high efficiency of Sledgehammer for simple exercises in philosophy.
BibTeX:	@article{Aristotles_Assertoric_Syllogistic-AFP, author = {Angeliki Koutsoukou-Argyraki}, title = {Aristotle's Assertoric Syllogistic}, journal = {Archive of Formal Proofs}, month = oct, year = 2019, note = {\url{https://isa-afp.org/entries/Aristotles_Assertoric_Syllogistic.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Aristotles_Assertoric_Syllogistic-2021-02-23.tar.gz
Isabelle 2020: afp-Aristotles_Assertoric_Syllogistic-2020-04-18.tar.gz
Isabelle 2019: afp-Aristotles_Assertoric_Syllogistic-2019-10-17.tar.gz

\ No newline at end of file diff --git a/web/entries/Berlekamp_Zassenhaus.html b/web/entries/Berlekamp_Zassenhaus.html --- a/web/entries/Berlekamp_Zassenhaus.html +++ b/web/entries/Berlekamp_Zassenhaus.html @@ -1,248 +1,248 @@ The Factorization Algorithm of Berlekamp and Zassenhaus - Archive of Formal Proofs

The Factorization Algorithm of Berlekamp and Zassenhaus

Title:	The Factorization Algorithm of Berlekamp and Zassenhaus
Authors:	Jose Divasón, Sebastiaan Joosten, - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2016-10-14
Abstract:	We formalize the Berlekamp-Zassenhaus algorithm for factoring square-free integer polynomials in Isabelle/HOL. We further adapt an existing formalization of Yun’s square-free factorization algorithm to integer polynomials, and thus provide an efficient and certified factorization algorithm for arbitrary univariate polynomials. The algorithm first performs a factorization in the prime field GF(p) and then performs computations in the integer ring modulo p^k, where both p and k are determined at runtime. Since a natural modeling of these structures via dependent types is not possible in Isabelle/HOL, we formalize the whole algorithm using Isabelle’s recent addition of local type definitions. Through experiments we verify that our algorithm factors polynomials of degree 100 within seconds.
BibTeX:	@article{Berlekamp_Zassenhaus-AFP, author = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada}, title = {The Factorization Algorithm of Berlekamp and Zassenhaus}, journal = {Archive of Formal Proofs}, month = oct, year = 2016, note = {\url{https://isa-afp.org/entries/Berlekamp_Zassenhaus.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Efficient-Mergesort, Polynomial_Factorization, Polynomial_Interpolation, Show, Subresultants
Used by:	Algebraic_Numbers, LLL_Basis_Reduction, Smith_Normal_Form

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Berlekamp_Zassenhaus-2021-02-23.tar.gz
Isabelle 2020: afp-Berlekamp_Zassenhaus-2020-04-18.tar.gz
Isabelle 2019: afp-Berlekamp_Zassenhaus-2019-06-11.tar.gz
Isabelle 2018: afp-Berlekamp_Zassenhaus-2018-09-07.tar.gz
Isabelle 2018: afp-Berlekamp_Zassenhaus-2018-08-16.tar.gz
Isabelle 2017: afp-Berlekamp_Zassenhaus-2017-10-10.tar.gz
Isabelle 2016-1: afp-Berlekamp_Zassenhaus-2016-12-17.tar.gz

\ No newline at end of file diff --git a/web/entries/Certification_Monads.html b/web/entries/Certification_Monads.html --- a/web/entries/Certification_Monads.html +++ b/web/entries/Certification_Monads.html @@ -1,230 +1,230 @@ Certification Monads - Archive of Formal Proofs

Certification Monads

Title:	Certification Monads
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2014-10-03
Abstract:	This entry provides several monads intended for the development of stand-alone certifiers via code generation from Isabelle/HOL. More specifically, there are three flavors of error monads (the sum type, for the case where all monadic functions are total; an instance of the former, the so called check monad, yielding either success without any further information or an error message; as well as a variant of the sum type that accommodates partial functions by providing an explicit bottom element) and a parser monad built on top. All of this monads are heavily used in the IsaFoR/CeTA project which thus provides many examples of their usage.
BibTeX:	@article{Certification_Monads-AFP, author = {Christian Sternagel and René Thiemann}, title = {Certification Monads}, journal = {Archive of Formal Proofs}, month = oct, year = 2014, note = {\url{https://isa-afp.org/entries/Certification_Monads.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Partial_Function_MR, Show
Used by:	AI_Planning_Languages_Semantics, WOOT_Strong_Eventual_Consistency, XML

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Certification_Monads-2021-02-23.tar.gz
Isabelle 2020: afp-Certification_Monads-2020-04-18.tar.gz
Isabelle 2019: afp-Certification_Monads-2019-06-11.tar.gz
Isabelle 2018: afp-Certification_Monads-2018-08-16.tar.gz
Isabelle 2017: afp-Certification_Monads-2017-10-10.tar.gz
Isabelle 2016-1: afp-Certification_Monads-2016-12-17.tar.gz
Isabelle 2016: afp-Certification_Monads-2016-02-22.tar.gz
Isabelle 2015: afp-Certification_Monads-2015-05-27.tar.gz
Isabelle 2014: afp-Certification_Monads-2014-10-08.tar.gz

\ No newline at end of file diff --git a/web/entries/Collections.html b/web/entries/Collections.html --- a/web/entries/Collections.html +++ b/web/entries/Collections.html @@ -1,317 +1,317 @@ Collections Framework - Archive of Formal Proofs

Collections Framework

- +

Title:	Collections Framework
Author:	Peter Lammich
Contributors:	Andreas Lochbihler and Thomas Tuerk
Submission date:	2009-11-25
Abstract:	This development provides an efficient, extensible, machine checked collections framework. The library adopts the concepts of interface, implementation and generic algorithm from object-oriented programming and implements them in Isabelle/HOL. The framework features the use of data refinement techniques to refine an abstract specification (using high-level concepts like sets) to a more concrete implementation (using collection datastructures, like red-black-trees). The code-generator of Isabelle/HOL can be used to generate efficient code.
Change history:	[2010-10-08]: New Interfaces: OrderedSet, OrderedMap, List. Fifo now implements list-interface: Function names changed: put/get --> enqueue/dequeue. New Implementations: ArrayList, ArrayHashMap, ArrayHashSet, TrieMap, TrieSet. Invariant-free datastructures: Invariant implicitely hidden in typedef. Record-interfaces: All operations of an interface encapsulated as record. Examples moved to examples subdirectory. [2010-12-01]: New Interfaces: Priority Queues, Annotated Lists. Implemented by finger trees, (skew) binomial queues. [2011-10-10]: SetSpec: Added operations: sng, isSng, bexists, size_abort, diff, filter, iterate_rule_insertP MapSpec: Added operations: sng, isSng, iterate_rule_insertP, bexists, size, size_abort, restrict, map_image_filter, map_value_image_filter Some maintenance changes [2012-04-25]: New iterator foundation by Tuerk. Various maintenance changes. [2012-08]: Collections V2. New features: Polymorphic iterators. Generic algorithm instantiation where required. Naming scheme changed from xx_opname to xx.opname. A compatibility file CollectionsV1 tries to simplify porting of existing theories, by providing old naming scheme and the old monomorphic iterator locales. [2013-09]: Added Generic Collection Framework based on Autoref. The GenCF provides: Arbitrary nesting, full integration with Autoref. [2014-06]: Maintenace changes to GenCF: Optimized inj_image on list_set. op_set_cart (Cartesian product). big-Union operation. atLeastLessThan - operation ({a..<b})
BibTeX:	@article{Collections-AFP, author = {Peter Lammich}, title = {Collections Framework}, journal = {Archive of Formal Proofs}, month = nov, year = 2009, note = {\url{https://isa-afp.org/entries/Collections.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Binomial-Heaps, Finger-Trees, Native_Word, Refine_Monadic, Trie
Used by:	Abstract_Completeness, Containers, Deriving, Dijkstra_Shortest_Path, Formal_SSA, JinjaThreads, Kruskal, ROBDD, Separation_Logic_Imperative_HOL, Transition_Systems_and_Automata, Transitive-Closure, Tree-Automata
Abstract_Completeness, Containers, Deriving, Dijkstra_Shortest_Path, Formal_SSA, Gale_Shapley, JinjaThreads, Kruskal, ROBDD, Separation_Logic_Imperative_HOL, Transition_Systems_and_Automata, Transitive-Closure, Tree-Automata

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Collections-2021-02-23.tar.gz
Isabelle 2020: afp-Collections-2020-04-18.tar.gz
Isabelle 2019: afp-Collections-2019-06-11.tar.gz
Isabelle 2018: afp-Collections-2018-08-16.tar.gz
Isabelle 2017: afp-Collections-2017-10-10.tar.gz
Isabelle 2016-1: afp-Collections-2016-12-17.tar.gz
Isabelle 2016: afp-Collections-2016-02-22.tar.gz
Isabelle 2015: afp-Collections-2015-05-27.tar.gz
Isabelle 2014: afp-Collections-2014-08-28.tar.gz
Isabelle 2013-2: afp-Collections-2013-12-11.tar.gz
Isabelle 2013-1: afp-Collections-2013-11-17.tar.gz
Isabelle 2013: afp-Collections-2013-03-02.tar.gz
Isabelle 2013: afp-Collections-2013-02-16.tar.gz
Isabelle 2012: afp-Collections-2012-05-24.tar.gz
Isabelle 2011-1: afp-Collections-2011-10-12.tar.gz
Isabelle 2011-1: afp-Collections-2011-10-11.tar.gz
Isabelle 2011: afp-Collections-2011-02-11.tar.gz
Isabelle 2009-2: afp-Collections-2010-06-30.tar.gz
Isabelle 2009-1: afp-Collections-2009-12-13.tar.gz
Isabelle 2009-1: afp-Collections-2009-12-12.tar.gz
Isabelle 2009: afp-Collections-2009-11-29.tar.gz

\ No newline at end of file diff --git a/web/entries/Cubic_Quartic_Equations.html b/web/entries/Cubic_Quartic_Equations.html --- a/web/entries/Cubic_Quartic_Equations.html +++ b/web/entries/Cubic_Quartic_Equations.html @@ -1,201 +1,201 @@ Solving Cubic and Quartic Equations - Archive of Formal Proofs

Solving Cubic and Quartic Equations

Title:	Solving Cubic and Quartic Equations
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2021-09-03
Abstract:	We formalize Cardano's formula to solve a cubic equation $$ax^3 + bx^2 + cx + d = 0,$$ as well as Ferrari's formula to solve a quartic equation. We further turn both formulas into executable algorithms based on the algebraic number implementation in the AFP. To this end we also slightly extended this library, namely by making the minimal polynomial of an algebraic number executable, and by defining and implementing $n$-th roots of complex numbers.
BibTeX:	@article{Cubic_Quartic_Equations-AFP, author = {René Thiemann}, title = {Solving Cubic and Quartic Equations}, journal = {Archive of Formal Proofs}, month = sep, year = 2021, note = {\url{https://isa-afp.org/entries/Cubic_Quartic_Equations.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Algebraic_Numbers, Complex_Geometry, Factor_Algebraic_Polynomial

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Cubic_Quartic_Equations-2021-09-03.tar.gz

\ No newline at end of file diff --git a/web/entries/Datatype_Order_Generator.html b/web/entries/Datatype_Order_Generator.html --- a/web/entries/Datatype_Order_Generator.html +++ b/web/entries/Datatype_Order_Generator.html @@ -1,273 +1,273 @@ Generating linear orders for datatypes - Archive of Formal Proofs

Generating linear orders for datatypes

Title:	Generating linear orders for datatypes
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2012-08-07
Abstract:	We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature. We further implemented such automatic methods to derive (linear) orders or hash-functions which are required in the Isabelle Collection Framework. Moreover, for the tactic of Huffman and Krauss to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactic we could completely remove tedious proofs for linear orders of two datatypes. This development is aimed at datatypes generated by the "old_datatype" command.
BibTeX:	@article{Datatype_Order_Generator-AFP, author = {René Thiemann}, title = {Generating linear orders for datatypes}, journal = {Archive of Formal Proofs}, month = aug, year = 2012, note = {\url{https://isa-afp.org/entries/Datatype_Order_Generator.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Deriving, Native_Word
Used by:	Higher_Order_Terms, WOOT_Strong_Eventual_Consistency

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Datatype_Order_Generator-2021-02-23.tar.gz
Isabelle 2020: afp-Datatype_Order_Generator-2020-04-18.tar.gz
Isabelle 2019: afp-Datatype_Order_Generator-2019-06-11.tar.gz
Isabelle 2018: afp-Datatype_Order_Generator-2018-08-16.tar.gz
Isabelle 2017: afp-Datatype_Order_Generator-2017-10-10.tar.gz
Isabelle 2016-1: afp-Datatype_Order_Generator-2016-12-17.tar.gz
Isabelle 2016: afp-Datatype_Order_Generator-2016-02-22.tar.gz
Isabelle 2015: afp-Datatype_Order_Generator-2015-05-27.tar.gz
Isabelle 2014: afp-Datatype_Order_Generator-2014-08-28.tar.gz
Isabelle 2013-2: afp-Datatype_Order_Generator-2013-12-11.tar.gz
Isabelle 2013-1: afp-Datatype_Order_Generator-2013-11-17.tar.gz
Isabelle 2013: afp-Datatype_Order_Generator-2013-03-02.tar.gz
Isabelle 2013: afp-Datatype_Order_Generator-2013-02-16.tar.gz
Isabelle 2012: afp-Datatype_Order_Generator-2012-08-07.tar.gz

\ No newline at end of file diff --git a/web/entries/Decreasing-Diagrams-II.html b/web/entries/Decreasing-Diagrams-II.html --- a/web/entries/Decreasing-Diagrams-II.html +++ b/web/entries/Decreasing-Diagrams-II.html @@ -1,224 +1,224 @@ Decreasing Diagrams II - Archive of Formal Proofs

Decreasing Diagrams II

Title:	Decreasing Diagrams II
Author:	- Bertram Felgenhauer (int-e /at/ gmx /dot/ de) + Bertram Felgenhauer
Submission date:	2015-08-20
Abstract:	This theory formalizes the commutation version of decreasing diagrams for Church-Rosser modulo. The proof follows Felgenhauer and van Oostrom (RTA 2013). The theory also provides important specializations, in particular van Oostrom’s conversion version (TCS 2008) of decreasing diagrams.
BibTeX:	@article{Decreasing-Diagrams-II-AFP, author = {Bertram Felgenhauer}, title = {Decreasing Diagrams II}, journal = {Archive of Formal Proofs}, month = aug, year = 2015, note = {\url{https://isa-afp.org/entries/Decreasing-Diagrams-II.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Abstract-Rewriting, Open_Induction, Well_Quasi_Orders

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Decreasing-Diagrams-II-2021-02-23.tar.gz
Isabelle 2020: afp-Decreasing-Diagrams-II-2020-04-18.tar.gz
Isabelle 2019: afp-Decreasing-Diagrams-II-2019-06-11.tar.gz
Isabelle 2018: afp-Decreasing-Diagrams-II-2018-08-16.tar.gz
Isabelle 2017: afp-Decreasing-Diagrams-II-2017-10-10.tar.gz
Isabelle 2016-1: afp-Decreasing-Diagrams-II-2016-12-17.tar.gz
Isabelle 2016: afp-Decreasing-Diagrams-II-2016-02-22.tar.gz
Isabelle 2015: afp-Decreasing-Diagrams-II-2015-08-21.tar.gz

\ No newline at end of file diff --git a/web/entries/Deriving.html b/web/entries/Deriving.html --- a/web/entries/Deriving.html +++ b/web/entries/Deriving.html @@ -1,244 +1,244 @@ Deriving class instances for datatypes - Archive of Formal Proofs

Deriving class instances for datatypes

Title:	Deriving class instances for datatypes
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2015-03-11
Abstract:	We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature. We further implemented such automatic methods to derive comparators, linear orders, parametrizable equality functions, and hash-functions which are required in the Isabelle Collection Framework and the Container Framework. Moreover, for the tactic of Blanchette to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. All of the generators are based on the infrastructure that is provided by the BNF-based datatype package. Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactics we could remove several tedious proofs for (conditional) linear orders, and conditional equality operators within IsaFoR and the Container Framework.
BibTeX:	@article{Deriving-AFP, author = {Christian Sternagel and René Thiemann}, title = {Deriving class instances for datatypes}, journal = {Archive of Formal Proofs}, month = mar, year = 2015, note = {\url{https://isa-afp.org/entries/Deriving.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Collections
Used by:	Affine_Arithmetic, Containers, Datatype_Order_Generator, Formula_Derivatives, Groebner_Bases, LTL_Master_Theorem, MSO_Regex_Equivalence, Real_Impl, Show, Van_Emde_Boas_Trees

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Deriving-2021-02-23.tar.gz
Isabelle 2020: afp-Deriving-2020-04-18.tar.gz
Isabelle 2019: afp-Deriving-2019-06-11.tar.gz
Isabelle 2018: afp-Deriving-2018-08-16.tar.gz
Isabelle 2017: afp-Deriving-2017-10-10.tar.gz
Isabelle 2016-1: afp-Deriving-2016-12-17.tar.gz
Isabelle 2016: afp-Deriving-2016-02-22.tar.gz
Isabelle 2015: afp-Deriving-2015-05-27.tar.gz

\ No newline at end of file diff --git a/web/entries/Diophantine_Eqns_Lin_Hom.html b/web/entries/Diophantine_Eqns_Lin_Hom.html --- a/web/entries/Diophantine_Eqns_Lin_Hom.html +++ b/web/entries/Diophantine_Eqns_Lin_Hom.html @@ -1,222 +1,222 @@ Homogeneous Linear Diophantine Equations - Archive of Formal Proofs

Homogeneous Linear Diophantine Equations

Title:	Homogeneous Linear Diophantine Equations
Authors:	Florian Messner (florian /dot/ g /dot/ messner /at/ uibk /dot/ ac /dot/ at), Julian Parsert, Jonas Schöpf (jonas /dot/ schoepf /at/ uibk /dot/ ac /dot/ at) and - Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2017-10-14
Abstract:	We formalize the theory of homogeneous linear diophantine equations, focusing on two main results: (1) an abstract characterization of minimal complete sets of solutions, and (2) an algorithm computing them. Both, the characterization and the algorithm are based on previous work by Huet. Our starting point is a simple but inefficient variant of Huet's lexicographic algorithm incorporating improved bounds due to Clausen and Fortenbacher. We proceed by proving its soundness and completeness. Finally, we employ code equations to obtain a reasonably efficient implementation. Thus, we provide a formally verified solver for homogeneous linear diophantine equations.
BibTeX:	@article{Diophantine_Eqns_Lin_Hom-AFP, author = {Florian Messner and Julian Parsert and Jonas Schöpf and Christian Sternagel}, title = {Homogeneous Linear Diophantine Equations}, journal = {Archive of Formal Proofs}, month = oct, year = 2017, note = {\url{https://isa-afp.org/entries/Diophantine_Eqns_Lin_Hom.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Diophantine_Eqns_Lin_Hom-2021-02-23.tar.gz
Isabelle 2020: afp-Diophantine_Eqns_Lin_Hom-2020-04-18.tar.gz
Isabelle 2019: afp-Diophantine_Eqns_Lin_Hom-2019-06-11.tar.gz
Isabelle 2018: afp-Diophantine_Eqns_Lin_Hom-2018-08-16.tar.gz
Isabelle 2017: afp-Diophantine_Eqns_Lin_Hom-2017-10-15.tar.gz

\ No newline at end of file diff --git a/web/entries/Efficient-Mergesort.html b/web/entries/Efficient-Mergesort.html --- a/web/entries/Efficient-Mergesort.html +++ b/web/entries/Efficient-Mergesort.html @@ -1,274 +1,274 @@ Efficient Mergesort - Archive of Formal Proofs

Efficient Mergesort

Title:	Efficient Mergesort
Author:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2011-11-09
Abstract:	We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution.
Change history:	[2012-10-24]: Added reference to journal article. [2018-09-17]: Added theory Efficient_Mergesort that works exclusively with the mutual induction schemas generated by the function package. [2018-09-19]: Added theory Mergesort_Complexity that proves an upper bound on the number of comparisons that are required by mergesort. [2018-09-19]: Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old name Efficient_Sort. [2020-11-20]: Additional theory Natural_Mergesort that developes an efficient mergesort algorithm without key-functions for educational purposes.
BibTeX:	@article{Efficient-Mergesort-AFP, author = {Christian Sternagel}, title = {Efficient Mergesort}, journal = {Archive of Formal Proofs}, month = nov, year = 2011, note = {\url{https://isa-afp.org/entries/Efficient-Mergesort.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Berlekamp_Zassenhaus, Regex_Equivalence

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Efficient-Mergesort-2021-02-23.tar.gz
Isabelle 2020: afp-Efficient-Mergesort-2020-04-18.tar.gz
Isabelle 2019: afp-Efficient-Mergesort-2019-06-11.tar.gz
Isabelle 2018: afp-Efficient-Mergesort-2018-08-16.tar.gz
Isabelle 2017: afp-Efficient-Mergesort-2017-10-10.tar.gz
Isabelle 2016-1: afp-Efficient-Mergesort-2016-12-17.tar.gz
Isabelle 2016: afp-Efficient-Mergesort-2016-02-22.tar.gz
Isabelle 2015: afp-Efficient-Mergesort-2015-05-27.tar.gz
Isabelle 2014: afp-Efficient-Mergesort-2014-08-28.tar.gz
Isabelle 2013-2: afp-Efficient-Mergesort-2013-12-11.tar.gz
Isabelle 2013-1: afp-Efficient-Mergesort-2013-11-17.tar.gz
Isabelle 2013: afp-Efficient-Mergesort-2013-03-02.tar.gz
Isabelle 2013: afp-Efficient-Mergesort-2013-02-16.tar.gz
Isabelle 2012: afp-Efficient-Mergesort-2012-05-24.tar.gz
Isabelle 2011-1: afp-Efficient-Mergesort-2011-11-10.tar.gz

\ No newline at end of file diff --git a/web/entries/Ergodic_Theory.html b/web/entries/Ergodic_Theory.html --- a/web/entries/Ergodic_Theory.html +++ b/web/entries/Ergodic_Theory.html @@ -1,225 +1,225 @@ Ergodic Theory - Archive of Formal Proofs

Ergodic Theory

- +

Title:	Ergodic Theory
Author:	Sebastien Gouezel
Contributor:	Manuel Eberl
Submission date:	2015-12-01
Abstract:	Ergodic theory is the branch of mathematics that studies the behaviour of measure preserving transformations, in finite or infinite measure. It interacts both with probability theory (mainly through measure theory) and with geometry as a lot of interesting examples are from geometric origin. We implement the first definitions and theorems of ergodic theory, including notably Poicaré recurrence theorem for finite measure preserving systems (together with the notion of conservativity in general), induced maps, Kac's theorem, Birkhoff theorem (arguably the most important theorem in ergodic theory), and variations around it such as conservativity of the corresponding skew product, or Atkinson lemma.
BibTeX:	@article{Ergodic_Theory-AFP, author = {Sebastien Gouezel}, title = {Ergodic Theory}, journal = {Archive of Formal Proofs}, month = dec, year = 2015, note = {\url{https://isa-afp.org/entries/Ergodic_Theory.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Gromov_Hyperbolicity, Laws_of_Large_Numbers, Lp
Gromov_Hyperbolicity, Laws_of_Large_Numbers, Lp, Roth_Arithmetic_Progressions

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Ergodic_Theory-2021-02-23.tar.gz
Isabelle 2020: afp-Ergodic_Theory-2020-04-18.tar.gz
Isabelle 2019: afp-Ergodic_Theory-2019-06-11.tar.gz
Isabelle 2018: afp-Ergodic_Theory-2018-08-16.tar.gz
Isabelle 2017: afp-Ergodic_Theory-2017-10-10.tar.gz
Isabelle 2016-1: afp-Ergodic_Theory-2016-12-17.tar.gz
Isabelle 2016: afp-Ergodic_Theory-2016-02-22.tar.gz

\ No newline at end of file diff --git a/web/entries/Extended_Finite_State_Machine_Inference.html b/web/entries/Extended_Finite_State_Machine_Inference.html --- a/web/entries/Extended_Finite_State_Machine_Inference.html +++ b/web/entries/Extended_Finite_State_Machine_Inference.html @@ -1,219 +1,219 @@ Inference of Extended Finite State Machines - Archive of Formal Proofs

Inference of Extended Finite State Machines

Title:	Inference of Extended Finite State Machines
Authors:	- Michael Foster (jmafoster1 /at/ sheffield /dot/ ac /dot/ uk), + Michael Foster (m /dot/ foster /at/ sheffield /dot/ ac /dot/ uk), Achim D. Brucker, Ramsay G. Taylor (r /dot/ g /dot/ taylor /at/ sheffield /dot/ ac /dot/ uk) and John Derrick (j /dot/ derrick /at/ sheffield /dot/ ac /dot/ uk)
Submission date:	2020-09-07
Abstract:	In this AFP entry, we provide a formal implementation of a state-merging technique to infer extended finite state machines (EFSMs), complete with output and update functions, from black-box traces. In particular, we define the subsumption in context relation as a means of determining whether one transition is able to account for the behaviour of another. Building on this, we define the direct subsumption relation, which lifts the subsumption in context relation to EFSM level such that we can use it to determine whether it is safe to merge a given pair of transitions. Key proofs include the conditions necessary for subsumption to occur and that subsumption and direct subsumption are preorder relations. We also provide a number of different heuristics which can be used to abstract away concrete values into registers so that more states and transitions can be merged and provide proofs of the various conditions which must hold for these abstractions to subsume their ungeneralised counterparts. A Code Generator setup to create executable Scala code is also defined.
BibTeX:	@article{Extended_Finite_State_Machine_Inference-AFP, author = {Michael Foster and Achim D. Brucker and Ramsay G. Taylor and John Derrick}, title = {Inference of Extended Finite State Machines}, journal = {Archive of Formal Proofs}, month = sep, year = 2020, note = {\url{https://isa-afp.org/entries/Extended_Finite_State_Machine_Inference.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Extended_Finite_State_Machines

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Extended_Finite_State_Machine_Inference-2021-02-23.tar.gz
Isabelle 2020: afp-Extended_Finite_State_Machine_Inference-2020-09-19.tar.gz

\ No newline at end of file diff --git a/web/entries/Extended_Finite_State_Machines.html b/web/entries/Extended_Finite_State_Machines.html --- a/web/entries/Extended_Finite_State_Machines.html +++ b/web/entries/Extended_Finite_State_Machines.html @@ -1,217 +1,217 @@ A Formal Model of Extended Finite State Machines - Archive of Formal Proofs

A Formal Model of Extended Finite State Machines

Title:	A Formal Model of Extended Finite State Machines
Authors:	- Michael Foster (jmafoster1 /at/ sheffield /dot/ ac /dot/ uk), + Michael Foster (m /dot/ foster /at/ sheffield /dot/ ac /dot/ uk), Achim D. Brucker, Ramsay G. Taylor (r /dot/ g /dot/ taylor /at/ sheffield /dot/ ac /dot/ uk) and John Derrick (j /dot/ derrick /at/ sheffield /dot/ ac /dot/ uk)
Submission date:	2020-09-07
Abstract:	In this AFP entry, we provide a formalisation of extended finite state machines (EFSMs) where models are represented as finite sets of transitions between states. EFSMs execute traces to produce observable outputs. We also define various simulation and equality metrics for EFSMs in terms of traces and prove their strengths in relation to each other. Another key contribution is a framework of function definitions such that LTL properties can be phrased over EFSMs. Finally, we provide a simple example case study in the form of a drinks machine.
BibTeX:	@article{Extended_Finite_State_Machines-AFP, author = {Michael Foster and Achim D. Brucker and Ramsay G. Taylor and John Derrick}, title = {A Formal Model of Extended Finite State Machines}, journal = {Archive of Formal Proofs}, month = sep, year = 2020, note = {\url{https://isa-afp.org/entries/Extended_Finite_State_Machines.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	FinFun
Used by:	Extended_Finite_State_Machine_Inference

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Extended_Finite_State_Machines-2021-02-23.tar.gz
Isabelle 2020: afp-Extended_Finite_State_Machines-2020-09-19.tar.gz

\ No newline at end of file diff --git a/web/entries/Factor_Algebraic_Polynomial.html b/web/entries/Factor_Algebraic_Polynomial.html --- a/web/entries/Factor_Algebraic_Polynomial.html +++ b/web/entries/Factor_Algebraic_Polynomial.html @@ -1,208 +1,208 @@ Factorization of Polynomials with Algebraic Coefficients - Archive of Formal Proofs

Factorization of Polynomials with Algebraic Coefficients

Title:	Factorization of Polynomials with Algebraic Coefficients
Authors:	Manuel Eberl and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2021-11-08
Abstract:	The AFP already contains a verified implementation of algebraic numbers. However, it is has a severe limitation in its factorization algorithm of real and complex polynomials: the factorization is only guaranteed to succeed if the coefficients of the polynomial are rational numbers. In this work, we verify an algorithm to factor all real and complex polynomials whose coefficients are algebraic. The existence of such an algorithm proves in a constructive way that the set of complex algebraic numbers is algebraically closed. Internally, the algorithm is based on resultants of multivariate polynomials and an approximation algorithm using interval arithmetic.
BibTeX:	@article{Factor_Algebraic_Polynomial-AFP, author = {Manuel Eberl and René Thiemann}, title = {Factorization of Polynomials with Algebraic Coefficients}, journal = {Archive of Formal Proofs}, month = nov, year = 2021, note = {\url{https://isa-afp.org/entries/Factor_Algebraic_Polynomial.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Algebraic_Numbers, Hermite_Lindemann, Polynomials
Used by:	Cubic_Quartic_Equations

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Factor_Algebraic_Polynomial-2021-11-14.tar.gz

\ No newline at end of file diff --git a/web/entries/Farkas.html b/web/entries/Farkas.html --- a/web/entries/Farkas.html +++ b/web/entries/Farkas.html @@ -1,222 +1,222 @@ Farkas' Lemma and Motzkin's Transposition Theorem - Archive of Formal Proofs

Farkas' Lemma and Motzkin's Transposition Theorem

Title:	Farkas' Lemma and Motzkin's Transposition Theorem
Authors:	Ralph Bottesch, Max W. Haslbeck and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2019-01-17
Abstract:	We formalize a proof of Motzkin's transposition theorem and Farkas' lemma in Isabelle/HOL. Our proof is based on the formalization of the simplex algorithm which, given a set of linear constraints, either returns a satisfying assignment to the problem or detects unsatisfiability. By reusing facts about the simplex algorithm we show that a set of linear constraints is unsatisfiable if and only if there is a linear combination of the constraints which evaluates to a trivially unsatisfiable inequality.
BibTeX:	@article{Farkas-AFP, author = {Ralph Bottesch and Max W. Haslbeck and René Thiemann}, title = {Farkas' Lemma and Motzkin's Transposition Theorem}, journal = {Archive of Formal Proofs}, month = jan, year = 2019, note = {\url{https://isa-afp.org/entries/Farkas.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Jordan_Normal_Form, Simplex
Used by:	Linear_Programming

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Farkas-2021-02-23.tar.gz
Isabelle 2020: afp-Farkas-2020-04-18.tar.gz
Isabelle 2019: afp-Farkas-2019-06-11.tar.gz
Isabelle 2018: afp-Farkas-2019-01-21.tar.gz

\ No newline at end of file diff --git a/web/entries/First_Order_Terms.html b/web/entries/First_Order_Terms.html --- a/web/entries/First_Order_Terms.html +++ b/web/entries/First_Order_Terms.html @@ -1,224 +1,224 @@ First-Order Terms - Archive of Formal Proofs

First-Order Terms

Title:	First-Order Terms
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2018-02-06
Abstract:	We formalize basic results on first-order terms, including matching and a first-order unification algorithm, as well as well-foundedness of the subsumption order. This entry is part of the Isabelle Formalization of Rewriting IsaFoR, where first-order terms are omni-present: the unification algorithm is used to certify several confluence and termination techniques, like critical-pair computation and dependency graph approximations; and the subsumption order is a crucial ingredient for completion.
BibTeX:	@article{First_Order_Terms-AFP, author = {Christian Sternagel and René Thiemann}, title = {First-Order Terms}, journal = {Archive of Formal Proofs}, month = feb, year = 2018, note = {\url{https://isa-afp.org/entries/First_Order_Terms.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Abstract-Rewriting
Used by:	Functional_Ordered_Resolution_Prover, Knuth_Bendix_Order, Resolution_FOL, Saturation_Framework_Extensions, Stateful_Protocol_Composition_and_Typing

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-First_Order_Terms-2021-02-23.tar.gz
Isabelle 2020: afp-First_Order_Terms-2020-04-18.tar.gz
Isabelle 2019: afp-First_Order_Terms-2019-06-11.tar.gz
Isabelle 2018: afp-First_Order_Terms-2018-08-16.tar.gz
Isabelle 2017: afp-First_Order_Terms-2018-02-07.tar.gz
Isabelle 2017: afp-First_Order_Terms-2018-02-06.tar.gz

\ No newline at end of file diff --git a/web/entries/Gale_Shapley.html b/web/entries/Gale_Shapley.html new file mode 100644 --- /dev/null +++ b/web/entries/Gale_Shapley.html @@ -0,0 +1,188 @@ + + + + +Gale-Shapley Algorithm - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Gale-Shapley + + Algorithm + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Gale-Shapley Algorithm
+ Author: +	+ Tobias Nipkow +
Submission date:	2021-12-29
Abstract:	+This is a stepwise refinement and proof of the Gale-Shapley stable +matching (or marriage) algorithm down to executable code. Both a +purely functional implementation based on lists and a functional +implementation based on efficient arrays (provided by the Collections +Framework in the AFP) are developed. The latter implementation runs in +time O(n²) where +n is the cardinality of the two sets to be matched.
BibTeX:	+ @article{Gale_Shapley-AFP, + author = {Tobias Nipkow}, + title = {Gale-Shapley Algorithm}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/Gale_Shapley.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License
Depends on:	Collections, List-Index

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Gauss_Jordan.html b/web/entries/Gauss_Jordan.html --- a/web/entries/Gauss_Jordan.html +++ b/web/entries/Gauss_Jordan.html @@ -1,236 +1,236 @@ Gauss-Jordan Algorithm and Its Applications - Archive of Formal Proofs

Gauss-Jordan Algorithm and Its Applications

- +

Title:	Gauss-Jordan Algorithm and Its Applications
Authors:	Jose Divasón and Jesús Aransay
Submission date:	2014-09-03
Abstract:	The Gauss-Jordan algorithm states that any matrix over a field can be transformed by means of elementary row operations to a matrix in reduced row echelon form. The formalization is based on the Rank Nullity Theorem entry of the AFP and on the HOL-Multivariate-Analysis session of Isabelle, where matrices are represented as functions over finite types. We have set up the code generator to make this representation executable. In order to improve the performance, a refinement to immutable arrays has been carried out. We have formalized some of the applications of the Gauss-Jordan algorithm. Thanks to this development, the following facts can be computed over matrices whose elements belong to a field: Ranks, Determinants, Inverses, Bases and dimensions and Solutions of systems of linear equations. Code can be exported to SML and Haskell.
BibTeX:	@article{Gauss_Jordan-AFP, author = {Jose Divasón and Jesús Aransay}, title = {Gauss-Jordan Algorithm and Its Applications}, journal = {Archive of Formal Proofs}, month = sep, year = 2014, note = {\url{https://isa-afp.org/entries/Gauss_Jordan.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Rank_Nullity_Theorem
Used by:	Echelon_Form, Polynomial_Factorization, QR_Decomposition
Echelon_Form, MDP-Algorithms, Polynomial_Factorization, QR_Decomposition

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Gauss_Jordan-2021-02-23.tar.gz
Isabelle 2020: afp-Gauss_Jordan-2020-04-18.tar.gz
Isabelle 2019: afp-Gauss_Jordan-2019-06-11.tar.gz
Isabelle 2018: afp-Gauss_Jordan-2018-08-16.tar.gz
Isabelle 2017: afp-Gauss_Jordan-2017-10-10.tar.gz
Isabelle 2016-1: afp-Gauss_Jordan-2016-12-17.tar.gz
Isabelle 2016: afp-Gauss_Jordan-2016-02-22.tar.gz
Isabelle 2015: afp-Gauss_Jordan-2015-05-27.tar.gz
Isabelle 2014: afp-Gauss_Jordan-2014-09-03.tar.gz

\ No newline at end of file diff --git a/web/entries/Girth_Chromatic.html b/web/entries/Girth_Chromatic.html --- a/web/entries/Girth_Chromatic.html +++ b/web/entries/Girth_Chromatic.html @@ -1,264 +1,264 @@ A Probabilistic Proof of the Girth-Chromatic Number Theorem - Archive of Formal Proofs

A Probabilistic Proof of the Girth-Chromatic Number Theorem

- +

Title:	A Probabilistic Proof of the Girth-Chromatic Number Theorem
Author:	Lars Noschinski
Submission date:	2012-02-06
Abstract:	This works presents a formalization of the Girth-Chromatic number theorem in graph theory, stating that graphs with arbitrarily large girth and chromatic number exist. The proof uses the theory of Random Graphs to prove the existence with probabilistic arguments.
BibTeX:	@article{Girth_Chromatic-AFP, author = {Lars Noschinski}, title = {A Probabilistic Proof of the Girth-Chromatic Number Theorem}, journal = {Archive of Formal Proofs}, month = feb, year = 2012, note = {\url{https://isa-afp.org/entries/Girth_Chromatic.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Random_Graph_Subgraph_Threshold, Szemeredi_Regularity
Random_Graph_Subgraph_Threshold, Roth_Arithmetic_Progressions, Szemeredi_Regularity

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Girth_Chromatic-2021-02-23.tar.gz
Isabelle 2020: afp-Girth_Chromatic-2020-04-18.tar.gz
Isabelle 2019: afp-Girth_Chromatic-2019-06-11.tar.gz
Isabelle 2018: afp-Girth_Chromatic-2018-08-16.tar.gz
Isabelle 2017: afp-Girth_Chromatic-2017-10-10.tar.gz
Isabelle 2016-1: afp-Girth_Chromatic-2016-12-17.tar.gz
Isabelle 2016: afp-Girth_Chromatic-2016-02-22.tar.gz
Isabelle 2015: afp-Girth_Chromatic-2015-05-27.tar.gz
Isabelle 2014: afp-Girth_Chromatic-2014-08-28.tar.gz
Isabelle 2013-2: afp-Girth_Chromatic-2013-12-11.tar.gz
Isabelle 2013-1: afp-Girth_Chromatic-2013-11-17.tar.gz
Isabelle 2013: afp-Girth_Chromatic-2013-02-16.tar.gz
Isabelle 2012: afp-Girth_Chromatic-2012-05-24.tar.gz
Isabelle 2011-1: afp-Girth_Chromatic-2012-02-06.tar.gz

\ No newline at end of file diff --git a/web/entries/Goodstein_Lambda.html b/web/entries/Goodstein_Lambda.html --- a/web/entries/Goodstein_Lambda.html +++ b/web/entries/Goodstein_Lambda.html @@ -1,210 +1,210 @@ Implementing the Goodstein Function in λ-Calculus - Archive of Formal Proofs

Implementing the Goodstein Function in λ-Calculus

Title:	Implementing the Goodstein Function in λ-Calculus
Author:	- Bertram Felgenhauer (int-e /at/ gmx /dot/ de) + Bertram Felgenhauer
Submission date:	2020-02-21
Abstract:	In this formalization, we develop an implementation of the Goodstein function G in plain λ-calculus, linked to a concise, self-contained specification. The implementation works on a Church-encoded representation of countable ordinals. The initial conversion to hereditary base 2 is not covered, but the material is sufficient to compute the particular value G(16), and easily extends to other fixed arguments.
BibTeX:	@article{Goodstein_Lambda-AFP, author = {Bertram Felgenhauer}, title = {Implementing the Goodstein Function in λ-Calculus}, journal = {Archive of Formal Proofs}, month = feb, year = 2020, note = {\url{https://isa-afp.org/entries/Goodstein_Lambda.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Goodstein_Lambda-2021-02-23.tar.gz
Isabelle 2020: afp-Goodstein_Lambda-2020-04-18.tar.gz
Isabelle 2019: afp-Goodstein_Lambda-2020-02-24.tar.gz

\ No newline at end of file diff --git a/web/entries/HOLCF-Prelude.html b/web/entries/HOLCF-Prelude.html --- a/web/entries/HOLCF-Prelude.html +++ b/web/entries/HOLCF-Prelude.html @@ -1,220 +1,220 @@ HOLCF-Prelude - Archive of Formal Proofs

HOLCF-Prelude

Title:	HOLCF-Prelude
Authors:	Joachim Breitner (joachim /at/ cis /dot/ upenn /dot/ edu), Brian Huffman, Neil Mitchell and - Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2017-07-15
Abstract:	The Isabelle/HOLCF-Prelude is a formalization of a large part of Haskell's standard prelude in Isabelle/HOLCF. We use it to prove the correctness of the Eratosthenes' Sieve, in its self-referential implementation commonly used to showcase Haskell's laziness; prove correctness of GHC's "fold/build" rule and related rewrite rules; and certify a number of hints suggested by HLint.
BibTeX:	@article{HOLCF-Prelude-AFP, author = {Joachim Breitner and Brian Huffman and Neil Mitchell and Christian Sternagel}, title = {HOLCF-Prelude}, journal = {Archive of Formal Proofs}, month = jul, year = 2017, note = {\url{https://isa-afp.org/entries/HOLCF-Prelude.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	BirdKMP

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-HOLCF-Prelude-2021-02-23.tar.gz
Isabelle 2020: afp-HOLCF-Prelude-2020-04-18.tar.gz
Isabelle 2019: afp-HOLCF-Prelude-2019-06-11.tar.gz
Isabelle 2018: afp-HOLCF-Prelude-2018-08-16.tar.gz
Isabelle 2017: afp-HOLCF-Prelude-2017-10-10.tar.gz
Isabelle 2016-1: afp-HOLCF-Prelude-2017-07-15.tar.gz

\ No newline at end of file diff --git a/web/entries/Hyperdual.html b/web/entries/Hyperdual.html new file mode 100644 --- /dev/null +++ b/web/entries/Hyperdual.html @@ -0,0 +1,203 @@ + + + + +Hyperdual Numbers and Forward Differentiation - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Hyperdual + + Numbers + + and + + Forward + + Differentiation + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Hyperdual Numbers and Forward Differentiation
+ Authors: +	+ Filip Smola and + Jacques Fleuriot +
Submission date:	2021-12-31
Abstract:	+ Hyperdual numbers are ones with a real component and a number +of infinitesimal components, usually written as $a_0 + a_1 \cdot +\epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$. +They have been proposed by Fike and +Alonso in an approach to automatic +differentiation. In this entry we formalise +hyperdual numbers and their application to forward differentiation. We +show them to be an instance of multiple algebraic structures and then, +along with facts about twice-differentiability, we define what we call +the hyperdual extensions of functions on real-normed fields. This +extension formally represents the proposed way that the first and +second derivatives of a function can be automatically calculated. We +demonstrate it on the standard logistic function $f(x) = \frac{1}{1 + +e^{-x}}$ and also reproduce the example analytic function $f(x) = +\frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike +and Alonso.
BibTeX:	+ @article{Hyperdual-AFP, + author = {Filip Smola and Jacques Fleuriot}, + title = {Hyperdual Numbers and Forward Differentiation}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/Hyperdual.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Imperative_Insertion_Sort.html b/web/entries/Imperative_Insertion_Sort.html --- a/web/entries/Imperative_Insertion_Sort.html +++ b/web/entries/Imperative_Insertion_Sort.html @@ -1,227 +1,227 @@ Imperative Insertion Sort - Archive of Formal Proofs

Imperative Insertion Sort

Title:	Imperative Insertion Sort
Author:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2014-09-25
Abstract:	The insertion sort algorithm of Cormen et al. (Introduction to Algorithms) is expressed in Imperative HOL and proved to be correct and terminating. For this purpose we also provide a theory about imperative loop constructs with accompanying induction/invariant rules for proving partial and total correctness. Furthermore, the formalized algorithm is fit for code generation.
BibTeX:	@article{Imperative_Insertion_Sort-AFP, author = {Christian Sternagel}, title = {Imperative Insertion Sort}, journal = {Archive of Formal Proofs}, month = sep, year = 2014, note = {\url{https://isa-afp.org/entries/Imperative_Insertion_Sort.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Imperative_Insertion_Sort-2021-02-23.tar.gz
Isabelle 2020: afp-Imperative_Insertion_Sort-2020-04-18.tar.gz
Isabelle 2019: afp-Imperative_Insertion_Sort-2019-06-11.tar.gz
Isabelle 2018: afp-Imperative_Insertion_Sort-2018-08-16.tar.gz
Isabelle 2017: afp-Imperative_Insertion_Sort-2017-10-10.tar.gz
Isabelle 2016-1: afp-Imperative_Insertion_Sort-2016-12-17.tar.gz
Isabelle 2016: afp-Imperative_Insertion_Sort-2016-02-22.tar.gz
Isabelle 2015: afp-Imperative_Insertion_Sort-2015-05-27.tar.gz
Isabelle 2014: afp-Imperative_Insertion_Sort-2014-09-25.tar.gz

\ No newline at end of file diff --git a/web/entries/Irrational_Series_Erdos_Straus.html b/web/entries/Irrational_Series_Erdos_Straus.html --- a/web/entries/Irrational_Series_Erdos_Straus.html +++ b/web/entries/Irrational_Series_Erdos_Straus.html @@ -1,217 +1,217 @@ Irrationality Criteria for Series by Erdős and Straus - Archive of Formal Proofs

Irrationality Criteria for Series by Erdős and Straus

Title:	Irrationality Criteria for Series by Erdős and Straus
Authors:	- Angeliki Koutsoukou-Argyraki and + Angeliki Koutsoukou-Argyraki and Wenda Li
Submission date:	2020-05-12
Abstract:	We formalise certain irrationality criteria for infinite series of the form: \[\sum_{n=1}^\infty \frac{b_n}{\prod_{i=1}^n a_i} \] where $\{b_n\}$ is a sequence of integers and $\{a_n\}$ a sequence of positive integers with $a_n >1$ for all large n. The results are due to P. Erdős and E. G. Straus [1]. In particular, we formalise Theorem 2.1, Corollary 2.10 and Theorem 3.1. The latter is an application of Theorem 2.1 involving the prime numbers.
BibTeX:	@article{Irrational_Series_Erdos_Straus-AFP, author = {Angeliki Koutsoukou-Argyraki and Wenda Li}, title = {Irrationality Criteria for Series by Erdős and Straus}, journal = {Archive of Formal Proofs}, month = may, year = 2020, note = {\url{https://isa-afp.org/entries/Irrational_Series_Erdos_Straus.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Prime_Distribution_Elementary, Prime_Number_Theorem

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Irrational_Series_Erdos_Straus-2021-02-23.tar.gz
Isabelle 2020: afp-Irrational_Series_Erdos_Straus-2020-05-14.tar.gz
Isabelle 2020: afp-Irrational_Series_Erdos_Straus-2020-05-13.tar.gz

\ No newline at end of file diff --git a/web/entries/Irrationality_J_Hancl.html b/web/entries/Irrationality_J_Hancl.html --- a/web/entries/Irrationality_J_Hancl.html +++ b/web/entries/Irrationality_J_Hancl.html @@ -1,216 +1,216 @@ Irrational Rapidly Convergent Series - Archive of Formal Proofs

Irrational Rapidly Convergent Series

Title:	Irrational Rapidly Convergent Series
Authors:	- Angeliki Koutsoukou-Argyraki and + Angeliki Koutsoukou-Argyraki and Wenda Li
Submission date:	2018-05-23
Abstract:	We formalize with Isabelle/HOL a proof of a theorem by J. Hancl asserting the irrationality of the sum of a series consisting of rational numbers, built up by sequences that fulfill certain properties. Even though the criterion is a number theoretic result, the proof makes use only of analytical arguments. We also formalize a corollary of the theorem for a specific series fulfilling the assumptions of the theorem.
BibTeX:	@article{Irrationality_J_Hancl-AFP, author = {Angeliki Koutsoukou-Argyraki and Wenda Li}, title = {Irrational Rapidly Convergent Series}, journal = {Archive of Formal Proofs}, month = may, year = 2018, note = {\url{https://isa-afp.org/entries/Irrationality_J_Hancl.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Irrationality_J_Hancl-2021-02-23.tar.gz
Isabelle 2020: afp-Irrationality_J_Hancl-2020-04-18.tar.gz
Isabelle 2019: afp-Irrationality_J_Hancl-2019-06-11.tar.gz
Isabelle 2018: afp-Irrationality_J_Hancl-2018-08-16.tar.gz
Isabelle 2017: afp-Irrationality_J_Hancl-2018-05-26.tar.gz

\ No newline at end of file diff --git a/web/entries/Jordan_Normal_Form.html b/web/entries/Jordan_Normal_Form.html --- a/web/entries/Jordan_Normal_Form.html +++ b/web/entries/Jordan_Normal_Form.html @@ -1,259 +1,259 @@ Matrices, Jordan Normal Forms, and Spectral Radius Theory - Archive of Formal Proofs

Matrices, Jordan Normal Forms, and Spectral Radius Theory

Title:	Matrices, Jordan Normal Forms, and Spectral Radius Theory
Authors:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Contributor:	Alexander Bentkamp (bentkamp /at/ gmail /dot/ com)
Submission date:	2015-08-21
Abstract:	Matrix interpretations are useful as measure functions in termination proving. In order to use these interpretations also for complexity analysis, the growth rate of matrix powers has to examined. Here, we formalized a central result of spectral radius theory, namely that the growth rate is polynomially bounded if and only if the spectral radius of a matrix is at most one. To formally prove this result we first studied the growth rates of matrices in Jordan normal form, and prove the result that every complex matrix has a Jordan normal form using a constructive prove via Schur decomposition. The whole development is based on a new abstract type for matrices, which is also executable by a suitable setup of the code generator. It completely subsumes our former AFP-entry on executable matrices, and its main advantage is its close connection to the HMA-representation which allowed us to easily adapt existing proofs on determinants. All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates.
Change history:	[2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms [2018-04-17]: Integrated lemmas from deep-learning AFP-entry of Alexander Bentkamp
BibTeX:	@article{Jordan_Normal_Form-AFP, author = {René Thiemann and Akihisa Yamada}, title = {Matrices, Jordan Normal Forms, and Spectral Radius Theory}, journal = {Archive of Formal Proofs}, month = aug, year = 2015, note = {\url{https://isa-afp.org/entries/Jordan_Normal_Form.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Polynomial_Factorization
Used by:	Complex_Bounded_Operators, Deep_Learning, Farkas, Groebner_Bases, Isabelle_Marries_Dirac, Linear_Programming, Modular_arithmetic_LLL_and_HNF_algorithms, Perron_Frobenius, QHLProver, Simplicial_complexes_and_boolean_functions, Stochastic_Matrices, Subresultants

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Jordan_Normal_Form-2021-02-23.tar.gz
Isabelle 2020: afp-Jordan_Normal_Form-2020-04-18.tar.gz
Isabelle 2019: afp-Jordan_Normal_Form-2019-06-11.tar.gz
Isabelle 2018: afp-Jordan_Normal_Form-2018-08-16.tar.gz
Isabelle 2017: afp-Jordan_Normal_Form-2017-10-10.tar.gz
Isabelle 2016-1: afp-Jordan_Normal_Form-2016-12-17.tar.gz
Isabelle 2016: afp-Jordan_Normal_Form-2016-02-22.tar.gz
Isabelle 2015: afp-Jordan_Normal_Form-2015-08-23.tar.gz

\ No newline at end of file diff --git a/web/entries/Knights_Tour.html b/web/entries/Knights_Tour.html new file mode 100644 --- /dev/null +++ b/web/entries/Knights_Tour.html @@ -0,0 +1,195 @@ + + + + +Knight's Tour Revisited Revisited - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Knight's + + Tour + + Revisited + + Revisited + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Knight's Tour Revisited Revisited
+ Author: +	+ Lukas Koller (lukas /dot/ koller /at/ tum /dot/ de) +
Submission date:	2022-01-04
Abstract:	+This is a formalization of the article Knight's Tour Revisited by +Cull and De Curtins where they prove the existence of a Knight's +path for arbitrary n × m-boards with min(n,m) ≥ +5. If n · m is even, then there exists a Knight's +circuit. A Knight's Path is a sequence of moves of a Knight on a +chessboard s.t. the Knight visits every square of a chessboard +exactly once. Finding a Knight's path is a an instance of the +Hamiltonian path problem. A Knight's circuit is a Knight's path, +where additionally the Knight can move from the last square to the +first square of the path, forming a loop. During the formalization +two mistakes in the original proof were discovered. These mistakes +are corrected in this formalization.
BibTeX:	+ @article{Knights_Tour-AFP, + author = {Lukas Koller}, + title = {Knight's Tour Revisited Revisited}, + journal = {Archive of Formal Proofs}, + month = jan, + year = 2022, + note = {\url{https://isa-afp.org/entries/Knights_Tour.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Knuth_Bendix_Order.html b/web/entries/Knuth_Bendix_Order.html --- a/web/entries/Knuth_Bendix_Order.html +++ b/web/entries/Knuth_Bendix_Order.html @@ -1,211 +1,211 @@ A Formalization of Knuth–Bendix Orders - Archive of Formal Proofs

A Formalization of Knuth–Bendix Orders

- +

Title:	A Formalization of Knuth–Bendix Orders
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2020-05-13
Abstract:	We define a generalized version of Knuth–Bendix orders, including subterm coefficient functions. For these orders we formalize several properties such as strong normalization, the subterm property, closure properties under substitutions and contexts, as well as ground totality.
BibTeX:	@article{Knuth_Bendix_Order-AFP, author = {Christian Sternagel and René Thiemann}, title = {A Formalization of Knuth–Bendix Orders}, journal = {Archive of Formal Proofs}, month = may, year = 2020, note = {\url{https://isa-afp.org/entries/Knuth_Bendix_Order.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	First_Order_Terms, Matrix, Polynomial_Factorization
Used by:	Functional_Ordered_Resolution_Prover, Weighted_Path_Order
Functional_Ordered_Resolution_Prover, Regular_Tree_Relations, Weighted_Path_Order

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Knuth_Bendix_Order-2021-02-23.tar.gz
Isabelle 2020: afp-Knuth_Bendix_Order-2020-05-16.tar.gz
Isabelle 2020: afp-Knuth_Bendix_Order-2020-05-15.tar.gz

\ No newline at end of file diff --git a/web/entries/LLL_Basis_Reduction.html b/web/entries/LLL_Basis_Reduction.html --- a/web/entries/LLL_Basis_Reduction.html +++ b/web/entries/LLL_Basis_Reduction.html @@ -1,241 +1,241 @@ A verified LLL algorithm - Archive of Formal Proofs

A verified LLL algorithm

Title:	A verified LLL algorithm
Authors:	Ralph Bottesch, Jose Divasón, Maximilian Haslbeck, Sebastiaan Joosten, - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2018-02-02
Abstract:	The Lenstra-Lenstra-Lovász basis reduction algorithm, also known as LLL algorithm, is an algorithm to find a basis with short, nearly orthogonal vectors of an integer lattice. Thereby, it can also be seen as an approximation to solve the shortest vector problem (SVP), which is an NP-hard problem, where the approximation quality solely depends on the dimension of the lattice, but not the lattice itself. The algorithm also possesses many applications in diverse fields of computer science, from cryptanalysis to number theory, but it is specially well-known since it was used to implement the first polynomial-time algorithm to factor polynomials. In this work we present the first mechanized soundness proof of the LLL algorithm to compute short vectors in lattices. The formalization follows a textbook by von zur Gathen and Gerhard.
Change history:	[2018-04-16]: Integrated formal complexity bounds (Haslbeck, Thiemann) [2018-05-25]: Integrated much faster LLL implementation based on integer arithmetic (Bottesch, Haslbeck, Thiemann)
BibTeX:	@article{LLL_Basis_Reduction-AFP, author = {Ralph Bottesch and Jose Divasón and Maximilian Haslbeck and Sebastiaan Joosten and René Thiemann and Akihisa Yamada}, title = {A verified LLL algorithm}, journal = {Archive of Formal Proofs}, month = feb, year = 2018, note = {\url{https://isa-afp.org/entries/LLL_Basis_Reduction.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Algebraic_Numbers, Berlekamp_Zassenhaus
Used by:	Linear_Inequalities, LLL_Factorization, Modular_arithmetic_LLL_and_HNF_algorithms

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-LLL_Basis_Reduction-2021-02-23.tar.gz
Isabelle 2020: afp-LLL_Basis_Reduction-2020-04-20.tar.gz
Isabelle 2019: afp-LLL_Basis_Reduction-2019-06-11.tar.gz
Isabelle 2018: afp-LLL_Basis_Reduction-2018-09-07.tar.gz
Isabelle 2018: afp-LLL_Basis_Reduction-2018-08-16.tar.gz
Isabelle 2017: afp-LLL_Basis_Reduction-2018-02-03.tar.gz

\ No newline at end of file diff --git a/web/entries/LLL_Factorization.html b/web/entries/LLL_Factorization.html --- a/web/entries/LLL_Factorization.html +++ b/web/entries/LLL_Factorization.html @@ -1,239 +1,239 @@ A verified factorization algorithm for integer polynomials with polynomial complexity - Archive of Formal Proofs

A verified factorization algorithm for integer polynomials with polynomial complexity

Title:	A verified factorization algorithm for integer polynomials with polynomial complexity
Authors:	Jose Divasón, Sebastiaan Joosten, - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2018-02-06
Abstract:	Short vectors in lattices and factors of integer polynomials are related. Each factor of an integer polynomial belongs to a certain lattice. When factoring polynomials, the condition that we are looking for an irreducible polynomial means that we must look for a small element in a lattice, which can be done by a basis reduction algorithm. In this development we formalize this connection and thereby one main application of the LLL basis reduction algorithm: an algorithm to factor square-free integer polynomials which runs in polynomial time. The work is based on our previous Berlekamp–Zassenhaus development, where the exponential reconstruction phase has been replaced by the polynomial-time basis reduction algorithm. Thanks to this formalization we found a serious flaw in a textbook.
BibTeX:	@article{LLL_Factorization-AFP, author = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada}, title = {A verified factorization algorithm for integer polynomials with polynomial complexity}, journal = {Archive of Formal Proofs}, month = feb, year = 2018, note = {\url{https://isa-afp.org/entries/LLL_Factorization.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	LLL_Basis_Reduction, Perron_Frobenius

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-LLL_Factorization-2021-02-23.tar.gz
Isabelle 2020: afp-LLL_Factorization-2020-04-20.tar.gz
Isabelle 2019: afp-LLL_Factorization-2019-06-11.tar.gz
Isabelle 2018: afp-LLL_Factorization-2018-08-16.tar.gz
Isabelle 2017: afp-LLL_Factorization-2018-02-07.tar.gz

\ No newline at end of file diff --git a/web/entries/Lifting_Definition_Option.html b/web/entries/Lifting_Definition_Option.html --- a/web/entries/Lifting_Definition_Option.html +++ b/web/entries/Lifting_Definition_Option.html @@ -1,241 +1,241 @@ Lifting Definition Option - Archive of Formal Proofs

Lifting Definition Option

Title:	Lifting Definition Option
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2014-10-13
Abstract:	We implemented a command that can be used to easily generate elements of a restricted type `{x :: 'a. P x}`, provided the definition is of the form `f ys = (if check ys then Some(generate ys :: 'a) else None)` where `ys` is a list of variables `y1 ... yn` and `check ys ==> P(generate ys)` can be proved. In principle, such a definition is also directly possible using the `lift_definition` command. However, then this definition will not be suitable for code-generation. To this end, we automated a more complex construction of Joachim Breitner which is amenable for code-generation, and where the test `check ys` will only be performed once. In the automation, one auxiliary type is created, and Isabelle's lifting- and transfer-package is invoked several times.
BibTeX:	@article{Lifting_Definition_Option-AFP, author = {René Thiemann}, title = {Lifting Definition Option}, journal = {Archive of Formal Proofs}, month = oct, year = 2014, note = {\url{https://isa-afp.org/entries/Lifting_Definition_Option.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Lifting_Definition_Option-2021-02-23.tar.gz
Isabelle 2020: afp-Lifting_Definition_Option-2020-04-18.tar.gz
Isabelle 2019: afp-Lifting_Definition_Option-2019-06-11.tar.gz
Isabelle 2018: afp-Lifting_Definition_Option-2018-08-16.tar.gz
Isabelle 2017: afp-Lifting_Definition_Option-2017-10-10.tar.gz
Isabelle 2016-1: afp-Lifting_Definition_Option-2016-12-17.tar.gz
Isabelle 2016: afp-Lifting_Definition_Option-2016-02-22.tar.gz
Isabelle 2015: afp-Lifting_Definition_Option-2015-05-27.tar.gz
Isabelle 2014: afp-Lifting_Definition_Option-2014-10-15.tar.gz

\ No newline at end of file diff --git a/web/entries/Linear_Inequalities.html b/web/entries/Linear_Inequalities.html --- a/web/entries/Linear_Inequalities.html +++ b/web/entries/Linear_Inequalities.html @@ -1,209 +1,209 @@ Linear Inequalities - Archive of Formal Proofs

Linear Inequalities

Title:	Linear Inequalities
Authors:	Ralph Bottesch, Alban Reynaud and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2019-06-21
Abstract:	We formalize results about linear inqualities, mainly from Schrijver's book. The main results are the proof of the fundamental theorem on linear inequalities, Farkas' lemma, Carathéodory's theorem, the Farkas-Minkowsky-Weyl theorem, the decomposition theorem of polyhedra, and Meyer's result that the integer hull of a polyhedron is a polyhedron itself. Several theorems include bounds on the appearing numbers, and in particular we provide an a-priori bound on mixed-integer solutions of linear inequalities.
BibTeX:	@article{Linear_Inequalities-AFP, author = {Ralph Bottesch and Alban Reynaud and René Thiemann}, title = {Linear Inequalities}, journal = {Archive of Formal Proofs}, month = jun, year = 2019, note = {\url{https://isa-afp.org/entries/Linear_Inequalities.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	LLL_Basis_Reduction
Used by:	Linear_Programming

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Linear_Inequalities-2021-02-23.tar.gz
Isabelle 2020: afp-Linear_Inequalities-2020-04-18.tar.gz
Isabelle 2019: afp-Linear_Inequalities-2019-06-24.tar.gz

\ No newline at end of file diff --git a/web/entries/List-Index.html b/web/entries/List-Index.html --- a/web/entries/List-Index.html +++ b/web/entries/List-Index.html @@ -1,267 +1,267 @@ List Index - Archive of Formal Proofs

List Index

- +

Title:	List Index
Author:	Tobias Nipkow
Submission date:	2010-02-20
Abstract:	This theory provides functions for finding the index of an element in a list, by predicate and by value.
BibTeX:	@article{List-Index-AFP, author = {Tobias Nipkow}, title = {List Index}, journal = {Archive of Formal Proofs}, month = feb, year = 2010, note = {\url{https://isa-afp.org/entries/List-Index.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Affine_Arithmetic, Comparison_Sort_Lower_Bound, Dominance_CHK, Formula_Derivatives, Higher_Order_Terms, Jinja, JinjaDCI, List_Update, LTL_to_DRA, Metalogic_ProofChecker, MSO_Regex_Equivalence, Nested_Multisets_Ordinals, Ordinary_Differential_Equations, Planarity_Certificates, Quick_Sort_Cost, Randomised_Social_Choice, Refine_Imperative_HOL, Smith_Normal_Form, Verified_SAT_Based_AI_Planning
Affine_Arithmetic, Comparison_Sort_Lower_Bound, Dominance_CHK, Formula_Derivatives, Gale_Shapley, Higher_Order_Terms, Jinja, JinjaDCI, List_Update, LTL_to_DRA, Metalogic_ProofChecker, MSO_Regex_Equivalence, Nested_Multisets_Ordinals, Ordinary_Differential_Equations, Planarity_Certificates, Quick_Sort_Cost, Randomised_Social_Choice, Refine_Imperative_HOL, Smith_Normal_Form, Verified_SAT_Based_AI_Planning

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-List-Index-2021-02-23.tar.gz
Isabelle 2020: afp-List-Index-2020-04-20.tar.gz
Isabelle 2019: afp-List-Index-2019-06-11.tar.gz
Isabelle 2018: afp-List-Index-2018-08-16.tar.gz
Isabelle 2017: afp-List-Index-2017-10-10.tar.gz
Isabelle 2016-1: afp-List-Index-2016-12-17.tar.gz
Isabelle 2016: afp-List-Index-2016-02-22.tar.gz
Isabelle 2015: afp-List-Index-2015-05-27.tar.gz
Isabelle 2014: afp-List-Index-2014-08-28.tar.gz
Isabelle 2013-2: afp-List-Index-2013-12-11.tar.gz
Isabelle 2013-1: afp-List-Index-2013-11-17.tar.gz
Isabelle 2013: afp-List-Index-2013-02-16.tar.gz
Isabelle 2012: afp-List-Index-2012-05-24.tar.gz
Isabelle 2011-1: afp-List-Index-2011-10-11.tar.gz
Isabelle 2011: afp-List-Index-2011-02-11.tar.gz
Isabelle 2009-2: afp-List-Index-2010-07-01.tar.gz
Isabelle 2009-1: afp-List-Index-2010-02-20.tar.gz

\ No newline at end of file diff --git a/web/entries/MDP-Algorithms.html b/web/entries/MDP-Algorithms.html new file mode 100644 --- /dev/null +++ b/web/entries/MDP-Algorithms.html @@ -0,0 +1,206 @@ + + + + +Verified Algorithms for Solving Markov Decision Processes - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Verified + + Algorithms + + for + + Solving + + Markov + + Decision + + Processes + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Verified Algorithms for Solving Markov Decision Processes
+ Authors: +	+ Maximilian Schäffeler (schaeffm /at/ in /dot/ tum /dot/ de) and + Mohammad Abdulaziz +
Submission date:	2021-12-16
Abstract:	+We present a formalization of algorithms for solving Markov Decision +Processes (MDPs) with formal guarantees on the optimality of their +solutions. In particular we build on our analysis of the Bellman +operator for discounted infinite horizon MDPs. From the iterator rule +on the Bellman operator we directly derive executable value iteration +and policy iteration algorithms to iteratively solve finite MDPs. We +also prove correct optimized versions of value iteration that use +matrix splittings to improve the convergence rate. In particular, we +formally verify Gauss-Seidel value iteration and modified policy +iteration. The algorithms are evaluated on two standard examples from +the literature, namely, inventory management and gridworld. Our +formalization covers most of chapter 6 in Puterman's book +"Markov Decision Processes: Discrete Stochastic Dynamic +Programming".
BibTeX:	+ @article{MDP-Algorithms-AFP, + author = {Maximilian Schäffeler and Mohammad Abdulaziz}, + title = {Verified Algorithms for Solving Markov Decision Processes}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/MDP-Algorithms.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License
Depends on:	Gauss_Jordan, MDP-Rewards

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/MDP-Rewards.html b/web/entries/MDP-Rewards.html new file mode 100644 --- /dev/null +++ b/web/entries/MDP-Rewards.html @@ -0,0 +1,200 @@ + + + + +Markov Decision Processes with Rewards - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Markov + + Decision + + Processes + + with + + Rewards + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Markov Decision Processes with Rewards
+ Authors: +	+ Maximilian Schäffeler (schaeffm /at/ in /dot/ tum /dot/ de) and + Mohammad Abdulaziz +
Submission date:	2021-12-16
Abstract:	+We present a formalization of Markov Decision Processes with rewards. +In particular we first build on Hölzl's formalization of MDPs +(AFP entry: Markov_Models) and extend them with rewards. We proceed +with an analysis of the expected total discounted reward criterion for +infinite horizon MDPs. The central result is the construction of the +iteration rule for the Bellman operator. We prove the optimality +equations for this operator and show the existence of an optimal +stationary deterministic solution. The analysis can be used to obtain +dynamic programming algorithms such as value iteration and policy +iteration to solve MDPs with formal guarantees. Our formalization is +based on chapters 5 and 6 in Puterman's book "Markov +Decision Processes: Discrete Stochastic Dynamic Programming".
BibTeX:	+ @article{MDP-Rewards-AFP, + author = {Maximilian Schäffeler and Mohammad Abdulaziz}, + title = {Markov Decision Processes with Rewards}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/MDP-Rewards.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License
Used by:	MDP-Algorithms

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Matrix.html b/web/entries/Matrix.html --- a/web/entries/Matrix.html +++ b/web/entries/Matrix.html @@ -1,298 +1,298 @@ Executable Matrix Operations on Matrices of Arbitrary Dimensions - Archive of Formal Proofs

Executable Matrix Operations on Matrices of Arbitrary Dimensions

Title:	Executable Matrix Operations on Matrices of Arbitrary Dimensions
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2010-06-17
Abstract:	We provide the operations of matrix addition, multiplication, transposition, and matrix comparisons as executable functions over ordered semirings. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over matrices. We further show that the standard semirings over the naturals, integers, and rationals, as well as the arctic semirings satisfy the axioms that are required by our matrix theory. Our formalization is part of the CeTA system which contains several termination techniques. The provided theories have been essential to formalize matrix-interpretations and arctic interpretations.
Change history:	[2010-09-17]: Moved theory on arbitrary (ordered) semirings to Abstract Rewriting.
BibTeX:	@article{Matrix-AFP, author = {Christian Sternagel and René Thiemann}, title = {Executable Matrix Operations on Matrices of Arbitrary Dimensions}, journal = {Archive of Formal Proofs}, month = jun, year = 2010, note = {\url{https://isa-afp.org/entries/Matrix.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Abstract-Rewriting
Used by:	Knuth_Bendix_Order, Matrix_Tensor, Polynomial_Factorization, Polynomials, Transitive-Closure

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Matrix-2021-02-23.tar.gz
Isabelle 2020: afp-Matrix-2020-04-20.tar.gz
Isabelle 2019: afp-Matrix-2019-06-11.tar.gz
Isabelle 2018: afp-Matrix-2018-08-16.tar.gz
Isabelle 2017: afp-Matrix-2017-10-10.tar.gz
Isabelle 2016-1: afp-Matrix-2016-12-17.tar.gz
Isabelle 2016: afp-Matrix-2016-02-22.tar.gz
Isabelle 2015: afp-Matrix-2015-05-27.tar.gz
Isabelle 2014: afp-Matrix-2014-08-28.tar.gz
Isabelle 2013-2: afp-Matrix-2013-12-11.tar.gz
Isabelle 2013-1: afp-Matrix-2013-11-17.tar.gz
Isabelle 2013: afp-Matrix-2013-02-16.tar.gz
Isabelle 2012: afp-Matrix-2012-05-24.tar.gz
Isabelle 2011-1: afp-Matrix-2011-10-11.tar.gz
Isabelle 2011: afp-Matrix-2011-02-11.tar.gz
Isabelle 2009-2: afp-Matrix-2010-07-01.tar.gz
Isabelle 2009-1: afp-Matrix-2010-06-17.tar.gz

\ No newline at end of file diff --git a/web/entries/Minsky_Machines.html b/web/entries/Minsky_Machines.html --- a/web/entries/Minsky_Machines.html +++ b/web/entries/Minsky_Machines.html @@ -1,221 +1,221 @@ Minsky Machines - Archive of Formal Proofs

Minsky Machines

Title:	Minsky Machines
Author:	- Bertram Felgenhauer (int-e /at/ gmx /dot/ de) + Bertram Felgenhauer
Submission date:	2018-08-14
Abstract:	We formalize undecidablity results for Minsky machines. To this end, we also formalize recursive inseparability. We start by proving that Minsky machines can compute arbitrary primitive recursive and recursive functions. We then show that there is a deterministic Minsky machine with one argument and two final states such that the set of inputs that are accepted in one state is recursively inseparable from the set of inputs that are accepted in the other state. As a corollary, the set of Minsky configurations that reach the first state but not the second recursively inseparable from the set of Minsky configurations that reach the second state but not the first. In particular both these sets are undecidable. We do not prove that recursive functions can simulate Minsky machines.
BibTeX:	@article{Minsky_Machines-AFP, author = {Bertram Felgenhauer}, title = {Minsky Machines}, journal = {Archive of Formal Proofs}, month = aug, year = 2018, note = {\url{https://isa-afp.org/entries/Minsky_Machines.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Abstract-Rewriting, Recursion-Theory-I

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Minsky_Machines-2021-02-23.tar.gz
Isabelle 2020: afp-Minsky_Machines-2020-04-20.tar.gz
Isabelle 2019: afp-Minsky_Machines-2019-06-11.tar.gz
Isabelle 2018: afp-Minsky_Machines-2018-08-16.tar.gz
Isabelle 2017: afp-Minsky_Machines-2018-08-14.tar.gz

\ No newline at end of file diff --git a/web/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html b/web/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html --- a/web/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html +++ b/web/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html @@ -1,225 +1,225 @@ Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation - Archive of Formal Proofs

Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation

Title:	Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation
Authors:	Ralph Bottesch, Jose Divasón and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2021-03-12
Abstract:	We verify two algorithms for which modular arithmetic plays an essential role: Storjohann's variant of the LLL lattice basis reduction algorithm and Kopparty's algorithm for computing the Hermite normal form of a matrix. To do this, we also formalize some facts about the modulo operation with symmetric range. Our implementations are based on the original papers, but are otherwise efficient. For basis reduction we formalize two versions: one that includes all of the optimizations/heuristics from Storjohann's paper, and one excluding a heuristic that we observed to often decrease efficiency. We also provide a fast, self-contained certifier for basis reduction, based on the efficient Hermite normal form algorithm.
BibTeX:	@article{Modular_arithmetic_LLL_and_HNF_algorithms-AFP, author = {Ralph Bottesch and Jose Divasón and René Thiemann}, title = {Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation}, journal = {Archive of Formal Proofs}, month = mar, year = 2021, note = {\url{https://isa-afp.org/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Hermite, Jordan_Normal_Form, LLL_Basis_Reduction, Show, Smith_Normal_Form

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Modular_arithmetic_LLL_and_HNF_algorithms-2021-03-14.tar.gz

\ No newline at end of file diff --git a/web/entries/Octonions.html b/web/entries/Octonions.html --- a/web/entries/Octonions.html +++ b/web/entries/Octonions.html @@ -1,206 +1,206 @@ Octonions - Archive of Formal Proofs

Octonions

Title:	Octonions
Author:	- Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki
Submission date:	2018-09-14
Abstract:	We develop the basic theory of Octonions, including various identities and properties of the octonions and of the octonionic product, a description of 7D isometries and representations of orthogonal transformations. To this end we first develop the theory of the vector cross product in 7 dimensions. The development of the theory of Octonions is inspired by that of the theory of Quaternions by Lawrence Paulson. However, we do not work within the type class real_algebra_1 because the octonionic product is not associative.
BibTeX:	@article{Octonions-AFP, author = {Angeliki Koutsoukou-Argyraki}, title = {Octonions}, journal = {Archive of Formal Proofs}, month = sep, year = 2018, note = {\url{https://isa-afp.org/entries/Octonions.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Octonions-2021-02-23.tar.gz
Isabelle 2020: afp-Octonions-2020-04-20.tar.gz
Isabelle 2019: afp-Octonions-2019-06-11.tar.gz
Isabelle 2018: afp-Octonions-2018-09-16.tar.gz

\ No newline at end of file diff --git a/web/entries/Open_Induction.html b/web/entries/Open_Induction.html --- a/web/entries/Open_Induction.html +++ b/web/entries/Open_Induction.html @@ -1,250 +1,250 @@ Open Induction - Archive of Formal Proofs

Open Induction

Title:	Open Induction
Authors:	Mizuhito Ogawa and - Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2012-11-02
Abstract:	A proof of the open induction schema based on J.-C. Raoult, Proving open properties by induction, Information Processing Letters 29, 1988, pp.19-23. This research was supported by the Austrian Science Fund (FWF): J3202.
BibTeX:	@article{Open_Induction-AFP, author = {Mizuhito Ogawa and Christian Sternagel}, title = {Open Induction}, journal = {Archive of Formal Proofs}, month = nov, year = 2012, note = {\url{https://isa-afp.org/entries/Open_Induction.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Decreasing-Diagrams-II, Functional_Ordered_Resolution_Prover, Myhill-Nerode, Well_Quasi_Orders

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Open_Induction-2021-02-23.tar.gz
Isabelle 2020: afp-Open_Induction-2020-04-20.tar.gz
Isabelle 2019: afp-Open_Induction-2019-06-11.tar.gz
Isabelle 2018: afp-Open_Induction-2018-08-16.tar.gz
Isabelle 2017: afp-Open_Induction-2017-10-10.tar.gz
Isabelle 2016-1: afp-Open_Induction-2016-12-17.tar.gz
Isabelle 2016: afp-Open_Induction-2016-02-22.tar.gz
Isabelle 2015: afp-Open_Induction-2015-05-27.tar.gz
Isabelle 2014: afp-Open_Induction-2014-08-28.tar.gz
Isabelle 2013-2: afp-Open_Induction-2013-12-11.tar.gz
Isabelle 2013-1: afp-Open_Induction-2013-11-17.tar.gz
Isabelle 2013: afp-Open_Induction-2013-03-02.tar.gz
Isabelle 2013: afp-Open_Induction-2013-02-16.tar.gz

\ No newline at end of file diff --git a/web/entries/Partial_Function_MR.html b/web/entries/Partial_Function_MR.html --- a/web/entries/Partial_Function_MR.html +++ b/web/entries/Partial_Function_MR.html @@ -1,236 +1,236 @@ Mutually Recursive Partial Functions - Archive of Formal Proofs

Mutually Recursive Partial Functions

Title:	Mutually Recursive Partial Functions
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2014-02-18
Abstract:	We provide a wrapper around the partial-function command that supports mutual recursion.
BibTeX:	@article{Partial_Function_MR-AFP, author = {René Thiemann}, title = {Mutually Recursive Partial Functions}, journal = {Archive of Formal Proofs}, month = feb, year = 2014, note = {\url{https://isa-afp.org/entries/Partial_Function_MR.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Used by:	Certification_Monads, Polynomial_Factorization

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Partial_Function_MR-2021-02-23.tar.gz
Isabelle 2020: afp-Partial_Function_MR-2020-04-20.tar.gz
Isabelle 2019: afp-Partial_Function_MR-2019-06-11.tar.gz
Isabelle 2018: afp-Partial_Function_MR-2018-08-16.tar.gz
Isabelle 2017: afp-Partial_Function_MR-2017-10-10.tar.gz
Isabelle 2016-1: afp-Partial_Function_MR-2016-12-17.tar.gz
Isabelle 2016: afp-Partial_Function_MR-2016-02-22.tar.gz
Isabelle 2015: afp-Partial_Function_MR-2015-05-27.tar.gz
Isabelle 2014: afp-Partial_Function_MR-2014-08-28.tar.gz
Isabelle 2013-2: afp-Partial_Function_MR-2014-02-19.tar.gz

\ No newline at end of file diff --git a/web/entries/Perron_Frobenius.html b/web/entries/Perron_Frobenius.html --- a/web/entries/Perron_Frobenius.html +++ b/web/entries/Perron_Frobenius.html @@ -1,262 +1,262 @@ Perron-Frobenius Theorem for Spectral Radius Analysis - Archive of Formal Proofs

Perron-Frobenius Theorem for Spectral Radius Analysis

Title:	Perron-Frobenius Theorem for Spectral Radius Analysis
Authors:	Jose Divasón, Ondřej Kunčar, - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2016-05-20
Abstract:	The spectral radius of a matrix A is the maximum norm of all eigenvalues of A. In previous work we already formalized that for a complex matrix A, the values in Aⁿ grow polynomially in n if and only if the spectral radius is at most one. One problem with the above characterization is the determination of all complex eigenvalues. In case A contains only non-negative real values, a simplification is possible with the help of the Perron–Frobenius theorem, which tells us that it suffices to consider only the real eigenvalues of A, i.e., applying Sturm's method can decide the polynomial growth of Aⁿ. We formalize the Perron–Frobenius theorem based on a proof via Brouwer's fixpoint theorem, which is available in the HOL multivariate analysis (HMA) library. Since the results on the spectral radius is based on matrices in the Jordan normal form (JNF) library, we further develop a connection which allows us to easily transfer theorems between HMA and JNF. With this connection we derive the combined result: if A is a non-negative real matrix, and no real eigenvalue of A is strictly larger than one, then Aⁿ is polynomially bounded in n.
Change history:	[2017-10-18]: added Perron-Frobenius theorem for irreducible matrices with generalization (revision bda1f1ce8a1c) [2018-05-17]: prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size (revision ffdb3794e5d5)
BibTeX:	@article{Perron_Frobenius-AFP, author = {Jose Divasón and Ondřej Kunčar and René Thiemann and Akihisa Yamada}, title = {Perron-Frobenius Theorem for Spectral Radius Analysis}, journal = {Archive of Formal Proofs}, month = may, year = 2016, note = {\url{https://isa-afp.org/entries/Perron_Frobenius.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Jordan_Normal_Form, Polynomial_Factorization, Rank_Nullity_Theorem, Sturm_Sequences
Used by:	LLL_Factorization, Smith_Normal_Form, Stochastic_Matrices

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Perron_Frobenius-2021-02-23.tar.gz
Isabelle 2020: afp-Perron_Frobenius-2020-04-20.tar.gz
Isabelle 2019: afp-Perron_Frobenius-2019-06-11.tar.gz
Isabelle 2018: afp-Perron_Frobenius-2018-08-16.tar.gz
Isabelle 2017: afp-Perron_Frobenius-2017-10-18.tar.gz
Isabelle 2017: afp-Perron_Frobenius-2017-10-10.tar.gz
Isabelle 2016-1: afp-Perron_Frobenius-2016-12-17.tar.gz
Isabelle 2016: afp-Perron_Frobenius-2016-05-20.tar.gz

\ No newline at end of file diff --git a/web/entries/Polynomial_Factorization.html b/web/entries/Polynomial_Factorization.html --- a/web/entries/Polynomial_Factorization.html +++ b/web/entries/Polynomial_Factorization.html @@ -1,234 +1,234 @@ Polynomial Factorization - Archive of Formal Proofs

Polynomial Factorization

Title:	Polynomial Factorization
Authors:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2016-01-29
Abstract:	Based on existing libraries for polynomial interpolation and matrices, we formalized several factorization algorithms for polynomials, including Kronecker's algorithm for integer polynomials, Yun's square-free factorization algorithm for field polynomials, and Berlekamp's algorithm for polynomials over finite fields. By combining the last one with Hensel's lifting, we derive an efficient factorization algorithm for the integer polynomials, which is then lifted for rational polynomials by mechanizing Gauss' lemma. Finally, we assembled a combined factorization algorithm for rational polynomials, which combines all the mentioned algorithms and additionally uses the explicit formula for roots of quadratic polynomials and a rational root test. As side products, we developed division algorithms for polynomials over integral domains, as well as primality-testing and prime-factorization algorithms for integers.
BibTeX:	@article{Polynomial_Factorization-AFP, author = {René Thiemann and Akihisa Yamada}, title = {Polynomial Factorization}, journal = {Archive of Formal Proofs}, month = jan, year = 2016, note = {\url{https://isa-afp.org/entries/Polynomial_Factorization.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Abstract-Rewriting, Containers, Gauss_Jordan, Matrix, Partial_Function_MR, Polynomial_Interpolation, Show, Sqrt_Babylonian, VectorSpace
Used by:	Amicable_Numbers, Berlekamp_Zassenhaus, Dirichlet_Series, Functional_Ordered_Resolution_Prover, Gaussian_Integers, Jordan_Normal_Form, Knuth_Bendix_Order, Linear_Recurrences, Perron_Frobenius, Power_Sum_Polynomials, Subresultants

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Polynomial_Factorization-2021-02-23.tar.gz
Isabelle 2020: afp-Polynomial_Factorization-2020-04-20.tar.gz
Isabelle 2019: afp-Polynomial_Factorization-2019-06-11.tar.gz
Isabelle 2018: afp-Polynomial_Factorization-2018-08-16.tar.gz
Isabelle 2017: afp-Polynomial_Factorization-2017-10-10.tar.gz
Isabelle 2016-1: afp-Polynomial_Factorization-2016-12-17.tar.gz
Isabelle 2016: afp-Polynomial_Factorization-2016-02-22.tar.gz

\ No newline at end of file diff --git a/web/entries/Polynomial_Interpolation.html b/web/entries/Polynomial_Interpolation.html --- a/web/entries/Polynomial_Interpolation.html +++ b/web/entries/Polynomial_Interpolation.html @@ -1,234 +1,234 @@ Polynomial Interpolation - Archive of Formal Proofs

Polynomial Interpolation

Title:	Polynomial Interpolation
Authors:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2016-01-29
Abstract:	We formalized three algorithms for polynomial interpolation over arbitrary fields: Lagrange's explicit expression, the recursive algorithm of Neville and Aitken, and the Newton interpolation in combination with an efficient implementation of divided differences. Variants of these algorithms for integer polynomials are also available, where sometimes the interpolation can fail; e.g., there is no linear integer polynomial p such that p(0) = 0 and p(2) = 1. Moreover, for the Newton interpolation for integer polynomials, we proved that all intermediate results that are computed during the algorithm must be integers. This admits an early failure detection in the implementation. Finally, we proved the uniqueness of polynomial interpolation. The development also contains improved code equations to speed up the division of integers in target languages.
BibTeX:	@article{Polynomial_Interpolation-AFP, author = {René Thiemann and Akihisa Yamada}, title = {Polynomial Interpolation}, journal = {Archive of Formal Proofs}, month = jan, year = 2016, note = {\url{https://isa-afp.org/entries/Polynomial_Interpolation.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Sqrt_Babylonian
Used by:	Berlekamp_Zassenhaus, Count_Complex_Roots, Deep_Learning, Formal_Puiseux_Series, Gauss_Sums, Polynomial_Factorization, Three_Circles

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Polynomial_Interpolation-2021-02-23.tar.gz
Isabelle 2020: afp-Polynomial_Interpolation-2020-04-20.tar.gz
Isabelle 2019: afp-Polynomial_Interpolation-2019-06-11.tar.gz
Isabelle 2018: afp-Polynomial_Interpolation-2018-08-16.tar.gz
Isabelle 2017: afp-Polynomial_Interpolation-2017-10-10.tar.gz
Isabelle 2016-1: afp-Polynomial_Interpolation-2016-12-17.tar.gz
Isabelle 2016: afp-Polynomial_Interpolation-2016-02-22.tar.gz

\ No newline at end of file diff --git a/web/entries/Polynomials.html b/web/entries/Polynomials.html --- a/web/entries/Polynomials.html +++ b/web/entries/Polynomials.html @@ -1,306 +1,306 @@ Executable Multivariate Polynomials - Archive of Formal Proofs

Executable Multivariate Polynomials

Title:	Executable Multivariate Polynomials
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com), - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at), + Christian Sternagel, + René Thiemann, Alexander Maletzky, Fabian Immler, Florian Haftmann, Andreas Lochbihler and Alexander Bentkamp (bentkamp /at/ gmail /dot/ com)
Submission date:	2010-08-10
Abstract:	We define multivariate polynomials over arbitrary (ordered) semirings in combination with (executable) operations like addition, multiplication, and substitution. We also define (weak) monotonicity of polynomials and comparison of polynomials where we provide standard estimations like absolute positiveness or the more recent approach of Neurauter, Zankl, and Middeldorp. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over polynomials. Our formalization was performed as part of the IsaFoR/CeTA-system which contains several termination techniques. The provided theories have been essential to formalize polynomial interpretations. This formalization also contains an abstract representation as coefficient functions with finite support and a type of power-products. If this type is ordered by a linear (term) ordering, various additional notions, such as leading power-product, leading coefficient etc., are introduced as well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y].
Change history:	[2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting. [2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler. [2018-01-23]: Added authors Haftmann, Lochbihler after incorporating their formalization of multivariate polynomials based on Polynomial mappings. Moved material from Bentkamp's entry "Deep Learning". [2019-04-18]: Added material about polynomials whose power-products are represented themselves by polynomial mappings.
BibTeX:	@article{Polynomials-AFP, author = {Christian Sternagel and René Thiemann and Alexander Maletzky and Fabian Immler and Florian Haftmann and Andreas Lochbihler and Alexander Bentkamp}, title = {Executable Multivariate Polynomials}, journal = {Archive of Formal Proofs}, month = aug, year = 2010, note = {\url{https://isa-afp.org/entries/Polynomials.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Abstract-Rewriting, Matrix, Show, Well_Quasi_Orders
Used by:	Deep_Learning, Factor_Algebraic_Polynomial, Groebner_Bases, Lambda_Free_KBOs, PAC_Checker, Symmetric_Polynomials, Virtual_Substitution

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Polynomials-2021-02-23.tar.gz
Isabelle 2020: afp-Polynomials-2020-04-20.tar.gz
Isabelle 2019: afp-Polynomials-2020-01-14.tar.gz
Isabelle 2019: afp-Polynomials-2019-06-11.tar.gz
Isabelle 2018: afp-Polynomials-2018-08-16.tar.gz
Isabelle 2017: afp-Polynomials-2017-10-10.tar.gz
Isabelle 2016-1: afp-Polynomials-2016-12-17.tar.gz
Isabelle 2016: afp-Polynomials-2016-02-22.tar.gz
Isabelle 2015: afp-Polynomials-2015-05-27.tar.gz
Isabelle 2014: afp-Polynomials-2014-08-28.tar.gz
Isabelle 2013-2: afp-Polynomials-2013-12-11.tar.gz
Isabelle 2013-1: afp-Polynomials-2013-11-17.tar.gz
Isabelle 2013: afp-Polynomials-2013-02-16.tar.gz
Isabelle 2012: afp-Polynomials-2012-05-24.tar.gz
Isabelle 2011-1: afp-Polynomials-2011-10-11.tar.gz
Isabelle 2011: afp-Polynomials-2011-02-11.tar.gz
Isabelle 2009-2: afp-Polynomials-2010-08-11.tar.gz

\ No newline at end of file diff --git a/web/entries/Random_Graph_Subgraph_Threshold.html b/web/entries/Random_Graph_Subgraph_Threshold.html --- a/web/entries/Random_Graph_Subgraph_Threshold.html +++ b/web/entries/Random_Graph_Subgraph_Threshold.html @@ -1,242 +1,244 @@ Properties of Random Graphs -- Subgraph Containment - Archive of Formal Proofs

Properties of Random Graphs -- Subgraph Containment

- + + +

Title:	Properties of Random Graphs -- Subgraph Containment
Author:	Lars Hupel
Submission date:	2014-02-13
Abstract:	Random graphs are graphs with a fixed number of vertices, where each edge is present with a fixed probability. We are interested in the probability that a random graph contains a certain pattern, for example a cycle or a clique. A very high edge probability gives rise to perhaps too many edges (which degrades performance for many algorithms), whereas a low edge probability might result in a disconnected graph. We prove a theorem about a threshold probability such that a higher edge probability will asymptotically almost surely produce a random graph with the desired subgraph.
BibTeX:	@article{Random_Graph_Subgraph_Threshold-AFP, author = {Lars Hupel}, title = {Properties of Random Graphs -- Subgraph Containment}, journal = {Archive of Formal Proofs}, month = feb, year = 2014, note = {\url{https://isa-afp.org/entries/Random_Graph_Subgraph_Threshold.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Girth_Chromatic
Used by:	Roth_Arithmetic_Progressions

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Random_Graph_Subgraph_Threshold-2021-02-23.tar.gz
Isabelle 2020: afp-Random_Graph_Subgraph_Threshold-2020-04-20.tar.gz
Isabelle 2019: afp-Random_Graph_Subgraph_Threshold-2019-06-11.tar.gz
Isabelle 2018: afp-Random_Graph_Subgraph_Threshold-2018-08-16.tar.gz
Isabelle 2017: afp-Random_Graph_Subgraph_Threshold-2017-10-10.tar.gz
Isabelle 2016-1: afp-Random_Graph_Subgraph_Threshold-2016-12-17.tar.gz
Isabelle 2016: afp-Random_Graph_Subgraph_Threshold-2016-02-22.tar.gz
Isabelle 2015: afp-Random_Graph_Subgraph_Threshold-2015-05-27.tar.gz
Isabelle 2014: afp-Random_Graph_Subgraph_Threshold-2014-08-28.tar.gz
Isabelle 2013-2: afp-Random_Graph_Subgraph_Threshold-2014-02-14.tar.gz

\ No newline at end of file diff --git a/web/entries/Real_Impl.html b/web/entries/Real_Impl.html --- a/web/entries/Real_Impl.html +++ b/web/entries/Real_Impl.html @@ -1,257 +1,257 @@ Implementing field extensions of the form Q[sqrt(b)] - Archive of Formal Proofs

Implementing field extensions of the form Q[sqrt(b)]

Title:	Implementing field extensions of the form Q[sqrt(b)]
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2014-02-06
Abstract:	We apply data refinement to implement the real numbers, where we support all numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p + q * sqrt(b) for rational numbers p and q and some fixed natural number b. To this end, we also developed algorithms to precisely compute roots of a rational number, and to perform a factorization of natural numbers which eliminates duplicate prime factors. Our results have been used to certify termination proofs which involve polynomial interpretations over the reals.
Change history:	[2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian.
BibTeX:	@article{Real_Impl-AFP, author = {René Thiemann}, title = {Implementing field extensions of the form Q[sqrt(b)]}, journal = {Archive of Formal Proofs}, month = feb, year = 2014, note = {\url{https://isa-afp.org/entries/Real_Impl.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Deriving, Show, Sqrt_Babylonian
Used by:	Complex_Bounded_Operators, QR_Decomposition

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Real_Impl-2021-02-23.tar.gz
Isabelle 2020: afp-Real_Impl-2020-04-20.tar.gz
Isabelle 2019: afp-Real_Impl-2019-06-11.tar.gz
Isabelle 2018: afp-Real_Impl-2018-08-16.tar.gz
Isabelle 2017: afp-Real_Impl-2017-10-10.tar.gz
Isabelle 2016-1: afp-Real_Impl-2016-12-17.tar.gz
Isabelle 2016: afp-Real_Impl-2016-02-22.tar.gz
Isabelle 2015: afp-Real_Impl-2015-05-27.tar.gz
Isabelle 2014: afp-Real_Impl-2014-08-28.tar.gz
Isabelle 2013-2: afp-Real_Impl-2014-02-11.tar.gz

\ No newline at end of file diff --git a/web/entries/Regular_Tree_Relations.html b/web/entries/Regular_Tree_Relations.html new file mode 100644 --- /dev/null +++ b/web/entries/Regular_Tree_Relations.html @@ -0,0 +1,203 @@ + + + + +Regular Tree Relations - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Regular + + Tree + + Relations + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Regular Tree Relations
+ Authors: +	+ Alexander Lochmann (alexander /dot/ lochmann /at/ uibk /dot/ ac /dot/ at), + Bertram Felgenhauer, + Christian Sternagel, + René Thiemann and + Thomas Sternagel +
Submission date:	2021-12-15
Abstract:	+Tree automata have good closure properties and therefore a commonly +used to prove/disprove properties. This formalization contains among +other things the proofs of many closure properties of tree automata +(anchored) ground tree transducers and regular relations. Additionally +it includes the well known pumping lemma and a lifting of the Myhill +Nerode theorem for regular languages to tree languages. We want to +mention the existence of a tree +automata APF-entry developed by Peter Lammich. His work is +based on epsilon free top-down tree automata, while this entry builds +on bottom-up tree auotamta with epsilon transitions. Moreover our +formalization relies on the Collections +Framework, also by Peter Lammich, to obtain efficient code. +All proven constructions of the closure properties are exportable +using the Isabelle/HOL code generation facilities.
BibTeX:	+ @article{Regular_Tree_Relations-AFP, + author = {Alexander Lochmann and Bertram Felgenhauer and Christian Sternagel and René Thiemann and Thomas Sternagel}, + title = {Regular Tree Relations}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/Regular_Tree_Relations.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License
Depends on:	Knuth_Bendix_Order

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Rewriting_Z.html b/web/entries/Rewriting_Z.html --- a/web/entries/Rewriting_Z.html +++ b/web/entries/Rewriting_Z.html @@ -1,227 +1,227 @@ The Z Property - Archive of Formal Proofs

The Z Property

Title:	The Z Property
Authors:	- Bertram Felgenhauer (int-e /at/ gmx /dot/ de), + Bertram Felgenhauer, Julian Nagele, Vincent van Oostrom and - Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2016-06-30
Abstract:	We formalize the Z property introduced by Dehornoy and van Oostrom. First we show that for any abstract rewrite system, Z implies confluence. Then we give two examples of proofs using Z: confluence of lambda-calculus with respect to beta-reduction and confluence of combinatory logic.
BibTeX:	@article{Rewriting_Z-AFP, author = {Bertram Felgenhauer and Julian Nagele and Vincent van Oostrom and Christian Sternagel}, title = {The Z Property}, journal = {Archive of Formal Proofs}, month = jun, year = 2016, note = {\url{https://isa-afp.org/entries/Rewriting_Z.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Abstract-Rewriting, Nominal2

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Rewriting_Z-2021-02-23.tar.gz
Isabelle 2020: afp-Rewriting_Z-2020-04-20.tar.gz
Isabelle 2019: afp-Rewriting_Z-2019-06-11.tar.gz
Isabelle 2018: afp-Rewriting_Z-2018-08-16.tar.gz
Isabelle 2017: afp-Rewriting_Z-2017-10-10.tar.gz
Isabelle 2016-1: afp-Rewriting_Z-2016-12-17.tar.gz
Isabelle 2016: afp-Rewriting_Z-2016-06-30.tar.gz

\ No newline at end of file diff --git a/web/entries/Roth_Arithmetic_Progressions.html b/web/entries/Roth_Arithmetic_Progressions.html new file mode 100644 --- /dev/null +++ b/web/entries/Roth_Arithmetic_Progressions.html @@ -0,0 +1,204 @@ + + + + +Roth's Theorem on Arithmetic Progressions - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Roth's + + Theorem + + on + + Arithmetic + + Progressions + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Title:	Roth's Theorem on Arithmetic Progressions
+ Authors: +	+ Chelsea Edmonds, + Angeliki Koutsoukou-Argyraki and + Lawrence C. Paulson +
Submission date:	2021-12-28
Abstract:	+We formalise a proof of Roth's Theorem on Arithmetic +Progressions, a major result in additive combinatorics on the +existence of 3-term arithmetic progressions in subsets of natural +numbers. To this end, we follow a proof using graph regularity. We +employ our recent formalisation of Szemerédi's Regularity Lemma, +a major result in extremal graph theory, which we use here to prove +the Triangle Counting Lemma and the Triangle Removal Lemma. Our +sources are Yufei Zhao's MIT lecture notes +"Graph Theory and Additive Combinatorics" +(revised version here) +and W.T. Gowers's Cambridge lecture notes +"Topics in Combinatorics". +We also refer to the University of +Georgia notes by Stephanie Bell and Will Grodzicki, +"Using Szemerédi's Regularity Lemma to Prove Roth's Theorem".
BibTeX:	+ @article{Roth_Arithmetic_Progressions-AFP, + author = {Chelsea Edmonds and Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson}, + title = {Roth's Theorem on Arithmetic Progressions}, + journal = {Archive of Formal Proofs}, + month = dec, + year = 2021, + note = {\url{https://isa-afp.org/entries/Roth_Arithmetic_Progressions.html}, + Formal proof development}, + ISSN = {2150-914x}, +} +
License:	BSD License
Depends on:	Ergodic_Theory, Girth_Chromatic, Random_Graph_Subgraph_Threshold, Szemeredi_Regularity

+ +

+ + + + + + + + + + + + + + + + +

+ Proof outline
+ Proof document +

+ Browse theories +

+ Download this entry +

Older releases: + None +

+ +

+ + + + + + \ No newline at end of file diff --git a/web/entries/Show.html b/web/entries/Show.html --- a/web/entries/Show.html +++ b/web/entries/Show.html @@ -1,252 +1,252 @@ Haskell's Show Class in Isabelle/HOL - Archive of Formal Proofs

Haskell's Show Class in Isabelle/HOL

Title:	Haskell's Show Class in Isabelle/HOL
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2014-07-29
Abstract:	We implemented a type class for "to-string" functions, similar to Haskell's Show class. Moreover, we provide instantiations for Isabelle/HOL's standard types like bool, prod, sum, nats, ints, and rats. It is further possible, to automatically derive show functions for arbitrary user defined datatypes similar to Haskell's "deriving Show".
Change history:	[2015-03-11]: Adapted development to new-style (BNF-based) datatypes. [2015-04-10]: Moved development for old-style datatypes into subdirectory "Old_Datatype".
BibTeX:	@article{Show-AFP, author = {Christian Sternagel and René Thiemann}, title = {Haskell's Show Class in Isabelle/HOL}, journal = {Archive of Formal Proofs}, month = jul, year = 2014, note = {\url{https://isa-afp.org/entries/Show.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Deriving
Used by:	Affine_Arithmetic, AI_Planning_Languages_Semantics, Berlekamp_Zassenhaus, CakeML, CakeML_Codegen, Certification_Monads, Dict_Construction, MiniSail, Modular_arithmetic_LLL_and_HNF_algorithms, Monad_Memo_DP, Polynomial_Factorization, Polynomials, Real_Impl, XML

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Show-2021-02-23.tar.gz
Isabelle 2020: afp-Show-2020-04-20.tar.gz
Isabelle 2019: afp-Show-2019-06-11.tar.gz
Isabelle 2018: afp-Show-2018-08-16.tar.gz
Isabelle 2017: afp-Show-2017-10-10.tar.gz
Isabelle 2016-1: afp-Show-2016-12-17.tar.gz
Isabelle 2016: afp-Show-2016-02-22.tar.gz
Isabelle 2015: afp-Show-2015-05-27.tar.gz
Isabelle 2014: afp-Show-2014-08-29.tar.gz
Isabelle 2014: afp-Show-2014-08-28.tar.gz

\ No newline at end of file diff --git a/web/entries/Simplex.html b/web/entries/Simplex.html --- a/web/entries/Simplex.html +++ b/web/entries/Simplex.html @@ -1,230 +1,230 @@ An Incremental Simplex Algorithm with Unsatisfiable Core Generation - Archive of Formal Proofs

An Incremental Simplex Algorithm with Unsatisfiable Core Generation

Title:	An Incremental Simplex Algorithm with Unsatisfiable Core Generation
Authors:	Filip Marić (filip /at/ matf /dot/ bg /dot/ ac /dot/ rs), Mirko Spasić (mirko /at/ matf /dot/ bg /dot/ ac /dot/ rs) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2018-08-24
Abstract:	We present an Isabelle/HOL formalization and total correctness proof for the incremental version of the Simplex algorithm which is used in most state-of-the-art SMT solvers. It supports extraction of satisfying assignments, extraction of minimal unsatisfiable cores, incremental assertion of constraints and backtracking. The formalization relies on stepwise program refinement, starting from a simple specification, going through a number of refinement steps, and ending up in a fully executable functional implementation. Symmetries present in the algorithm are handled with special care.
BibTeX:	@article{Simplex-AFP, author = {Filip Marić and Mirko Spasić and René Thiemann}, title = {An Incremental Simplex Algorithm with Unsatisfiable Core Generation}, journal = {Archive of Formal Proofs}, month = aug, year = 2018, note = {\url{https://isa-afp.org/entries/Simplex.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Used by:	Farkas

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Simplex-2021-02-23.tar.gz
Isabelle 2020: afp-Simplex-2020-04-20.tar.gz
Isabelle 2019: afp-Simplex-2020-01-14.tar.gz
Isabelle 2019: afp-Simplex-2019-06-11.tar.gz
Isabelle 2018: afp-Simplex-2018-08-27.tar.gz

\ No newline at end of file diff --git a/web/entries/Sqrt_Babylonian.html b/web/entries/Sqrt_Babylonian.html --- a/web/entries/Sqrt_Babylonian.html +++ b/web/entries/Sqrt_Babylonian.html @@ -1,268 +1,268 @@ Computing N-th Roots using the Babylonian Method - Archive of Formal Proofs

Computing N-th Roots using the Babylonian Method

Title:	Computing N-th Roots using the Babylonian Method
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2013-01-03
Abstract:	We implement the Babylonian method to compute n-th roots of numbers. We provide precise algorithms for naturals, integers and rationals, and offer an approximation algorithm for square roots over linear ordered fields. Moreover, there are precise algorithms to compute the floor and the ceiling of n-th roots.
Change history:	[2013-10-16]: Added algorithms to compute floor and ceiling of sqrt of integers. [2014-07-11]: Moved NthRoot_Impl from Real-Impl to this entry.
BibTeX:	@article{Sqrt_Babylonian-AFP, author = {René Thiemann}, title = {Computing N-th Roots using the Babylonian Method}, journal = {Archive of Formal Proofs}, month = jan, year = 2013, note = {\url{https://isa-afp.org/entries/Sqrt_Babylonian.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Cauchy
Used by:	Polynomial_Factorization, Polynomial_Interpolation, QR_Decomposition, Real_Impl

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Sqrt_Babylonian-2021-02-23.tar.gz
Isabelle 2020: afp-Sqrt_Babylonian-2020-04-20.tar.gz
Isabelle 2019: afp-Sqrt_Babylonian-2019-06-11.tar.gz
Isabelle 2018: afp-Sqrt_Babylonian-2018-08-16.tar.gz
Isabelle 2017: afp-Sqrt_Babylonian-2017-10-10.tar.gz
Isabelle 2016-1: afp-Sqrt_Babylonian-2016-12-17.tar.gz
Isabelle 2016: afp-Sqrt_Babylonian-2016-02-22.tar.gz
Isabelle 2015: afp-Sqrt_Babylonian-2015-05-27.tar.gz
Isabelle 2014: afp-Sqrt_Babylonian-2014-08-28.tar.gz
Isabelle 2013-2: afp-Sqrt_Babylonian-2013-12-11.tar.gz
Isabelle 2013-1: afp-Sqrt_Babylonian-2013-11-17.tar.gz
Isabelle 2013: afp-Sqrt_Babylonian-2013-02-16.tar.gz
Isabelle 2012: afp-Sqrt_Babylonian-2013-01-04.tar.gz

\ No newline at end of file diff --git a/web/entries/Stochastic_Matrices.html b/web/entries/Stochastic_Matrices.html --- a/web/entries/Stochastic_Matrices.html +++ b/web/entries/Stochastic_Matrices.html @@ -1,223 +1,223 @@ Stochastic Matrices and the Perron-Frobenius Theorem - Archive of Formal Proofs

Stochastic Matrices and the Perron-Frobenius Theorem

Title:	Stochastic Matrices and the Perron-Frobenius Theorem
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2017-11-22
Abstract:	Stochastic matrices are a convenient way to model discrete-time and finite state Markov chains. The Perron–Frobenius theorem tells us something about the existence and uniqueness of non-negative eigenvectors of a stochastic matrix. In this entry, we formalize stochastic matrices, link the formalization to the existing AFP-entry on Markov chains, and apply the Perron–Frobenius theorem to prove that stationary distributions always exist, and they are unique if the stochastic matrix is irreducible.
BibTeX:	@article{Stochastic_Matrices-AFP, author = {René Thiemann}, title = {Stochastic Matrices and the Perron-Frobenius Theorem}, journal = {Archive of Formal Proofs}, month = nov, year = 2017, note = {\url{https://isa-afp.org/entries/Stochastic_Matrices.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Jordan_Normal_Form, Markov_Models, Perron_Frobenius

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Stochastic_Matrices-2021-02-23.tar.gz
Isabelle 2020: afp-Stochastic_Matrices-2020-04-20.tar.gz
Isabelle 2019: afp-Stochastic_Matrices-2019-06-11.tar.gz
Isabelle 2018: afp-Stochastic_Matrices-2018-08-16.tar.gz
Isabelle 2017: afp-Stochastic_Matrices-2017-11-23.tar.gz

\ No newline at end of file diff --git a/web/entries/Subresultants.html b/web/entries/Subresultants.html --- a/web/entries/Subresultants.html +++ b/web/entries/Subresultants.html @@ -1,218 +1,218 @@ Subresultants - Archive of Formal Proofs

Subresultants

Title:	Subresultants
Authors:	Sebastiaan Joosten, - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2017-04-06
Abstract:	We formalize the theory of subresultants and the subresultant polynomial remainder sequence as described by Brown and Traub. As a result, we obtain efficient certified algorithms for computing the resultant and the greatest common divisor of polynomials.
BibTeX:	@article{Subresultants-AFP, author = {Sebastiaan Joosten and René Thiemann and Akihisa Yamada}, title = {Subresultants}, journal = {Archive of Formal Proofs}, month = apr, year = 2017, note = {\url{https://isa-afp.org/entries/Subresultants.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Jordan_Normal_Form, Polynomial_Factorization
Used by:	Berlekamp_Zassenhaus

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Subresultants-2021-02-23.tar.gz
Isabelle 2020: afp-Subresultants-2020-04-20.tar.gz
Isabelle 2019: afp-Subresultants-2019-06-11.tar.gz
Isabelle 2018: afp-Subresultants-2018-08-16.tar.gz
Isabelle 2017: afp-Subresultants-2017-10-10.tar.gz
Isabelle 2016-1: afp-Subresultants-2017-04-07.tar.gz

\ No newline at end of file diff --git a/web/entries/Sunflowers.html b/web/entries/Sunflowers.html --- a/web/entries/Sunflowers.html +++ b/web/entries/Sunflowers.html @@ -1,200 +1,200 @@ The Sunflower Lemma of Erdős and Rado - Archive of Formal Proofs

The Sunflower Lemma of Erdős and Rado

Title:	The Sunflower Lemma of Erdős and Rado
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2021-02-25
Abstract:	We formally define sunflowers and provide a formalization of the sunflower lemma of Erdős and Rado: whenever a set of size-k-sets has a larger cardinality than (r - 1)^k · k!, then it contains a sunflower of cardinality r.
BibTeX:	@article{Sunflowers-AFP, author = {René Thiemann}, title = {The Sunflower Lemma of Erdős and Rado}, journal = {Archive of Formal Proofs}, month = feb, year = 2021, note = {\url{https://isa-afp.org/entries/Sunflowers.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Sunflowers-2021-03-01.tar.gz

\ No newline at end of file diff --git a/web/entries/Szemeredi_Regularity.html b/web/entries/Szemeredi_Regularity.html --- a/web/entries/Szemeredi_Regularity.html +++ b/web/entries/Szemeredi_Regularity.html @@ -1,204 +1,206 @@ Szemerédi's Regularity Lemma - Archive of Formal Proofs

Szemerédi's Regularity Lemma

- + + +

Title:	Szemerédi's Regularity Lemma
Authors:	Chelsea Edmonds, - Angeliki Koutsoukou-Argyraki and + Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson
Submission date:	2021-11-05
Abstract:	Szemerédi's regularity lemma is a key result in the study of large -graphs. It asserts the existence an upper bound on the number of parts +graphs. It asserts the existence of an upper bound on the number of parts the vertices of a graph need to be partitioned into such that the edges between the parts are random in a certain sense. This bound depends only on the desired precision and not on the graph itself, in the spirit of Ramsey's theorem. The formalisation follows online course notes by Tim Gowers and Yufei Zhao.
BibTeX:	@article{Szemeredi_Regularity-AFP, author = {Chelsea Edmonds and Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson}, title = {Szemerédi's Regularity Lemma}, journal = {Archive of Formal Proofs}, month = nov, year = 2021, note = {\url{https://isa-afp.org/entries/Szemeredi_Regularity.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Girth_Chromatic
Used by:	Roth_Arithmetic_Progressions

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Szemeredi_Regularity-2021-11-07.tar.gz

\ No newline at end of file diff --git a/web/entries/Transcendence_Series_Hancl_Rucki.html b/web/entries/Transcendence_Series_Hancl_Rucki.html --- a/web/entries/Transcendence_Series_Hancl_Rucki.html +++ b/web/entries/Transcendence_Series_Hancl_Rucki.html @@ -1,217 +1,217 @@ The Transcendence of Certain Infinite Series - Archive of Formal Proofs

The Transcendence of Certain Infinite Series

Title:	The Transcendence of Certain Infinite Series
Authors:	- Angeliki Koutsoukou-Argyraki and + Angeliki Koutsoukou-Argyraki and Wenda Li
Submission date:	2019-03-27
Abstract:	We formalize the proofs of two transcendence criteria by J. Hančl and P. Rucki that assert the transcendence of the sums of certain infinite series built up by sequences that fulfil certain properties. Both proofs make use of Roth's celebrated theorem on diophantine approximations to algebraic numbers from 1955 which we implement as an assumption without having formalised its proof.
BibTeX:	@article{Transcendence_Series_Hancl_Rucki-AFP, author = {Angeliki Koutsoukou-Argyraki and Wenda Li}, title = {The Transcendence of Certain Infinite Series}, journal = {Archive of Formal Proofs}, month = mar, year = 2019, note = {\url{https://isa-afp.org/entries/Transcendence_Series_Hancl_Rucki.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Prime_Number_Theorem

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Transcendence_Series_Hancl_Rucki-2021-02-23.tar.gz
Isabelle 2020: afp-Transcendence_Series_Hancl_Rucki-2020-04-20.tar.gz
Isabelle 2019: afp-Transcendence_Series_Hancl_Rucki-2019-06-11.tar.gz
Isabelle 2018: afp-Transcendence_Series_Hancl_Rucki-2019-03-28.tar.gz

\ No newline at end of file diff --git a/web/entries/Transitive-Closure-II.html b/web/entries/Transitive-Closure-II.html --- a/web/entries/Transitive-Closure-II.html +++ b/web/entries/Transitive-Closure-II.html @@ -1,273 +1,273 @@ Executable Transitive Closures - Archive of Formal Proofs

Executable Transitive Closures

Title:	Executable Transitive Closures
Author:	- René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + René Thiemann
Submission date:	2012-02-29
Abstract:	We provide a generic work-list algorithm to compute the (reflexive-)transitive closure of relations where only successors of newly detected states are generated. In contrast to our previous work, the relations do not have to be finite, but each element must only have finitely many (indirect) successors. Moreover, a subsumption relation can be used instead of pure equality. An executable variant of the algorithm is available where the generic operations are instantiated with list operations. This formalization was performed as part of the IsaFoR/CeTA project, and it has been used to certify size-change termination proofs where large transitive closures have to be computed.
BibTeX:	@article{Transitive-Closure-II-AFP, author = {René Thiemann}, title = {Executable Transitive Closures}, journal = {Archive of Formal Proofs}, month = feb, year = 2012, note = {\url{https://isa-afp.org/entries/Transitive-Closure-II.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Regular-Sets

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Transitive-Closure-II-2021-02-23.tar.gz
Isabelle 2020: afp-Transitive-Closure-II-2020-04-20.tar.gz
Isabelle 2019: afp-Transitive-Closure-II-2019-06-11.tar.gz
Isabelle 2018: afp-Transitive-Closure-II-2018-08-16.tar.gz
Isabelle 2017: afp-Transitive-Closure-II-2017-10-10.tar.gz
Isabelle 2016-1: afp-Transitive-Closure-II-2016-12-17.tar.gz
Isabelle 2016: afp-Transitive-Closure-II-2016-02-22.tar.gz
Isabelle 2015: afp-Transitive-Closure-II-2015-05-27.tar.gz
Isabelle 2014: afp-Transitive-Closure-II-2014-08-28.tar.gz
Isabelle 2013-2: afp-Transitive-Closure-II-2013-12-11.tar.gz
Isabelle 2013-1: afp-Transitive-Closure-II-2013-11-17.tar.gz
Isabelle 2013: afp-Transitive-Closure-II-2013-02-16.tar.gz
Isabelle 2012: afp-Transitive-Closure-II-2012-05-24.tar.gz
Isabelle 2011-1: afp-Transitive-Closure-II-2012-03-15.tar.gz
Isabelle 2011-1: afp-Transitive-Closure-II-2012-02-29.tar.gz

\ No newline at end of file diff --git a/web/entries/Transitive-Closure.html b/web/entries/Transitive-Closure.html --- a/web/entries/Transitive-Closure.html +++ b/web/entries/Transitive-Closure.html @@ -1,277 +1,277 @@ Executable Transitive Closures of Finite Relations - Archive of Formal Proofs

Executable Transitive Closures of Finite Relations

Title:	Executable Transitive Closures of Finite Relations
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2011-03-14
Abstract:	We provide a generic work-list algorithm to compute the transitive closure of finite relations where only successors of newly detected states are generated. This algorithm is then instantiated for lists over arbitrary carriers and red black trees (which are faster but require a linear order on the carrier), respectively. Our formalization was performed as part of the IsaFoR/CeTA project where reflexive transitive closures of large tree automata have to be computed.
Change history:	[2014-09-04] added example simprocs in Finite_Transitive_Closure_Simprocs
BibTeX:	@article{Transitive-Closure-AFP, author = {Christian Sternagel and René Thiemann}, title = {Executable Transitive Closures of Finite Relations}, journal = {Archive of Formal Proofs}, month = mar, year = 2011, note = {\url{https://isa-afp.org/entries/Transitive-Closure.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	GNU Lesser General Public License (LGPL)
Depends on:	Collections, Matrix
Used by:	KBPs, Network_Security_Policy_Verification, Planarity_Certificates

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Transitive-Closure-2021-02-23.tar.gz
Isabelle 2020: afp-Transitive-Closure-2020-04-20.tar.gz
Isabelle 2019: afp-Transitive-Closure-2019-06-11.tar.gz
Isabelle 2018: afp-Transitive-Closure-2018-08-16.tar.gz
Isabelle 2017: afp-Transitive-Closure-2017-10-10.tar.gz
Isabelle 2016-1: afp-Transitive-Closure-2016-12-17.tar.gz
Isabelle 2016: afp-Transitive-Closure-2016-02-22.tar.gz
Isabelle 2015: afp-Transitive-Closure-2015-05-27.tar.gz
Isabelle 2014: afp-Transitive-Closure-2014-08-28.tar.gz
Isabelle 2013-2: afp-Transitive-Closure-2013-12-11.tar.gz
Isabelle 2013-1: afp-Transitive-Closure-2013-11-17.tar.gz
Isabelle 2013: afp-Transitive-Closure-2013-02-16.tar.gz
Isabelle 2012: afp-Transitive-Closure-2012-05-24.tar.gz
Isabelle 2011-1: afp-Transitive-Closure-2011-10-12.tar.gz
Isabelle 2011-1: afp-Transitive-Closure-2011-10-11.tar.gz
Isabelle 2011: afp-Transitive-Closure-2011-03-14.tar.gz

\ No newline at end of file diff --git a/web/entries/Weighted_Path_Order.html b/web/entries/Weighted_Path_Order.html --- a/web/entries/Weighted_Path_Order.html +++ b/web/entries/Weighted_Path_Order.html @@ -1,218 +1,218 @@ A Formalization of Weighted Path Orders and Recursive Path Orders - Archive of Formal Proofs

A Formalization of Weighted Path Orders and Recursive Path Orders

Title:	A Formalization of Weighted Path Orders and Recursive Path Orders
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com), - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and + Christian Sternagel, + René Thiemann and Akihisa Yamada (akihisa /dot/ yamada /at/ aist /dot/ go /dot/ jp)
Submission date:	2021-09-16
Abstract:	We define the weighted path order (WPO) and formalize several properties such as strong normalization, the subterm property, and closure properties under substitutions and contexts. Our definition of WPO extends the original definition by also permitting multiset comparisons of arguments instead of just lexicographic extensions. Therefore, our WPO not only subsumes lexicographic path orders (LPO), but also recursive path orders (RPO). We formally prove these subsumptions and therefore all of the mentioned properties of WPO are automatically transferable to LPO and RPO as well. Such a transformation is not required for Knuth–Bendix orders (KBO), since they have already been formalized. Nevertheless, we still provide a proof that WPO subsumes KBO and thereby underline the generality of WPO.
BibTeX:	@article{Weighted_Path_Order-AFP, author = {Christian Sternagel and René Thiemann and Akihisa Yamada}, title = {A Formalization of Weighted Path Orders and Recursive Path Orders}, journal = {Archive of Formal Proofs}, month = sep, year = 2021, note = {\url{https://isa-afp.org/entries/Weighted_Path_Order.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Knuth_Bendix_Order

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Weighted_Path_Order-2021-09-26.tar.gz

\ No newline at end of file diff --git a/web/entries/Well_Quasi_Orders.html b/web/entries/Well_Quasi_Orders.html --- a/web/entries/Well_Quasi_Orders.html +++ b/web/entries/Well_Quasi_Orders.html @@ -1,274 +1,274 @@ Well-Quasi-Orders - Archive of Formal Proofs

Well-Quasi-Orders

Title:	Well-Quasi-Orders
Author:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) + Christian Sternagel
Submission date:	2012-04-13
Abstract:	Based on Isabelle/HOL's type class for preorders, we introduce a type class for well-quasi-orders (wqo) which is characterized by the absence of "bad" sequences (our proofs are along the lines of the proof of Nash-Williams, from which we also borrow terminology). Our main results are instantiations for the product type, the list type, and a type of finite trees, which (almost) directly follow from our proofs of (1) Dickson's Lemma, (2) Higman's Lemma, and (3) Kruskal's Tree Theorem. More concretely: If the sets A and B are wqo then their Cartesian product is wqo. If the set A is wqo then the set of finite lists over A is wqo. If the set A is wqo then the set of finite trees over A is wqo. The research was funded by the Austrian Science Fund (FWF): J3202.
Change history:	[2012-06-11]: Added Kruskal's Tree Theorem. [2012-12-19]: New variant of Kruskal's tree theorem for terms (as opposed to variadic terms, i.e., trees), plus finite version of the tree theorem as corollary. [2013-05-16]: Simplified construction of minimal bad sequences. [2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem, based on homogeneous sequences. [2016-01-03]: An alternative proof of Higman's lemma by open induction. [2017-06-08]: Proved (classical) equivalence to inductive definition of almost-full relations according to the ITP 2012 paper "Stop When You Are Almost-Full" by Vytiniotis, Coquand, and Wahlstedt.
BibTeX:	@article{Well_Quasi_Orders-AFP, author = {Christian Sternagel}, title = {Well-Quasi-Orders}, journal = {Archive of Formal Proofs}, month = apr, year = 2012, note = {\url{https://isa-afp.org/entries/Well_Quasi_Orders.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Abstract-Rewriting, Open_Induction
Used by:	Decreasing-Diagrams-II, Myhill-Nerode, Polynomials, Saturation_Framework, Saturation_Framework_Extensions

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-Well_Quasi_Orders-2021-02-23.tar.gz
Isabelle 2020: afp-Well_Quasi_Orders-2020-04-20.tar.gz
Isabelle 2019: afp-Well_Quasi_Orders-2019-06-11.tar.gz
Isabelle 2018: afp-Well_Quasi_Orders-2018-08-16.tar.gz
Isabelle 2017: afp-Well_Quasi_Orders-2017-10-10.tar.gz
Isabelle 2016-1: afp-Well_Quasi_Orders-2016-12-17.tar.gz
Isabelle 2016: afp-Well_Quasi_Orders-2016-02-22.tar.gz
Isabelle 2015: afp-Well_Quasi_Orders-2015-05-27.tar.gz
Isabelle 2014: afp-Well_Quasi_Orders-2014-08-28.tar.gz
Isabelle 2013-2: afp-Well_Quasi_Orders-2013-12-11.tar.gz
Isabelle 2013-1: afp-Well_Quasi_Orders-2013-11-17.tar.gz
Isabelle 2013: afp-Well_Quasi_Orders-2013-02-16.tar.gz
Isabelle 2012: afp-Well_Quasi_Orders-2012-05-24.tar.gz

\ No newline at end of file diff --git a/web/entries/XML.html b/web/entries/XML.html --- a/web/entries/XML.html +++ b/web/entries/XML.html @@ -1,233 +1,233 @@ XML - Archive of Formal Proofs

XML

Title:	XML
Authors:	- Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) + Christian Sternagel and + René Thiemann
Submission date:	2014-10-03
Abstract:	This entry provides an XML library for Isabelle/HOL. This includes parsing and pretty printing of XML trees as well as combinators for transforming XML trees into arbitrary user-defined data. The main contribution of this entry is an interface (fit for code generation) that allows for communication between verified programs formalized in Isabelle/HOL and the outside world via XML. This library was developed as part of the IsaFoR/CeTA project to which we refer for examples of its usage.
BibTeX:	@article{XML-AFP, author = {Christian Sternagel and René Thiemann}, title = {XML}, journal = {Archive of Formal Proofs}, month = oct, year = 2014, note = {\url{https://isa-afp.org/entries/XML.html}, Formal proof development}, ISSN = {2150-914x}, }
License:	BSD License
Depends on:	Certification_Monads, Show

Proof outline
Proof document

Browse theories

Download this entry

Older releases:

Isabelle 2021: afp-XML-2021-02-23.tar.gz
Isabelle 2020: afp-XML-2020-04-20.tar.gz
Isabelle 2019: afp-XML-2019-06-11.tar.gz
Isabelle 2018: afp-XML-2018-08-16.tar.gz
Isabelle 2017: afp-XML-2017-10-10.tar.gz
Isabelle 2016-1: afp-XML-2016-12-17.tar.gz
Isabelle 2016: afp-XML-2016-02-22.tar.gz
Isabelle 2015: afp-XML-2015-05-27.tar.gz
Isabelle 2014: afp-XML-2014-10-08.tar.gz

\ No newline at end of file diff --git a/web/index.html b/web/index.html --- a/web/index.html +++ b/web/index.html @@ -1,5891 +1,5965 @@ Archive of Formal Proofs

Archive of Formal Proofs

The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. It is organized in the way of a scientific journal, is indexed by dblp and has an ISSN: 2150-914x. Submissions are refereed. The preferred citation style is available [here]. We encourage companion AFP submissions to conference and journal publications.

A development version of the archive is available as well.

+ + + + + + +

2022

+ 2022-01-04: Knight's Tour Revisited Revisited +
+ Author: + Lukas Koller +

+ + + + + + + + + + + + + + + + + + + + + +

2021

+ 2021-12-31: Hyperdual Numbers and Forward Differentiation +
+ Authors: + Filip Smola + and Jacques Fleuriot +

+ 2021-12-29: Gale-Shapley Algorithm +
+ Author: + Tobias Nipkow +

+ 2021-12-28: Roth's Theorem on Arithmetic Progressions +
+ Authors: + Chelsea Edmonds, + Angeliki Koutsoukou-Argyraki + and Lawrence C. Paulson +

+ 2021-12-16: Markov Decision Processes with Rewards +
+ Authors: + Maximilian Schäffeler + and Mohammad Abdulaziz +

+ 2021-12-16: Verified Algorithms for Solving Markov Decision Processes +
+ Authors: + Maximilian Schäffeler + and Mohammad Abdulaziz +

+ 2021-12-15: Regular Tree Relations +
+ Authors: + Alexander Lochmann, + Bertram Felgenhauer, + Christian Sternagel, + René Thiemann + and Thomas Sternagel +

2021-11-29: Simplicial Complexes and Boolean functions
Authors: Jesús Aransay, Alejandro del Campo and Julius Michaelis

2021-11-23: van Emde Boas Trees
Authors: Thomas Ammer and Peter Lammich

2021-11-22: Foundation of geometry in planes, and some complements: Excluding the parallel axioms
Author: Fumiya Iwama

2021-11-19: The Hahn and Jordan Decomposition Theorems
Authors: Marie Cousin, Mnacho Echenim and Hervé Guiol

2021-11-08: Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL
Author: Christoph Benzmüller

2021-11-08: Real Exponents as the Limits of Sequences of Rational Exponents
Author: Jacques D. Fleuriot

2021-11-08: Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL
Authors: Christoph Benzmüller and Sebastian Reiche

2021-11-08: Factorization of Polynomials with Algebraic Coefficients
Authors: Manuel Eberl - and René Thiemann + and René Thiemann

2021-11-05: Szemerédi's Regularity Lemma
Authors: Chelsea Edmonds, - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki and Lawrence C. Paulson

2021-10-28: Quantum and Classical Registers
Author: Dominique Unruh

2021-10-19: Belief Revision Theory
Authors: Valentin Fouillard, Safouan Taha, Frédéric Boulanger and Nicolas Sabouret

2021-10-13: X86 instruction semantics and basic block symbolic execution
Authors: Freek Verbeek, Abhijith Bharadwaj, Joshua Bockenek, Ian Roessle, Timmy Weerwag and Binoy Ravindran

2021-10-12: Algebras for Iteration, Infinite Executions and Correctness of Sequential Computations
Author: Walter Guttmann

2021-10-02: Verified Quadratic Virtual Substitution for Real Arithmetic
Authors: Matias Scharager, Katherine Cordwell, Stefan Mitsch and André Platzer

2021-09-24: Soundness and Completeness of an Axiomatic System for First-Order Logic
Author: Asta Halkjær From

2021-09-18: Complex Bounded Operators
Authors: Jose Manuel Rodriguez Caballero and Dominique Unruh

2021-09-16: A Formalization of Weighted Path Orders and Recursive Path Orders
Authors: - Christian Sternagel, - René Thiemann + Christian Sternagel, + René Thiemann and Akihisa Yamada

2021-09-06: Extension of Types-To-Sets
Author: Mihails Milehins

2021-09-06: IDE: Introduction, Destruction, Elimination
Author: Mihails Milehins

2021-09-06: Conditional Transfer Rule
Author: Mihails Milehins

2021-09-06: Conditional Simplification
Author: Mihails Milehins

2021-09-06: Category Theory for ZFC in HOL III: Universal Constructions
Author: Mihails Milehins

2021-09-06: Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories
Author: Mihails Milehins

2021-09-06: Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories
Author: Mihails Milehins

2021-09-05: A data flow analysis algorithm for computing dominators
Author: Nan Jiang

2021-09-03: Solving Cubic and Quartic Equations
Author: - René Thiemann + René Thiemann

2021-08-26: Logging-independent Message Anonymity in the Relational Method
Author: Pasquale Noce

2021-08-21: The Theorem of Three Circles
Authors: Fox Thomson and Wenda Li

2021-08-16: Fresh identifiers
Authors: Andrei Popescu and Thomas Bauereiss

2021-08-16: CoSMed: A confidentiality-verified social media platform
Authors: Thomas Bauereiss and Andrei Popescu

2021-08-16: CoSMeDis: A confidentiality-verified distributed social media platform
Authors: Thomas Bauereiss and Andrei Popescu

2021-08-16: CoCon: A Confidentiality-Verified Conference Management System
Authors: Andrei Popescu, Peter Lammich and Thomas Bauereiss

2021-08-16: Compositional BD Security
Authors: Thomas Bauereiss and Andrei Popescu

2021-08-13: Combinatorial Design Theory
Authors: Chelsea Edmonds and Lawrence Paulson

2021-08-03: Relational Forests
Author: Walter Guttmann

2021-07-27: Schutz' Independent Axioms for Minkowski Spacetime
Authors: Richard Schmoetten, Jake Palmer and Jacques Fleuriot

2021-07-07: Finitely Generated Abelian Groups
Authors: Joseph Thommes and Manuel Eberl

2021-07-01: SpecCheck - Specification-Based Testing for Isabelle/ML
Authors: Kevin Kappelmann, Lukas Bulwahn and Sebastian Willenbrink

2021-06-22: Van der Waerden's Theorem
Authors: Katharina Kreuzer and Manuel Eberl

2021-06-18: MiniSail - A kernel language for the ISA specification language SAIL
Author: Mark Wassell

2021-06-17: Public Announcement Logic
Author: Asta Halkjær From

2021-06-04: A Shorter Compiler Correctness Proof for Language IMP
Author: Pasquale Noce

2021-05-24: Lyndon words
Authors: Štěpán Holub and Štěpán Starosta

2021-05-24: Graph Lemma
Authors: Štěpán Holub and Štěpán Starosta

2021-05-24: Combinatorics on Words Basics
Authors: Štěpán Holub, Martin Raška and Štěpán Starosta

2021-04-30: Regression Test Selection
Author: Susannah Mansky

2021-04-27: Isabelle's Metalogic: Formalization and Proof Checker
Authors: Tobias Nipkow and Simon Roßkopf

2021-04-27: Lifting the Exponent
Author: Jakub Kądziołka

2021-04-24: The BKR Decision Procedure for Univariate Real Arithmetic
Authors: Katherine Cordwell, Yong Kiam Tan and André Platzer

2021-04-23: Gale-Stewart Games
Author: Sebastiaan Joosten

2021-04-13: Formalization of Timely Dataflow's Progress Tracking Protocol
Authors: Matthias Brun, Sára Decova, Andrea Lattuada and Dmitriy Traytel

2021-04-01: Information Flow Control via Dependency Tracking
Author: Benedikt Nordhoff

2021-03-29: Grothendieck's Schemes in Algebraic Geometry
Authors: Anthony Bordg, Lawrence Paulson and Wenda Li

2021-03-23: Hensel's Lemma for the p-adic Integers
Author: Aaron Crighton

2021-03-17: Constructive Cryptography in HOL: the Communication Modeling Aspect
Authors: Andreas Lochbihler and S. Reza Sefidgar

2021-03-12: Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation
Authors: Ralph Bottesch, Jose Divasón - and René Thiemann + and René Thiemann

2021-03-03: Quantum projective measurements and the CHSH inequality
Author: Mnacho Echenim

2021-03-03: The Hermite–Lindemann–Weierstraß Transcendence Theorem
Author: Manuel Eberl

2021-03-01: Mereology
Author: Ben Blumson

2021-02-25: The Sunflower Lemma of Erdős and Rado
Author: - René Thiemann + René Thiemann

2021-02-24: A Verified Imperative Implementation of B-Trees
Author: Niels Mündler

2021-02-17: Formal Puiseux Series
Author: Manuel Eberl

2021-02-10: The Laws of Large Numbers
Author: Manuel Eberl

2021-01-31: Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid
Author: Roland Coghetto

2021-01-30: Solution to the xkcd Blue Eyes puzzle
Author: Jakub Kądziołka

2021-01-18: Hood-Melville Queue
Author: Alejandro Gómez-Londoño

2021-01-11: JinjaDCI: a Java semantics with dynamic class initialization
Author: Susannah Mansky

2020

2020-12-27: Cofinality and the Delta System Lemma
Author: Pedro Sánchez Terraf

2020-12-17: Topological semantics for paraconsistent and paracomplete logics
Author: David Fuenmayor

2020-12-08: Relational Minimum Spanning Tree Algorithms
Authors: Walter Guttmann and Nicolas Robinson-O'Brien

2020-12-07: Inline Caching and Unboxing Optimization for Interpreters
Author: Martin Desharnais

2020-12-05: The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols
Author: Pasquale Noce

2020-11-22: Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information
Authors: Anthony Bordg, Hanna Lachnitt and Yijun He

2020-11-19: The HOL-CSP Refinement Toolkit
Authors: Safouan Taha, Burkhart Wolff and Lina Ye

2020-10-29: Verified SAT-Based AI Planning
Authors: Mohammad Abdulaziz and Friedrich Kurz

2020-10-29: AI Planning Languages Semantics
Authors: Mohammad Abdulaziz and Peter Lammich

2020-10-20: A Sound Type System for Physical Quantities, Units, and Measurements
Authors: Simon Foster and Burkhart Wolff

2020-10-12: Finite Map Extras
Author: Javier Díaz

2020-09-28: A Formal Model of the Safely Composable Document Object Model with Shadow Roots
Authors: Achim D. Brucker and Michael Herzberg

2020-09-28: A Formal Model of the Document Object Model with Shadow Roots
Authors: Achim D. Brucker and Michael Herzberg

2020-09-28: A Formalization of Safely Composable Web Components
Authors: Achim D. Brucker and Michael Herzberg

2020-09-28: A Formalization of Web Components
Authors: Achim D. Brucker and Michael Herzberg

2020-09-28: The Safely Composable DOM
Authors: Achim D. Brucker and Michael Herzberg

2020-09-16: Syntax-Independent Logic Infrastructure
Authors: Andrei Popescu and Dmitriy Traytel

2020-09-16: Robinson Arithmetic
Authors: Andrei Popescu and Dmitriy Traytel

2020-09-16: An Abstract Formalization of Gödel's Incompleteness Theorems
Authors: Andrei Popescu and Dmitriy Traytel

2020-09-16: From Abstract to Concrete Gödel's Incompleteness Theorems—Part II
Authors: Andrei Popescu and Dmitriy Traytel

2020-09-16: From Abstract to Concrete Gödel's Incompleteness Theorems—Part I
Authors: Andrei Popescu and Dmitriy Traytel

2020-09-07: A Formal Model of Extended Finite State Machines
Authors: Michael Foster, Achim D. Brucker, Ramsay G. Taylor and John Derrick

2020-09-07: Inference of Extended Finite State Machines
Authors: Michael Foster, Achim D. Brucker, Ramsay G. Taylor and John Derrick

2020-08-31: Practical Algebraic Calculus Checker
Authors: Mathias Fleury and Daniela Kaufmann

2020-08-31: Some classical results in inductive inference of recursive functions
Author: Frank J. Balbach

2020-08-26: Relational Disjoint-Set Forests
Author: Walter Guttmann

2020-08-25: Extensions to the Comprehensive Framework for Saturation Theorem Proving
Authors: Jasmin Blanchette and Sophie Tourret

2020-08-25: Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching
Author: Peter Gammie

2020-08-04: Amicable Numbers
Author: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki

2020-08-03: Ordinal Partitions
Author: Lawrence C. Paulson

2020-07-21: A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm
Authors: Ben Fiedler and Dmitriy Traytel

2020-07-13: Relational Characterisations of Paths
Authors: Walter Guttmann and Peter Höfner

2020-06-01: A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles
Authors: Albert Rizaldi and Fabian Immler

2020-05-23: A verified algorithm for computing the Smith normal form of a matrix
Author: Jose Divasón

2020-05-16: The Nash-Williams Partition Theorem
Author: Lawrence C. Paulson

2020-05-13: A Formalization of Knuth–Bendix Orders
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2020-05-12: Irrationality Criteria for Series by Erdős and Straus
Authors: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki and Wenda Li

2020-05-11: Recursion Theorem in ZF
Author: Georgy Dunaev

2020-05-08: An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation
Author: Salomon Sickert

2020-05-06: Formalization of Forcing in Isabelle/ZF
Authors: Emmanuel Gunther, Miguel Pagano and Pedro Sánchez Terraf

2020-05-02: Banach-Steinhaus Theorem
Authors: Dominique Unruh and Jose Manuel Rodriguez Caballero

2020-04-27: Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems
Author: Florian Kammueller

2020-04-24: Power Sum Polynomials
Author: Manuel Eberl

2020-04-24: The Lambert W Function on the Reals
Author: Manuel Eberl

2020-04-24: Gaussian Integers
Author: Manuel Eberl

2020-04-19: Matrices for ODEs
Author: Jonathan Julian Huerta y Munive

2020-04-16: Authenticated Data Structures As Functors
Authors: Andreas Lochbihler and Ognjen Marić

2020-04-10: Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows
Authors: Lukas Heimes, Dmitriy Traytel and Joshua Schneider

2020-04-09: A Comprehensive Framework for Saturation Theorem Proving
Author: Sophie Tourret

2020-04-09: Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations
Authors: Thibault Dardinier, Lukas Heimes, Martin Raszyk, Joshua Schneider and Dmitriy Traytel

2020-04-08: Stateful Protocol Composition and Typing
Authors: Andreas V. Hess, Sebastian Mödersheim and Achim D. Brucker

2020-04-08: Automated Stateful Protocol Verification
Authors: Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker and Anders Schlichtkrull

2020-04-07: Lucas's Theorem
Author: Chelsea Edmonds

2020-03-25: Strong Eventual Consistency of the Collaborative Editing Framework WOOT
Authors: Emin Karayel and Edgar Gonzàlez

2020-03-22: Furstenberg's topology and his proof of the infinitude of primes
Author: Manuel Eberl

2020-03-12: An Under-Approximate Relational Logic
Author: Toby Murray

2020-03-07: Hello World
Authors: Cornelius Diekmann and Lars Hupel

2020-02-21: Implementing the Goodstein Function in λ-Calculus
Author: Bertram Felgenhauer

2020-02-10: A Generic Framework for Verified Compilers
Author: Martin Desharnais

2020-02-01: Arithmetic progressions and relative primes
Author: José Manuel Rodríguez Caballero

2020-01-31: A Hierarchy of Algebras for Boolean Subsets
Authors: Walter Guttmann and Bernhard Möller

2020-01-17: Mersenne primes and the Lucas–Lehmer test
Author: Manuel Eberl

2020-01-16: Verified Approximation Algorithms
Authors: Robin Eßmann, Tobias Nipkow, Simon Robillard and Ujkan Sulejmani

2020-01-13: Closest Pair of Points Algorithms
Authors: Martin Rau and Tobias Nipkow

2020-01-09: Skip Lists
Authors: Max W. Haslbeck and Manuel Eberl

2020-01-06: Bicategories
Author: Eugene W. Stark

2019

2019-12-27: The Irrationality of ζ(3)
Author: Manuel Eberl

2019-12-20: Formalizing a Seligman-Style Tableau System for Hybrid Logic
Author: Asta Halkjær From

2019-12-18: The Poincaré-Bendixson Theorem
Authors: Fabian Immler and Yong Kiam Tan

2019-12-16: Poincaré Disc Model
Authors: Danijela Simić, Filip Marić and Pierre Boutry

2019-12-16: Complex Geometry
Authors: Filip Marić and Danijela Simić

2019-12-10: Gauss Sums and the Pólya–Vinogradov Inequality
Authors: Rodrigo Raya and Manuel Eberl

2019-12-04: An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges
Author: Pasquale Noce

2019-11-27: Interval Arithmetic on 32-bit Words
Author: Brandon Bohrer

2019-10-24: Zermelo Fraenkel Set Theory in Higher-Order Logic
Author: Lawrence C. Paulson

2019-10-22: Isabelle/C
Authors: Frédéric Tuong and Burkhart Wolff

2019-10-16: VerifyThis 2019 -- Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer

2019-10-08: Aristotle's Assertoric Syllogistic
Author: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki

2019-10-07: Sigma Protocols and Commitment Schemes
Authors: David Butler and Andreas Lochbihler

2019-10-04: Clean - An Abstract Imperative Programming Language and its Theory
Authors: Frédéric Tuong and Burkhart Wolff

2019-09-16: Formalization of Multiway-Join Algorithms
Author: Thibault Dardinier

2019-09-10: Verification Components for Hybrid Systems
Author: Jonathan Julian Huerta y Munive

2019-09-06: Fourier Series
Author: Lawrence C Paulson

2019-08-30: A Case Study in Basic Algebra
Author: Clemens Ballarin

2019-08-16: Formalisation of an Adaptive State Counting Algorithm
Author: Robert Sachtleben

2019-08-14: Laplace Transform
Author: Fabian Immler

2019-08-06: Linear Programming
Authors: Julian Parsert and Cezary Kaliszyk

2019-08-06: Communicating Concurrent Kleene Algebra for Distributed Systems Specification
Authors: Maxime Buyse and Jason Jaskolka

2019-08-05: Selected Problems from the International Mathematical Olympiad 2019
Author: Manuel Eberl

2019-08-01: Stellar Quorum Systems
Author: Giuliano Losa

2019-07-30: A Formal Development of a Polychronous Polytimed Coordination Language
Authors: Hai Nguyen Van, Frédéric Boulanger and Burkhart Wolff

2019-07-27: Order Extension and Szpilrajn's Extension Theorem
Authors: Peter Zeller and Lukas Stevens

2019-07-18: A Sequent Calculus for First-Order Logic
Author: Asta Halkjær From

2019-07-08: A Verified Code Generator from Isabelle/HOL to CakeML
Author: Lars Hupel

2019-07-04: Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
Authors: Joshua Schneider and Dmitriy Traytel

2019-06-27: Complete Non-Orders and Fixed Points
Authors: Akihisa Yamada and Jérémy Dubut

2019-06-25: Priority Search Trees
Authors: Peter Lammich and Tobias Nipkow

2019-06-25: Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
Authors: Peter Lammich and Tobias Nipkow

2019-06-21: Linear Inequalities
Authors: Ralph Bottesch, Alban Reynaud - and René Thiemann + and René Thiemann

2019-06-16: Hilbert's Nullstellensatz
Author: Alexander Maletzky

2019-06-15: Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds
Author: Alexander Maletzky

2019-06-13: Binary Heaps for IMP2
Author: Simon Griebel

2019-06-03: Differential Game Logic
Author: André Platzer

2019-05-30: Multidimensional Binary Search Trees
Author: Martin Rau

2019-05-14: Formalization of Generic Authenticated Data Structures
Authors: Matthias Brun and Dmitriy Traytel

2019-05-09: Multi-Party Computation
Authors: David Aspinall and David Butler

2019-04-26: HOL-CSP Version 2.0
Authors: Safouan Taha, Lina Ye and Burkhart Wolff

2019-04-16: A Compositional and Unified Translation of LTL into ω-Automata
Authors: Benedikt Seidl and Salomon Sickert

2019-04-06: A General Theory of Syntax with Bindings
Authors: Lorenzo Gheri and Andrei Popescu

2019-03-27: The Transcendence of Certain Infinite Series
Authors: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki and Wenda Li

2019-03-24: Quantum Hoare Logic
Authors: Junyi Liu, Bohua Zhan, Shuling Wang, Shenggang Ying, Tao Liu, Yangjia Li, Mingsheng Ying and Naijun Zhan

2019-03-09: Safe OCL
Author: Denis Nikiforov

2019-02-21: Elementary Facts About the Distribution of Primes
Author: Manuel Eberl

2019-02-14: Kruskal's Algorithm for Minimum Spanning Forest
Authors: Maximilian P.L. Haslbeck, Peter Lammich and Julian Biendarra

2019-02-11: Probabilistic Primality Testing
Authors: Daniel Stüwe and Manuel Eberl

2019-02-08: Universal Turing Machine
Authors: Jian Xu, Xingyuan Zhang, Christian Urban and Sebastiaan J. C. Joosten

2019-02-01: Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming
Authors: Simon Foster, Frank Zeyda, Yakoub Nemouchi, Pedro Ribeiro and Burkhart Wolff

2019-02-01: The Inversions of a List
Author: Manuel Eberl

2019-01-17: Farkas' Lemma and Motzkin's Transposition Theorem
Authors: Ralph Bottesch, Max W. Haslbeck - and René Thiemann + and René Thiemann

2019-01-15: IMP2 – Simple Program Verification in Isabelle/HOL
Authors: Peter Lammich and Simon Wimmer

2019-01-15: An Algebra for Higher-Order Terms
Author: Lars Hupel

2019-01-07: A Reduction Theorem for Store Buffers
Authors: Ernie Cohen and Norbert Schirmer

2018

2018-12-26: A Formal Model of the Document Object Model
Authors: Achim D. Brucker and Michael Herzberg

2018-12-25: Formalization of Concurrent Revisions
Author: Roy Overbeek

2018-12-21: Verifying Imperative Programs using Auto2
Author: Bohua Zhan

2018-12-17: Constructive Cryptography in HOL
Authors: Andreas Lochbihler and S. Reza Sefidgar

2018-12-11: Transformer Semantics
Author: Georg Struth

2018-12-11: Quantales
Author: Georg Struth

2018-12-11: Properties of Orderings and Lattices
Author: Georg Struth

2018-11-23: Graph Saturation
Author: Sebastiaan J. C. Joosten

2018-11-23: A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette and Dmitriy Traytel

2018-11-20: Auto2 Prover
Author: Bohua Zhan

2018-11-16: Matroids
Author: Jonas Keinholz

2018-11-06: Deriving generic class instances for datatypes
Authors: Jonas Rädle and Lars Hupel

2018-10-30: Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller

2018-10-29: Epistemic Logic: Completeness of Modal Logics
Author: Asta Halkjær From

2018-10-22: Smooth Manifolds
Authors: Fabian Immler and Bohua Zhan

2018-10-19: Randomised Binary Search Trees
Author: Manuel Eberl

2018-10-19: Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms
Author: Alexander Bentkamp

2018-10-12: Upper Bounding Diameters of State Spaces of Factored Transition Systems
Authors: Friedrich Kurz and Mohammad Abdulaziz

2018-09-28: The Transcendence of π
Author: Manuel Eberl

2018-09-25: Symmetric Polynomials
Author: Manuel Eberl

2018-09-20: Signature-Based Gröbner Basis Algorithms
Author: Alexander Maletzky

2018-09-19: The Prime Number Theorem
Authors: Manuel Eberl and Lawrence C. Paulson

2018-09-15: Aggregation Algebras
Author: Walter Guttmann

2018-09-14: Octonions
Author: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki

2018-09-05: Quaternions
Author: Lawrence C. Paulson

2018-09-02: The Budan-Fourier Theorem and Counting Real Roots with Multiplicity
Author: Wenda Li

2018-08-24: An Incremental Simplex Algorithm with Unsatisfiable Core Generation
Authors: Filip Marić, Mirko Spasić - and René Thiemann + and René Thiemann

2018-08-14: Minsky Machines
Author: Bertram Felgenhauer

2018-07-16: Pricing in discrete financial models
Author: Mnacho Echenim

2018-07-04: Von-Neumann-Morgenstern Utility Theorem
Authors: Julian Parsert and Cezary Kaliszyk

2018-06-23: Pell's Equation
Author: Manuel Eberl

2018-06-14: Projective Geometry
Author: Anthony Bordg

2018-06-14: The Localization of a Commutative Ring
Author: Anthony Bordg

2018-06-05: Partial Order Reduction
Author: Julian Brunner

2018-05-27: Optimal Binary Search Trees
Authors: Tobias Nipkow and Dániel Somogyi

2018-05-25: Hidden Markov Models
Author: Simon Wimmer

2018-05-24: Probabilistic Timed Automata
Authors: Simon Wimmer and Johannes Hölzl

2018-05-23: Irrational Rapidly Convergent Series
Authors: - Angeliki Koutsoukou-Argyraki + Angeliki Koutsoukou-Argyraki and Wenda Li

2018-05-23: Axiom Systems for Category Theory in Free Logic
Authors: Christoph Benzmüller and Dana Scott

2018-05-22: Monadification, Memoization and Dynamic Programming
Authors: Simon Wimmer, Shuwei Hu and Tobias Nipkow

2018-05-10: OpSets: Sequential Specifications for Replicated Datatypes
Authors: Martin Kleppmann, Victor B. F. Gomes, Dominic P. Mulligan and Alastair R. Beresford

2018-05-07: An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties
Authors: Oliver Bračevac, Richard Gay, Sylvia Grewe, Heiko Mantel, Henning Sudbrock and Markus Tasch

2018-04-29: WebAssembly
Author: Conrad Watt

2018-04-27: VerifyThis 2018 - Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer

2018-04-24: Bounded Natural Functors with Covariance and Contravariance
Authors: Andreas Lochbihler and Joshua Schneider

2018-03-22: The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency
Authors: Felix Brandt, Manuel Eberl, Christian Saile and Christian Stricker

2018-03-13: Weight-Balanced Trees
Authors: Tobias Nipkow and Stefan Dirix

2018-03-12: CakeML
Authors: Lars Hupel and Yu Zhang

2018-03-01: A Theory of Architectural Design Patterns
Author: Diego Marmsoler

2018-02-26: Hoare Logics for Time Bounds
Authors: Maximilian P. L. Haslbeck and Tobias Nipkow

2018-02-06: Treaps
Authors: Maximilian Haslbeck, Manuel Eberl and Tobias Nipkow

2018-02-06: A verified factorization algorithm for integer polynomials with polynomial complexity
Authors: Jose Divasón, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada

2018-02-06: First-Order Terms
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2018-02-06: The Error Function
Author: Manuel Eberl

2018-02-02: A verified LLL algorithm
Authors: Ralph Bottesch, Jose Divasón, Maximilian Haslbeck, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada

2018-01-18: Formalization of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette, Dmitriy Traytel and Uwe Waldmann

2018-01-16: Gromov Hyperbolicity
Author: Sebastien Gouezel

2018-01-11: An Isabelle/HOL formalisation of Green's Theorem
Authors: Mohammad Abdulaziz and Lawrence C. Paulson

2018-01-08: Taylor Models
Authors: Christoph Traut and Fabian Immler

2017

2017-12-22: The Falling Factorial of a Sum
Author: Lukas Bulwahn

2017-12-21: The Median-of-Medians Selection Algorithm
Author: Manuel Eberl

2017-12-21: The Mason–Stothers Theorem
Author: Manuel Eberl

2017-12-21: Dirichlet L-Functions and Dirichlet's Theorem
Author: Manuel Eberl

2017-12-19: Operations on Bounded Natural Functors
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel

2017-12-18: The string search algorithm by Knuth, Morris and Pratt
Authors: Fabian Hellauer and Peter Lammich

2017-11-22: Stochastic Matrices and the Perron-Frobenius Theorem
Author: - René Thiemann + René Thiemann

2017-11-09: The IMAP CmRDT
Authors: Tim Jungnickel, Lennart Oldenburg and Matthias Loibl

2017-11-06: Hybrid Multi-Lane Spatial Logic
Author: Sven Linker

2017-10-26: The Kuratowski Closure-Complement Theorem
Authors: Peter Gammie and Gianpaolo Gioiosa

2017-10-19: Transition Systems and Automata
Author: Julian Brunner

2017-10-19: Büchi Complementation
Author: Julian Brunner

2017-10-17: Evaluate Winding Numbers through Cauchy Indices
Author: Wenda Li

2017-10-17: Count the Number of Complex Roots
Author: Wenda Li

2017-10-14: Homogeneous Linear Diophantine Equations
Authors: Florian Messner, Julian Parsert, Jonas Schöpf - and Christian Sternagel + and Christian Sternagel

2017-10-12: The Hurwitz and Riemann ζ Functions
Author: Manuel Eberl

2017-10-12: Linear Recurrences
Author: Manuel Eberl

2017-10-12: Dirichlet Series
Author: Manuel Eberl

2017-09-21: Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument
Authors: David Fuenmayor and Christoph Benzmüller

2017-09-17: Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL
Author: Daniel Kirchner

2017-09-06: Anselm's God in Isabelle/HOL
Author: Ben Blumson

2017-09-01: Microeconomics and the First Welfare Theorem
Authors: Julian Parsert and Cezary Kaliszyk

2017-08-20: Root-Balanced Tree
Author: Tobias Nipkow

2017-08-20: Orbit-Stabiliser Theorem with Application to Rotational Symmetries
Author: Jonas Rädle

2017-08-16: The LambdaMu-calculus
Authors: Cristina Matache, Victor B. F. Gomes and Dominic P. Mulligan

2017-07-31: Stewart's Theorem and Apollonius' Theorem
Author: Lukas Bulwahn

2017-07-28: Dynamic Architectures
Author: Diego Marmsoler

2017-07-21: Declarative Semantics for Functional Languages
Author: Jeremy Siek

2017-07-15: HOLCF-Prelude
Authors: Joachim Breitner, Brian Huffman, Neil Mitchell - and Christian Sternagel + and Christian Sternagel

2017-07-13: Minkowski's Theorem
Author: Manuel Eberl

2017-07-09: Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus
Author: Michael Rawson

2017-07-07: A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes
Authors: Victor B. F. Gomes, Martin Kleppmann, Dominic P. Mulligan and Alastair R. Beresford

2017-07-06: Stone-Kleene Relation Algebras
Author: Walter Guttmann

2017-06-21: Propositional Proof Systems
Authors: Julius Michaelis and Tobias Nipkow

2017-06-13: Partial Semigroups and Convolution Algebras
Authors: Brijesh Dongol, Victor B. F. Gomes, Ian J. Hayes and Georg Struth

2017-06-06: Buffon's Needle Problem
Author: Manuel Eberl

2017-06-01: Formalizing Push-Relabel Algorithms
Authors: Peter Lammich and S. Reza Sefidgar

2017-06-01: Flow Networks and the Min-Cut-Max-Flow Theorem
Authors: Peter Lammich and S. Reza Sefidgar

2017-05-25: Optics
Authors: Simon Foster and Frank Zeyda

2017-05-24: Developing Security Protocols by Refinement
Authors: Christoph Sprenger and Ivano Somaini

2017-05-24: Dictionary Construction
Author: Lars Hupel

2017-05-08: The Floyd-Warshall Algorithm for Shortest Paths
Authors: Simon Wimmer and Peter Lammich

2017-05-05: Probabilistic while loop
Author: Andreas Lochbihler

2017-05-05: Effect polymorphism in higher-order logic
Author: Andreas Lochbihler

2017-05-05: Monad normalisation
Authors: Joshua Schneider, Manuel Eberl and Andreas Lochbihler

2017-05-05: Game-based cryptography in HOL
Authors: Andreas Lochbihler, S. Reza Sefidgar and Bhargav Bhatt

2017-05-05: CryptHOL
Author: Andreas Lochbihler

2017-05-04: Monoidal Categories
Author: Eugene W. Stark

2017-05-01: Types, Tableaus and Gödel’s God in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller

2017-04-28: Local Lexing
Author: Steven Obua

2017-04-19: Constructor Functions
Author: Lars Hupel

2017-04-18: Lazifying case constants
Author: Lars Hupel

2017-04-06: Subresultants
Authors: Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada

2017-04-04: Expected Shape of Random Binary Search Trees
Author: Manuel Eberl

2017-03-15: The number of comparisons in QuickSort
Author: Manuel Eberl

2017-03-15: Lower bound on comparison-based sorting algorithms
Author: Manuel Eberl

2017-03-10: The Euler–MacLaurin Formula
Author: Manuel Eberl

2017-02-28: The Group Law for Elliptic Curves
Author: Stefan Berghofer

2017-02-26: Menger's Theorem
Author: Christoph Dittmann

2017-02-13: Differential Dynamic Logic
Author: Brandon Bohrer

2017-02-10: Abstract Soundness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel

2017-02-07: Stone Relation Algebras
Author: Walter Guttmann

2017-01-31: Refining Authenticated Key Agreement with Strong Adversaries
Authors: Joseph Lallemand and Christoph Sprenger

2017-01-24: Bernoulli Numbers
Authors: Lukas Bulwahn and Manuel Eberl

2017-01-17: Minimal Static Single Assignment Form
Authors: Max Wagner and Denis Lohner

2017-01-17: Bertrand's postulate
Authors: Julian Biendarra and Manuel Eberl

2017-01-12: The Transcendence of e
Author: Manuel Eberl

2017-01-08: Formal Network Models and Their Application to Firewall Policies
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff

2017-01-03: Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method
Author: Pasquale Noce

2017-01-01: First-Order Logic According to Harrison
Authors: Alexander Birch Jensen, Anders Schlichtkrull and Jørgen Villadsen

2016

2016-12-30: Concurrent Refinement Algebra and Rely Quotients
Authors: Julian Fell, Ian J. Hayes and Andrius Velykis

2016-12-29: The Twelvefold Way
Author: Lukas Bulwahn

2016-12-20: Proof Strategy Language
Author: Yutaka Nagashima

2016-12-07: Paraconsistency
Authors: Anders Schlichtkrull and Jørgen Villadsen

2016-11-29: COMPLX: A Verification Framework for Concurrent Imperative Programs
Authors: Sidney Amani, June Andronick, Maksym Bortin, Corey Lewis, Christine Rizkallah and Joseph Tuong

2016-11-23: Abstract Interpretation of Annotated Commands
Author: Tobias Nipkow

2016-11-16: Separata: Isabelle tactics for Separation Algebra
Authors: Zhe Hou, David Sanan, Alwen Tiu, Rajeev Gore and Ranald Clouston

2016-11-12: Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals
Authors: Jasmin Christian Blanchette, Mathias Fleury and Dmitriy Traytel

2016-11-12: Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms
Authors: Heiko Becker, Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand

2016-11-10: Expressiveness of Deep Learning
Author: Alexander Bentkamp

2016-10-25: Modal Logics for Nominal Transition Systems
Authors: Tjark Weber, Lars-Henrik Eriksson, Joachim Parrow, Johannes Borgström and Ramunas Gutkovas

2016-10-24: Stable Matching
Author: Peter Gammie

2016-10-21: LOFT — Verified Migration of Linux Firewalls to SDN
Authors: Julius Michaelis and Cornelius Diekmann

2016-10-19: Source Coding Theorem
Authors: Quentin Hibon and Lawrence C. Paulson

2016-10-19: A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor
Authors: Zhe Hou, David Sanan, Alwen Tiu and Yang Liu

2016-10-14: The Factorization Algorithm of Berlekamp and Zassenhaus
Authors: Jose Divasón, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada

2016-10-11: Intersecting Chords Theorem
Author: Lukas Bulwahn

2016-10-05: Lp spaces
Author: Sebastien Gouezel

2016-09-30: Fisher–Yates shuffle
Author: Manuel Eberl

2016-09-29: Allen's Interval Calculus
Author: Fadoua Ghourabi

2016-09-23: Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms
Authors: Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand

2016-09-09: Iptables Semantics
Authors: Cornelius Diekmann and Lars Hupel

2016-09-06: A Variant of the Superposition Calculus
Author: Nicolas Peltier

2016-09-06: Stone Algebras
Author: Walter Guttmann

2016-09-01: Stirling's formula
Author: Manuel Eberl

2016-08-31: Routing
Authors: Julius Michaelis and Cornelius Diekmann

2016-08-24: Simple Firewall
Authors: Cornelius Diekmann, Julius Michaelis and Maximilian Haslbeck

2016-08-18: Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths
Authors: Romain Aissat, Frederic Voisin and Burkhart Wolff

2016-08-12: Formalizing the Edmonds-Karp Algorithm
Authors: Peter Lammich and S. Reza Sefidgar

2016-08-08: The Imperative Refinement Framework
Author: Peter Lammich

2016-08-07: Ptolemy's Theorem
Author: Lukas Bulwahn

2016-07-17: Surprise Paradox
Author: Joachim Breitner

2016-07-14: Pairing Heap
Authors: Hauke Brinkop and Tobias Nipkow

2016-07-05: A Framework for Verifying Depth-First Search Algorithms
Authors: Peter Lammich and René Neumann

2016-07-01: Chamber Complexes, Coxeter Systems, and Buildings
Author: Jeremy Sylvestre

2016-06-30: The Z Property
Authors: Bertram Felgenhauer, Julian Nagele, Vincent van Oostrom - and Christian Sternagel + and Christian Sternagel

2016-06-30: The Resolution Calculus for First-Order Logic
Author: Anders Schlichtkrull

2016-06-28: IP Addresses
Authors: Cornelius Diekmann, Julius Michaelis and Lars Hupel

2016-06-28: Compositional Security-Preserving Refinement for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah

2016-06-26: Category Theory with Adjunctions and Limits
Author: Eugene W. Stark

2016-06-26: Cardinality of Multisets
Author: Lukas Bulwahn

2016-06-25: A Dependent Security Type System for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah

2016-06-21: Catalan Numbers
Author: Manuel Eberl

2016-06-18: Program Construction and Verification Components Based on Kleene Algebra
Authors: Victor B. F. Gomes and Georg Struth

2016-06-13: Conservation of CSP Noninterference Security under Concurrent Composition
Author: Pasquale Noce

2016-06-09: Finite Machine Word Library
Authors: Joel Beeren, Matthew Fernandez, Xin Gao, Gerwin Klein, Rafal Kolanski, Japheth Lim, Corey Lewis, Daniel Matichuk and Thomas Sewell

2016-05-31: Tree Decomposition
Author: Christoph Dittmann

2016-05-24: POSIX Lexing with Derivatives of Regular Expressions
Authors: Fahad Ausaf, Roy Dyckhoff and Christian Urban

2016-05-24: Cardinality of Equivalence Relations
Author: Lukas Bulwahn

2016-05-20: Perron-Frobenius Theorem for Spectral Radius Analysis
Authors: Jose Divasón, Ondřej Kunčar, - René Thiemann + René Thiemann and Akihisa Yamada

2016-05-20: The meta theory of the Incredible Proof Machine
Authors: Joachim Breitner and Denis Lohner

2016-05-18: A Constructive Proof for FLP
Authors: Benjamin Bisping, Paul-David Brodmann, Tim Jungnickel, Christina Rickmann, Henning Seidler, Anke Stüber, Arno Wilhelm-Weidner, Kirstin Peters and Uwe Nestmann

2016-05-09: A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks
Author: Andreas Lochbihler

2016-05-05: Randomised Social Choice Theory
Author: Manuel Eberl

2016-05-04: The Incompatibility of SD-Efficiency and SD-Strategy-Proofness
Author: Manuel Eberl

2016-05-04: Spivey's Generalized Recurrence for Bell Numbers
Author: Lukas Bulwahn

2016-05-02: Gröbner Bases Theory
Authors: Fabian Immler and Alexander Maletzky

2016-04-28: No Faster-Than-Light Observers
Authors: Mike Stannett and István Németi

2016-04-27: Algorithms for Reduced Ordered Binary Decision Diagrams
Authors: Julius Michaelis, Maximilian Haslbeck, Peter Lammich and Lars Hupel

2016-04-27: A formalisation of the Cocke-Younger-Kasami algorithm
Author: Maksym Bortin

2016-04-26: Conservation of CSP Noninterference Security under Sequential Composition
Author: Pasquale Noce

2016-04-12: Kleene Algebras with Domain
Authors: Victor B. F. Gomes, Walter Guttmann, Peter Höfner, Georg Struth and Tjark Weber

2016-03-11: Propositional Resolution and Prime Implicates Generation
Author: Nicolas Peltier

2016-03-08: Timed Automata
Author: Simon Wimmer

2016-03-08: The Cartan Fixed Point Theorems
Author: Lawrence C. Paulson

2016-03-01: Linear Temporal Logic
Author: Salomon Sickert

2016-02-17: Analysis of List Update Algorithms
Authors: Maximilian P.L. Haslbeck and Tobias Nipkow

2016-02-05: Verified Construction of Static Single Assignment Form
Authors: Sebastian Ullrich and Denis Lohner

2016-01-29: Polynomial Interpolation
Authors: - René Thiemann + René Thiemann and Akihisa Yamada

2016-01-29: Polynomial Factorization
Authors: - René Thiemann + René Thiemann and Akihisa Yamada

2016-01-20: Knot Theory
Author: T.V.H. Prathamesh

2016-01-18: Tensor Product of Matrices
Author: T.V.H. Prathamesh

2016-01-14: Cardinality of Number Partitions
Author: Lukas Bulwahn

2015

2015-12-28: Basic Geometric Properties of Triangles
Author: Manuel Eberl

2015-12-28: The Divergence of the Prime Harmonic Series
Author: Manuel Eberl

2015-12-28: Liouville numbers
Author: Manuel Eberl

2015-12-28: Descartes' Rule of Signs
Author: Manuel Eberl

2015-12-22: The Stern-Brocot Tree
Authors: Peter Gammie and Andreas Lochbihler

2015-12-22: Applicative Lifting
Authors: Andreas Lochbihler and Joshua Schneider

2015-12-22: Algebraic Numbers in Isabelle/HOL
Authors: - René Thiemann, + René Thiemann, Akihisa Yamada and Sebastiaan Joosten

2015-12-12: Cardinality of Set Partitions
Author: Lukas Bulwahn

2015-12-02: Latin Square
Author: Alexander Bentkamp

2015-12-01: Ergodic Theory
Author: Sebastien Gouezel

2015-11-19: Euler's Partition Theorem
Author: Lukas Bulwahn

2015-11-18: The Tortoise and Hare Algorithm
Author: Peter Gammie

2015-11-11: Planarity Certificates
Author: Lars Noschinski

2015-11-02: Positional Determinacy of Parity Games
Author: Christoph Dittmann

2015-09-16: A Meta-Model for the Isabelle API
Authors: Frédéric Tuong and Burkhart Wolff

2015-09-04: Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata
Author: Salomon Sickert

2015-08-21: Matrices, Jordan Normal Forms, and Spectral Radius Theory
Authors: - René Thiemann + René Thiemann and Akihisa Yamada

2015-08-20: Decreasing Diagrams II
Author: Bertram Felgenhauer

2015-08-18: The Inductive Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce

2015-08-12: Representations of Finite Groups
Author: Jeremy Sylvestre

2015-08-10: Analysing and Comparing Encodability Criteria for Process Calculi
Authors: Kirstin Peters and Rob van Glabbeek

2015-07-21: Generating Cases from Labeled Subgoals
Author: Lars Noschinski

2015-07-14: Landau Symbols
Author: Manuel Eberl

2015-07-14: The Akra-Bazzi theorem and the Master theorem
Author: Manuel Eberl

2015-07-07: Hermite Normal Form
Authors: Jose Divasón and Jesús Aransay

2015-06-27: Derangements Formula
Author: Lukas Bulwahn

2015-06-11: The Ipurge Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce

2015-06-11: The Generic Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce

2015-06-11: Binary Multirelations
Authors: Hitoshi Furusawa and Georg Struth

2015-06-11: Reasoning about Lists via List Interleaving
Author: Pasquale Noce

2015-06-07: Parameterized Dynamic Tables
Author: Tobias Nipkow

2015-05-28: Derivatives of Logical Formulas
Author: Dmitriy Traytel

2015-05-27: A Zoo of Probabilistic Systems
Authors: Johannes Hölzl, Andreas Lochbihler and Dmitriy Traytel

2015-04-30: VCG - Combinatorial Vickrey-Clarke-Groves Auctions
Authors: Marco B. Caminati, Manfred Kerber, Christoph Lange and Colin Rowat

2015-04-15: Residuated Lattices
Authors: Victor B. F. Gomes and Georg Struth

2015-04-13: Concurrent IMP
Author: Peter Gammie

2015-04-13: Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO
Authors: Peter Gammie, Tony Hosking and Kai Engelhardt

2015-03-30: Trie
Authors: Andreas Lochbihler and Tobias Nipkow

2015-03-18: Consensus Refined
Authors: Ognjen Maric and Christoph Sprenger

2015-03-11: Deriving class instances for datatypes
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2015-02-20: The Safety of Call Arity
Author: Joachim Breitner

2015-02-12: QR Decomposition
Authors: Jose Divasón and Jesús Aransay

2015-02-12: Echelon Form
Authors: Jose Divasón and Jesús Aransay

2015-02-05: Finite Automata in Hereditarily Finite Set Theory
Author: Lawrence C. Paulson

2015-01-28: Verification of the UpDown Scheme
Author: Johannes Hölzl

2014

2014-11-28: The Unified Policy Framework (UPF)
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff

2014-10-23: Loop freedom of the (untimed) AODV routing protocol
Authors: Timothy Bourke and Peter Höfner

2014-10-13: Lifting Definition Option
Author: - René Thiemann + René Thiemann

2014-10-10: Stream Fusion in HOL with Code Generation
Authors: Andreas Lochbihler and Alexandra Maximova

2014-10-09: A Verified Compiler for Probability Density Functions
Authors: Manuel Eberl, Johannes Hölzl and Tobias Nipkow

2014-10-08: Formalization of Refinement Calculus for Reactive Systems
Author: Viorel Preoteasa

2014-10-03: XML
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2014-10-03: Certification Monads
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2014-09-25: Imperative Insertion Sort
Author: - Christian Sternagel + Christian Sternagel

2014-09-19: The Sturm-Tarski Theorem
Author: Wenda Li

2014-09-15: The Cayley-Hamilton Theorem
Authors: Stephan Adelsberger, Stefan Hetzl and Florian Pollak

2014-09-09: The Jordan-Hölder Theorem
Author: Jakob von Raumer

2014-09-04: Priority Queues Based on Braun Trees
Author: Tobias Nipkow

2014-09-03: Gauss-Jordan Algorithm and Its Applications
Authors: Jose Divasón and Jesús Aransay

2014-08-29: Vector Spaces
Author: Holden Lee

2014-08-29: Real-Valued Special Functions: Upper and Lower Bounds
Author: Lawrence C. Paulson

2014-08-13: Skew Heap
Author: Tobias Nipkow

2014-08-12: Splay Tree
Author: Tobias Nipkow

2014-07-29: Haskell's Show Class in Isabelle/HOL
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2014-07-18: Formal Specification of a Generic Separation Kernel
Authors: Freek Verbeek, Sergey Tverdyshev, Oto Havle, Holger Blasum, Bruno Langenstein, Werner Stephan, Yakoub Nemouchi, Abderrahmane Feliachi, Burkhart Wolff and Julien Schmaltz

2014-07-13: pGCL for Isabelle
Author: David Cock

2014-07-07: Amortized Complexity Verified
Author: Tobias Nipkow

2014-07-04: Network Security Policy Verification
Author: Cornelius Diekmann

2014-07-03: Pop-Refinement
Author: Alessandro Coglio

2014-06-12: Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions
Authors: Dmitriy Traytel and Tobias Nipkow

2014-06-08: Boolean Expression Checkers
Author: Tobias Nipkow

2014-05-28: Promela Formalization
Author: René Neumann

2014-05-28: Converting Linear-Time Temporal Logic to Generalized Büchi Automata
Authors: Alexander Schimpf and Peter Lammich

2014-05-28: Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm
Author: Peter Lammich

2014-05-28: A Fully Verified Executable LTL Model Checker
Authors: Javier Esparza, Peter Lammich, René Neumann, Tobias Nipkow, Alexander Schimpf and Jan-Georg Smaus

2014-05-28: The CAVA Automata Library
Author: Peter Lammich

2014-05-23: Transitive closure according to Roy-Floyd-Warshall
Author: Makarius Wenzel

2014-05-23: Noninterference Security in Communicating Sequential Processes
Author: Pasquale Noce

2014-05-21: Regular Algebras
Authors: Simon Foster and Georg Struth

2014-04-28: Formalisation and Analysis of Component Dependencies
Author: Maria Spichkova

2014-04-23: A Formalization of Declassification with WHAT-and-WHERE-Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer

2014-04-23: A Formalization of Strong Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer

2014-04-23: A Formalization of Assumptions and Guarantees for Compositional Noninterference
Authors: Sylvia Grewe, Heiko Mantel and Daniel Schoepe

2014-04-22: Bounded-Deducibility Security
Authors: Andrei Popescu, Peter Lammich and Thomas Bauereiss

2014-04-16: A shallow embedding of HyperCTL*
Authors: Markus N. Rabe, Peter Lammich and Andrei Popescu

2014-04-16: Abstract Completeness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel

2014-04-13: Discrete Summation
Author: Florian Haftmann

2014-04-03: Syntax and semantics of a GPU kernel programming language
Author: John Wickerson

2014-03-11: Probabilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl

2014-03-08: Mechanization of the Algebra for Wireless Networks (AWN)
Author: Timothy Bourke

2014-02-18: Mutually Recursive Partial Functions
Author: - René Thiemann + René Thiemann

2014-02-13: Properties of Random Graphs -- Subgraph Containment
Author: Lars Hupel

2014-02-11: Verification of Selection and Heap Sort Using Locales
Author: Danijela Petrovic

2014-02-07: Affine Arithmetic
Author: Fabian Immler

2014-02-06: Implementing field extensions of the form Q[sqrt(b)]
Author: - René Thiemann + René Thiemann

2014-01-30: Unified Decision Procedures for Regular Expression Equivalence
Authors: Tobias Nipkow and Dmitriy Traytel

2014-01-28: Secondary Sylow Theorems
Author: Jakob von Raumer

2014-01-25: Relation Algebra
Authors: Alasdair Armstrong, Simon Foster, Georg Struth and Tjark Weber

2014-01-23: Kleene Algebra with Tests and Demonic Refinement Algebras
Authors: Alasdair Armstrong, Victor B. F. Gomes and Georg Struth

2014-01-16: Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5
Authors: Achim D. Brucker, Frédéric Tuong and Burkhart Wolff

2014-01-11: Sturm's Theorem
Author: Manuel Eberl

2014-01-11: Compositional Properties of Crypto-Based Components
Author: Maria Spichkova

2013

2013-12-01: A General Method for the Proof of Theorems on Tail-recursive Functions
Author: Pasquale Noce

2013-11-17: Gödel's Incompleteness Theorems
Author: Lawrence C. Paulson

2013-11-17: The Hereditarily Finite Sets
Author: Lawrence C. Paulson

2013-11-15: A Codatatype of Formal Languages
Author: Dmitriy Traytel

2013-11-14: Stream Processing Components: Isabelle/HOL Formalisation and Case Studies
Author: Maria Spichkova

2013-11-12: Gödel's God in Isabelle/HOL
Authors: Christoph Benzmüller and Bruno Woltzenlogel Paleo

2013-11-01: Decreasing Diagrams
Author: Harald Zankl

2013-10-02: Automatic Data Refinement
Author: Peter Lammich

2013-09-17: Native Word
Author: Andreas Lochbihler

2013-07-27: A Formal Model of IEEE Floating Point Arithmetic
Author: Lei Yu

2013-07-22: Pratt's Primality Certificates
Authors: Simon Wimmer and Lars Noschinski

2013-07-22: Lehmer's Theorem
Authors: Simon Wimmer and Lars Noschinski

2013-07-19: The Königsberg Bridge Problem and the Friendship Theorem
Author: Wenda Li

2013-06-27: Sound and Complete Sort Encodings for First-Order Logic
Authors: Jasmin Christian Blanchette and Andrei Popescu

2013-05-22: An Axiomatic Characterization of the Single-Source Shortest Path Problem
Author: Christine Rizkallah

2013-04-28: Graph Theory
Author: Lars Noschinski

2013-04-15: Light-weight Containers
Author: Andreas Lochbihler

2013-02-21: Nominal 2
Authors: Christian Urban, Stefan Berghofer and Cezary Kaliszyk

2013-01-31: The Correctness of Launchbury's Natural Semantics for Lazy Evaluation
Author: Joachim Breitner

2013-01-19: Ribbon Proofs
Author: John Wickerson

2013-01-16: Rank-Nullity Theorem in Linear Algebra
Authors: Jose Divasón and Jesús Aransay

2013-01-15: Kleene Algebra
Authors: Alasdair Armstrong, Georg Struth and Tjark Weber

2013-01-03: Computing N-th Roots using the Babylonian Method
Author: - René Thiemann + René Thiemann

2012

2012-11-14: A Separation Logic Framework for Imperative HOL
Authors: Peter Lammich and Rene Meis

2012-11-02: Open Induction
Authors: Mizuhito Ogawa - and Christian Sternagel + and Christian Sternagel

2012-10-30: The independence of Tarski's Euclidean axiom
Author: T. J. M. Makarios

2012-10-27: Bondy's Theorem
Authors: Jeremy Avigad and Stefan Hetzl

2012-09-10: Possibilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl

2012-08-07: Generating linear orders for datatypes
Author: - René Thiemann + René Thiemann

2012-08-05: Proving the Impossibility of Trisecting an Angle and Doubling the Cube
Authors: Ralph Romanos and Lawrence C. Paulson

2012-07-27: Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model
Authors: Henri Debrat and Stephan Merz

2012-07-01: Logical Relations for PCF
Author: Peter Gammie

2012-06-26: Type Constructor Classes and Monad Transformers
Author: Brian Huffman

2012-05-29: Psi-calculi in Isabelle
Author: Jesper Bengtson

2012-05-29: The pi-calculus in nominal logic
Author: Jesper Bengtson

2012-05-29: CCS in nominal logic
Author: Jesper Bengtson

2012-05-27: Isabelle/Circus
Authors: Abderrahmane Feliachi, Burkhart Wolff and Marie-Claude Gaudel

2012-05-11: Separation Algebra
Authors: Gerwin Klein, Rafal Kolanski and Andrew Boyton

2012-05-07: Stuttering Equivalence
Author: Stephan Merz

2012-05-02: Inductive Study of Confidentiality
Author: Giampaolo Bella

2012-04-26: Ordinary Differential Equations
Authors: Fabian Immler and Johannes Hölzl

2012-04-13: Well-Quasi-Orders
Author: - Christian Sternagel + Christian Sternagel

2012-03-01: Abortable Linearizable Modules
Authors: Rachid Guerraoui, Viktor Kuncak and Giuliano Losa

2012-02-29: Executable Transitive Closures
Author: - René Thiemann + René Thiemann

2012-02-06: A Probabilistic Proof of the Girth-Chromatic Number Theorem
Author: Lars Noschinski

2012-01-30: Refinement for Monadic Programs
Author: Peter Lammich

2012-01-30: Dijkstra's Shortest Path Algorithm
Authors: Benedikt Nordhoff and Peter Lammich

2012-01-03: Markov Models
Authors: Johannes Hölzl and Tobias Nipkow

2011

2011-11-19: A Definitional Encoding of TLA* in Isabelle/HOL
Authors: Gudmund Grov and Stephan Merz

2011-11-09: Efficient Mergesort
Author: - Christian Sternagel + Christian Sternagel

2011-09-22: Pseudo Hoops
Authors: George Georgescu, Laurentiu Leustean and Viorel Preoteasa

2011-09-22: Algebra of Monotonic Boolean Transformers
Author: Viorel Preoteasa

2011-09-22: Lattice Properties
Author: Viorel Preoteasa

2011-08-26: The Myhill-Nerode Theorem Based on Regular Expressions
Authors: Chunhan Wu, Xingyuan Zhang and Christian Urban

2011-08-19: Gauss-Jordan Elimination for Matrices Represented as Functions
Author: Tobias Nipkow

2011-07-21: Maximum Cardinality Matching
Author: Christine Rizkallah

2011-05-17: Knowledge-based programs
Author: Peter Gammie

2011-04-01: The General Triangle Is Unique
Author: Joachim Breitner

2011-03-14: Executable Transitive Closures of Finite Relations
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2011-02-23: Interval Temporal Logic on Natural Numbers
Author: David Trachtenherz

2011-02-23: Infinite Lists
Author: David Trachtenherz

2011-02-23: AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics
Author: David Trachtenherz

2011-02-07: Lightweight Java
Authors: Rok Strniša and Matthew Parkinson

2011-01-10: RIPEMD-160
Author: Fabian Immler

2011-01-08: Lower Semicontinuous Functions
Author: Bogdan Grechuk

2010

2010-12-17: Hall's Marriage Theorem
Authors: Dongchen Jiang and Tobias Nipkow

2010-11-16: Shivers' Control Flow Analysis
Author: Joachim Breitner

2010-10-28: Finger Trees
Authors: Benedikt Nordhoff, Stefan Körner and Peter Lammich

2010-10-28: Functional Binomial Queues
Author: René Neumann

2010-10-28: Binomial Heaps and Skew Binomial Heaps
Authors: Rene Meis, Finn Nielsen and Peter Lammich

2010-08-29: Strong Normalization of Moggis's Computational Metalanguage
Author: Christian Doczkal

2010-08-10: Executable Multivariate Polynomials
Authors: - Christian Sternagel, - René Thiemann, + Christian Sternagel, + René Thiemann, Alexander Maletzky, Fabian Immler, Florian Haftmann, Andreas Lochbihler and Alexander Bentkamp

2010-08-08: Formalizing Statecharts using Hierarchical Automata
Authors: Steffen Helke and Florian Kammüller

2010-06-24: Free Groups
Author: Joachim Breitner

2010-06-20: Category Theory
Author: Alexander Katovsky

2010-06-17: Executable Matrix Operations on Matrices of Arbitrary Dimensions
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2010-06-14: Abstract Rewriting
Authors: - Christian Sternagel - and René Thiemann + Christian Sternagel + and René Thiemann

2010-05-28: Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement
Authors: Viorel Preoteasa and Ralph-Johan Back

2010-05-28: Semantics and Data Refinement of Invariant Based Programs
Authors: Viorel Preoteasa and Ralph-Johan Back

2010-05-22: A Complete Proof of the Robbins Conjecture
Author: Matthew Wampler-Doty

2010-05-12: Regular Sets and Expressions
Authors: Alexander Krauss and Tobias Nipkow

2010-04-30: Locally Nameless Sigma Calculus
Authors: Ludovic Henrio, Florian Kammüller, Bianca Lutz and Henry Sudhof

2010-03-29: Free Boolean Algebra
Author: Brian Huffman

2010-03-23: Inter-Procedural Information Flow Noninterference via Slicing
Author: Daniel Wasserrab

2010-03-23: Information Flow Noninterference via Slicing
Author: Daniel Wasserrab

2010-02-20: List Index
Author: Tobias Nipkow

2010-02-12: Coinductive
Author: Andreas Lochbihler

2009

2009-12-09: A Fast SAT Solver for Isabelle in Standard ML
Author: Armin Heller

2009-12-03: Formalizing the Logic-Automaton Connection
Authors: Stefan Berghofer and Markus Reiter

2009-11-25: Tree Automata
Author: Peter Lammich

2009-11-25: Collections Framework
Author: Peter Lammich

2009-11-22: Perfect Number Theorem
Author: Mark Ijbema

2009-11-13: Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer
Author: Daniel Wasserrab

2009-10-30: The Worker/Wrapper Transformation
Author: Peter Gammie

2009-09-01: Ordinals and Cardinals
Author: Andrei Popescu

2009-08-28: Invertibility in Sequent Calculi
Author: Peter Chapman

2009-08-04: An Example of a Cofinitary Group in Isabelle/HOL
Author: Bart Kastermans

2009-05-06: Code Generation for Functions as Data
Author: Andreas Lochbihler

2009-04-29: Stream Fusion
Author: Brian Huffman

2008

2008-12-12: A Bytecode Logic for JML and Types
Authors: Lennart Beringer and Martin Hofmann

2008-11-10: Secure information flow and program logics
Authors: Lennart Beringer and Martin Hofmann

2008-11-09: Some classical results in Social Choice Theory
Author: Peter Gammie

2008-11-07: Fun With Tilings
Authors: Tobias Nipkow and Lawrence C. Paulson

2008-10-15: The Textbook Proof of Huffman's Algorithm
Author: Jasmin Christian Blanchette

2008-09-16: Towards Certified Slicing
Author: Daniel Wasserrab

2008-09-02: A Correctness Proof for the Volpano/Smith Security Typing System
Authors: Gregor Snelting and Daniel Wasserrab

2008-09-01: Arrow and Gibbard-Satterthwaite
Author: Tobias Nipkow

2008-08-26: Fun With Functions
Author: Tobias Nipkow

2008-07-23: Formal Verification of Modern SAT Solvers
Author: Filip Marić

2008-04-05: Recursion Theory I
Author: Michael Nedzelsky

2008-02-29: A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment
Author: Norbert Schirmer

2008-02-29: BDD Normalisation
Authors: Veronika Ortner and Norbert Schirmer

2008-02-18: Normalization by Evaluation
Authors: Klaus Aehlig and Tobias Nipkow

2008-01-11: Quantifier Elimination for Linear Arithmetic
Author: Tobias Nipkow

2007

2007-12-14: Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors
Authors: Peter Lammich and Markus Müller-Olm

2007-12-03: Jinja with Threads
Author: Andreas Lochbihler

2007-11-06: Much Ado About Two
Author: Sascha Böhme

2007-08-12: Sums of Two and Four Squares
Author: Roelof Oosterhuis

2007-08-12: Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples
Author: Roelof Oosterhuis

2007-08-08: Fundamental Properties of Valuation Theory and Hensel's Lemma
Author: Hidetsune Kobayashi

2007-08-02: POPLmark Challenge Via de Bruijn Indices
Author: Stefan Berghofer

2007-08-02: First-Order Logic According to Fitting
Author: Stefan Berghofer

2006

2006-09-09: Hotel Key Card System
Author: Tobias Nipkow

2006-08-08: Abstract Hoare Logics
Author: Tobias Nipkow

2006-05-22: Flyspeck I: Tame Graphs
Authors: Gertrud Bauer and Tobias Nipkow

2006-05-15: CoreC++
Author: Daniel Wasserrab

2006-03-31: A Theory of Featherweight Java in Isabelle/HOL
Authors: J. Nathan Foster and Dimitrios Vytiniotis

2006-03-15: Instances of Schneider's generalized protocol of clock synchronization
Author: Damián Barsotti

2006-03-14: Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality
Author: Benjamin Porter

2005

2005-11-11: Countable Ordinals
Author: Brian Huffman

2005-10-12: Fast Fourier Transform
Author: Clemens Ballarin

2005-06-24: Formalization of a Generalized Protocol for Clock Synchronization
Author: Alwen Tiu

2005-06-22: Proving the Correctness of Disk Paxos
Authors: Mauro Jaskelioff and Stephan Merz

2005-06-20: Jive Data and Store Model
Authors: Nicole Rauch and Norbert Schirmer

2005-06-01: Jinja is not Java
Authors: Gerwin Klein and Tobias Nipkow

2005-05-02: SHA1, RSA, PSS and more
Authors: Christina Lindenberg and Kai Wirt

2005-04-21: Category Theory to Yoneda's Lemma
Author: Greg O'Keefe

2004

2004-12-09: File Refinement
Authors: Karen Zee and Viktor Kuncak

2004-11-19: Integration theory and random variables
Author: Stefan Richter

2004-09-28: A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic
Author: Tom Ridge

2004-09-20: Ramsey's theorem, infinitary version
Author: Tom Ridge

2004-09-20: Completeness theorem
Authors: James Margetson and Tom Ridge

2004-07-09: Compiling Exceptions Correctly
Author: Tobias Nipkow

2004-06-24: Depth First Search
Authors: Toshiaki Nishihara and Yasuhiko Minamide

2004-05-18: Groups, Rings and Modules
Authors: Hidetsune Kobayashi, L. Chen and H. Murao

2004-04-26: Topology
Author: Stefan Friedrich

2004-04-26: Lazy Lists II
Author: Stefan Friedrich

2004-04-05: Binary Search Trees
Author: Viktor Kuncak

2004-03-30: Functional Automata
Author: Tobias Nipkow

2004-03-19: Mini ML
Authors: Wolfgang Naraschewski and Tobias Nipkow

2004-03-19: AVL Trees
Authors: Tobias Nipkow and Cornelia Pusch

\ No newline at end of file diff --git a/web/rss.xml b/web/rss.xml --- a/web/rss.xml +++ b/web/rss.xml @@ -1,583 +1,618 @@ Archive of Formal Proofs https://www.isa-afp.org The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. - 29 Nov 2021 00:00:00 +0000 + 04 Jan 2022 00:00:00 +0000 + + Knight's Tour Revisited Revisited + https://www.isa-afp.org/entries/Knights_Tour.html + https://www.isa-afp.org/entries/Knights_Tour.html + Lukas Koller + 04 Jan 2022 00:00:00 +0000 + +This is a formalization of the article Knight's Tour Revisited by +Cull and De Curtins where they prove the existence of a Knight's +path for arbitrary n × m-boards with min(n,m) ≥ +5. If n · m is even, then there exists a Knight's +circuit. A Knight's Path is a sequence of moves of a Knight on a +chessboard s.t. the Knight visits every square of a chessboard +exactly once. Finding a Knight's path is a an instance of the +Hamiltonian path problem. A Knight's circuit is a Knight's path, +where additionally the Knight can move from the last square to the +first square of the path, forming a loop. During the formalization +two mistakes in the original proof were discovered. These mistakes +are corrected in this formalization. + + + Hyperdual Numbers and Forward Differentiation + https://www.isa-afp.org/entries/Hyperdual.html + https://www.isa-afp.org/entries/Hyperdual.html + Filip Smola, Jacques Fleuriot + 31 Dec 2021 00:00:00 +0000 + +Hyperdual numbers are ones with a real component and a number +of infinitesimal components, usually written as $a_0 + a_1 \cdot +\epsilon_1 + a_2 \cdot \epsilon_2 + a_3 \cdot \epsilon_1\epsilon_2$. +They have been proposed by <a +href="https://doi.org/10.2514/6.2011-886">Fike and +Alonso</a> in an approach to automatic +differentiation. In this entry we formalise +hyperdual numbers and their application to forward differentiation. We +show them to be an instance of multiple algebraic structures and then, +along with facts about twice-differentiability, we define what we call +the hyperdual extensions of functions on real-normed fields. This +extension formally represents the proposed way that the first and +second derivatives of a function can be automatically calculated. We +demonstrate it on the standard logistic function $f(x) = \frac{1}{1 + +e^{-x}}$ and also reproduce the example analytic function $f(x) = +\frac{e^x}{\sqrt{sin(x)^3 + cos(x)^3}}$ used for demonstration by Fike +and Alonso. + + + Gale-Shapley Algorithm + https://www.isa-afp.org/entries/Gale_Shapley.html + https://www.isa-afp.org/entries/Gale_Shapley.html + Tobias Nipkow + 29 Dec 2021 00:00:00 +0000 + +This is a stepwise refinement and proof of the Gale-Shapley stable +matching (or marriage) algorithm down to executable code. Both a +purely functional implementation based on lists and a functional +implementation based on efficient arrays (provided by the Collections +Framework in the AFP) are developed. The latter implementation runs in +time O(n2) where +n is the cardinality of the two sets to be matched. + + + Roth's Theorem on Arithmetic Progressions + https://www.isa-afp.org/entries/Roth_Arithmetic_Progressions.html + https://www.isa-afp.org/entries/Roth_Arithmetic_Progressions.html + Chelsea Edmonds, Angeliki Koutsoukou-Argyraki, Lawrence C. Paulson + 28 Dec 2021 00:00:00 +0000 + +We formalise a proof of Roth's Theorem on Arithmetic +Progressions, a major result in additive combinatorics on the +existence of 3-term arithmetic progressions in subsets of natural +numbers. To this end, we follow a proof using graph regularity. We +employ our recent formalisation of Szemerédi's Regularity Lemma, +a major result in extremal graph theory, which we use here to prove +the Triangle Counting Lemma and the Triangle Removal Lemma. Our +sources are Yufei Zhao's MIT lecture notes +"<a href="https://ocw.mit.edu/courses/mathematics/18-217-graph-theory-and-additive-combinatorics-fall-2019/lecture-notes/MIT18_217F19_ch3.pdf">Graph Theory and Additive Combinatorics</a>" +(revised version <a href="https://yufeizhao.com/gtac/gtac17.pdf">here</a>) +and W.T. Gowers's Cambridge lecture notes +"<a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Topics in Combinatorics</a>". +We also refer to the University of +Georgia notes by Stephanie Bell and Will Grodzicki, +"<a href="http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.432.327">Using Szemerédi's Regularity Lemma to Prove Roth's Theorem</a>". + + + Markov Decision Processes with Rewards + https://www.isa-afp.org/entries/MDP-Rewards.html + https://www.isa-afp.org/entries/MDP-Rewards.html + Maximilian Schäffeler, Mohammad Abdulaziz + 16 Dec 2021 00:00:00 +0000 + +We present a formalization of Markov Decision Processes with rewards. +In particular we first build on Hölzl's formalization of MDPs +(AFP entry: Markov_Models) and extend them with rewards. We proceed +with an analysis of the expected total discounted reward criterion for +infinite horizon MDPs. The central result is the construction of the +iteration rule for the Bellman operator. We prove the optimality +equations for this operator and show the existence of an optimal +stationary deterministic solution. The analysis can be used to obtain +dynamic programming algorithms such as value iteration and policy +iteration to solve MDPs with formal guarantees. Our formalization is +based on chapters 5 and 6 in Puterman's book "Markov +Decision Processes: Discrete Stochastic Dynamic Programming". + + + Verified Algorithms for Solving Markov Decision Processes + https://www.isa-afp.org/entries/MDP-Algorithms.html + https://www.isa-afp.org/entries/MDP-Algorithms.html + Maximilian Schäffeler, Mohammad Abdulaziz + 16 Dec 2021 00:00:00 +0000 + +We present a formalization of algorithms for solving Markov Decision +Processes (MDPs) with formal guarantees on the optimality of their +solutions. In particular we build on our analysis of the Bellman +operator for discounted infinite horizon MDPs. From the iterator rule +on the Bellman operator we directly derive executable value iteration +and policy iteration algorithms to iteratively solve finite MDPs. We +also prove correct optimized versions of value iteration that use +matrix splittings to improve the convergence rate. In particular, we +formally verify Gauss-Seidel value iteration and modified policy +iteration. The algorithms are evaluated on two standard examples from +the literature, namely, inventory management and gridworld. Our +formalization covers most of chapter 6 in Puterman's book +"Markov Decision Processes: Discrete Stochastic Dynamic +Programming". + + + Regular Tree Relations + https://www.isa-afp.org/entries/Regular_Tree_Relations.html + https://www.isa-afp.org/entries/Regular_Tree_Relations.html + Alexander Lochmann, Bertram Felgenhauer, Christian Sternagel, René Thiemann, Thomas Sternagel + 15 Dec 2021 00:00:00 +0000 + +Tree automata have good closure properties and therefore a commonly +used to prove/disprove properties. This formalization contains among +other things the proofs of many closure properties of tree automata +(anchored) ground tree transducers and regular relations. Additionally +it includes the well known pumping lemma and a lifting of the Myhill +Nerode theorem for regular languages to tree languages. We want to +mention the existence of a <a +href="https://www.isa-afp.org/entries/Tree-Automata.html">tree +automata APF-entry</a> developed by Peter Lammich. His work is +based on epsilon free top-down tree automata, while this entry builds +on bottom-up tree auotamta with epsilon transitions. Moreover our +formalization relies on the <a +href="https://www.isa-afp.org/entries/Collections.html">Collections +Framework</a>, also by Peter Lammich, to obtain efficient code. +All proven constructions of the closure properties are exportable +using the Isabelle/HOL code generation facilities. + Simplicial Complexes and Boolean functions https://www.isa-afp.org/entries/Simplicial_complexes_and_boolean_functions.html https://www.isa-afp.org/entries/Simplicial_complexes_and_boolean_functions.html Jesús Aransay, Alejandro del Campo, Julius Michaelis 29 Nov 2021 00:00:00 +0000 In this work we formalise the isomorphism between simplicial complexes of dimension $n$ and monotone Boolean functions in $n$ variables, mainly following the definitions and results as introduced by N. A. Scoville. We also take advantage of the AFP representation of <a href="https://www.isa-afp.org/entries/ROBDD.html">ROBDD</a> (Reduced Ordered Binary Decision Diagrams) to compute the ROBDD representation of a given simplicial complex (by means of the isomorphism to Boolean functions). Some examples of simplicial complexes and associated Boolean functions are also presented. van Emde Boas Trees https://www.isa-afp.org/entries/Van_Emde_Boas_Trees.html https://www.isa-afp.org/entries/Van_Emde_Boas_Trees.html Thomas Ammer, Peter Lammich 23 Nov 2021 00:00:00 +0000 The van Emde Boas tree or van Emde Boas priority queue is a data structure supporting membership test, insertion, predecessor and successor search, minimum and maximum determination and deletion in O(log log U) time, where U = 0,...,2n-1 is the overall range to be considered. The presented formalization follows Chapter 20 of the popular Introduction to Algorithms (3rd ed.) by Cormen, Leiserson, Rivest and Stein (CLRS), extending the list of formally verified CLRS algorithms. Our current formalization is based on the first author's bachelor's thesis. First, we prove correct a functional implementation, w.r.t. an abstract data type for sets. Apart from functional correctness, we show a resource bound, and runtime bounds w.r.t. manually defined timing functions for the operations. Next, we refine the operations to Imperative HOL with time, and show correctness and complexity. This yields a practically more efficient implementation, and eliminates the manually defined timing functions from the trusted base of the proof. Foundation of geometry in planes, and some complements: Excluding the parallel axioms https://www.isa-afp.org/entries/Foundation_of_geometry.html https://www.isa-afp.org/entries/Foundation_of_geometry.html Fumiya Iwama 22 Nov 2021 00:00:00 +0000 "Foundations of Geometry" is a mathematical book written by Hilbert in 1899. This entry is a complete formalization of "Incidence" (excluding cubic axioms), "Order" and "Congruence" (excluding point sequences) of the axioms constructed in this book. In addition, the theorem of the problem about the part that is treated implicitly and is not clearly stated in it is being carried out in parallel. The Hahn and Jordan Decomposition Theorems https://www.isa-afp.org/entries/Hahn_Jordan_Decomposition.html https://www.isa-afp.org/entries/Hahn_Jordan_Decomposition.html Marie Cousin, Mnacho Echenim, Hervé Guiol 19 Nov 2021 00:00:00 +0000 In this work we formalize the Hahn decomposition theorem for signed measures, namely that any measure space for a signed measure can be decomposed into a positive and a negative set, where every measurable subset of the positive one has a positive measure, and every measurable subset of the negative one has a negative measure. We also formalize the Jordan decomposition theorem as a corollary, which states that the signed measure under consideration admits a unique decomposition into a difference of two positive measures, at least one of which is finite. Exploring Simplified Variants of Gödel’s Ontological Argument in Isabelle/HOL https://www.isa-afp.org/entries/SimplifiedOntologicalArgument.html https://www.isa-afp.org/entries/SimplifiedOntologicalArgument.html Christoph Benzmüller 08 Nov 2021 00:00:00 +0000 Simplified variants of Gödel's ontological argument are explored. Among those is a particularly interesting simplified argument which is (i) valid already in basic modal logics K or KT, (ii) which does not suffer from modal collapse, and (iii) which avoids the rather complex predicates of essence (Ess.) and necessary existence (NE) as used by Gödel. Whether the presented variants increase or decrease the attractiveness and persuasiveness of the ontological argument is a question I would like to pass on to philosophy and theology. Real Exponents as the Limits of Sequences of Rational Exponents https://www.isa-afp.org/entries/Real_Power.html https://www.isa-afp.org/entries/Real_Power.html Jacques D. Fleuriot 08 Nov 2021 00:00:00 +0000 In this formalisation, we construct real exponents as the limits of sequences of rational exponents. In particular, if $a \ge 1$ and $x \in \mathbb{R}$, we choose an increasing rational sequence $r_n$ such that $\lim_{n\to\infty} {r_n} = x$. Then the sequence $a^{r_n}$ is increasing and if $r$ is any rational number such that $r > x$, $a^{r_n}$ is bounded above by $a^r$. By the convergence criterion for monotone sequences, $a^{r_n}$ converges. We define $a^ x = \lim_{n\to\infty} a^{r_n}$ and show that it has the expected properties (for $a \ge 0$). This particular construction of real exponents is needed instead of the usual one using the natural logarithm and exponential functions (which already exists in Isabelle) to support our mechanical derivation of Euler's exponential series as an ``infinite polynomial". Aside from helping us avoid circular reasoning, this is, as far as we are aware, the first time real exponents are mechanised in this way within a proof assistant. Automating Public Announcement Logic and the Wise Men Puzzle in Isabelle/HOL https://www.isa-afp.org/entries/PAL.html https://www.isa-afp.org/entries/PAL.html Christoph Benzmüller, Sebastian Reiche 08 Nov 2021 00:00:00 +0000 We present a shallow embedding of public announcement logic (PAL) with relativized general knowledge in HOL. We then use PAL to obtain an elegant encoding of the wise men puzzle, which we solve automatically using sledgehammer. Factorization of Polynomials with Algebraic Coefficients https://www.isa-afp.org/entries/Factor_Algebraic_Polynomial.html https://www.isa-afp.org/entries/Factor_Algebraic_Polynomial.html Manuel Eberl, René Thiemann 08 Nov 2021 00:00:00 +0000 The AFP already contains a verified implementation of algebraic numbers. However, it is has a severe limitation in its factorization algorithm of real and complex polynomials: the factorization is only guaranteed to succeed if the coefficients of the polynomial are rational numbers. In this work, we verify an algorithm to factor all real and complex polynomials whose coefficients are algebraic. The existence of such an algorithm proves in a constructive way that the set of complex algebraic numbers is algebraically closed. Internally, the algorithm is based on resultants of multivariate polynomials and an approximation algorithm using interval arithmetic. Szemerédi's Regularity Lemma https://www.isa-afp.org/entries/Szemeredi_Regularity.html https://www.isa-afp.org/entries/Szemeredi_Regularity.html Chelsea Edmonds, Angeliki Koutsoukou-Argyraki, Lawrence C. Paulson 05 Nov 2021 00:00:00 +0000 <a href="https://en.wikipedia.org/wiki/Szemerédi_regularity_lemma">Szemerédi's regularity lemma</a> is a key result in the study of large -graphs. It asserts the existence an upper bound on the number of parts +graphs. It asserts the existence of an upper bound on the number of parts the vertices of a graph need to be partitioned into such that the edges between the parts are random in a certain sense. This bound depends only on the desired precision and not on the graph itself, in the spirit of Ramsey's theorem. The formalisation follows online course notes by <a href="https://www.dpmms.cam.ac.uk/~par31/notes/tic.pdf">Tim Gowers</a> and <a href="https://yufeizhao.com/gtac/gtac.pdf">Yufei Zhao</a>. Quantum and Classical Registers https://www.isa-afp.org/entries/Registers.html https://www.isa-afp.org/entries/Registers.html Dominique Unruh 28 Oct 2021 00:00:00 +0000 A formalization of the theory of quantum and classical registers as developed by (Unruh, Quantum and Classical Registers). In a nutshell, a register refers to a part of a larger memory or system that can be accessed independently. Registers can be constructed from other registers and several (compatible) registers can be composed. This formalization develops both the generic theory of registers as well as specific instantiations for classical and quantum registers. Belief Revision Theory https://www.isa-afp.org/entries/Belief_Revision.html https://www.isa-afp.org/entries/Belief_Revision.html Valentin Fouillard, Safouan Taha, Frédéric Boulanger, Nicolas Sabouret 19 Oct 2021 00:00:00 +0000 The 1985 paper by Carlos Alchourrón, Peter Gärdenfors, and David Makinson (AGM), “On the Logic of Theory Change: Partial Meet Contraction and Revision Functions” launches a large and rapidly growing literature that employs formal models and logics to handle changing beliefs of a rational agent and to take into account new piece of information observed by this agent. In 2011, a review book titled "AGM 25 Years: Twenty-Five Years of Research in Belief Change" was edited to summarize the first twenty five years of works based on AGM. This HOL-based AFP entry is a faithful formalization of the AGM operators (e.g. contraction, revision, remainder ...) axiomatized in the original paper. It also contains the proofs of all the theorems stated in the paper that show how these operators combine. Both proofs of Harper and Levi identities are established. X86 instruction semantics and basic block symbolic execution https://www.isa-afp.org/entries/X86_Semantics.html https://www.isa-afp.org/entries/X86_Semantics.html Freek Verbeek, Abhijith Bharadwaj, Joshua Bockenek, Ian Roessle, Timmy Weerwag, Binoy Ravindran 13 Oct 2021 00:00:00 +0000 This AFP entry provides semantics for roughly 120 different X86-64 assembly instructions. These instructions include various moves, arithmetic/logical operations, jumps, call/return, SIMD extensions and others. External functions are supported by allowing a user to provide custom semantics for these calls. Floating-point operations are mapped to uninterpreted functions. The model provides semantics for register aliasing and a byte-level little-endian memory model. The semantics are purposefully incomplete, but overapproximative. For example, the precise effect of flags may be undefined for certain instructions, or instructions may simply have no semantics at all. In those cases, the semantics are mapped to universally quantified uninterpreted terms from a locale. Second, this entry provides a method to symbolic execution of basic blocks. The method, called ''se_step'' (for: symbolic execution step) fetches an instruction and updates the current symbolic state while keeping track of assumptions made over the memory model. A key component is a set of theorems that prove how reads from memory resolve after writes have occurred. Thirdly, this entry provides a parser that allows the user to copy-paste the output of the standard disassembly tool objdump into Isabelle/HOL. A couple small and explanatory examples are included, including functions from the word count program. Several examples can be supplied upon request (they are not included due to the running time of verification): functions from the floating-point modulo function from FDLIBM, the GLIBC strlen function and the CoreUtils SHA256 implementation. Algebras for Iteration, Infinite Executions and Correctness of Sequential Computations https://www.isa-afp.org/entries/Correctness_Algebras.html https://www.isa-afp.org/entries/Correctness_Algebras.html Walter Guttmann 12 Oct 2021 00:00:00 +0000 We study models of state-based non-deterministic sequential computations and describe them using algebras. We propose algebras that describe iteration for strict and non-strict computations. They unify computation models which differ in the fixpoints used to represent iteration. We propose algebras that describe the infinite executions of a computation. They lead to a unified approximation order and results that connect fixpoints in the approximation and refinement orders. This unifies the semantics of recursion for a range of computation models. We propose algebras that describe preconditions and the effect of while-programs under postconditions. They unify correctness statements in two dimensions: one statement applies in various computation models to various correctness claims. Verified Quadratic Virtual Substitution for Real Arithmetic https://www.isa-afp.org/entries/Virtual_Substitution.html https://www.isa-afp.org/entries/Virtual_Substitution.html Matias Scharager, Katherine Cordwell, Stefan Mitsch, André Platzer 02 Oct 2021 00:00:00 +0000 This paper presents a formally verified quantifier elimination (QE) algorithm for first-order real arithmetic by linear and quadratic virtual substitution (VS) in Isabelle/HOL. The Tarski-Seidenberg theorem established that the first-order logic of real arithmetic is decidable by QE. However, in practice, QE algorithms are highly complicated and often combine multiple methods for performance. VS is a practically successful method for QE that targets formulas with low-degree polynomials. To our knowledge, this is the first work to formalize VS for quadratic real arithmetic including inequalities. The proofs necessitate various contributions to the existing multivariate polynomial libraries in Isabelle/HOL. Our framework is modularized and easily expandable (to facilitate integrating future optimizations), and could serve as a basis for developing practical general-purpose QE algorithms. Further, as our formalization is designed with practicality in mind, we export our development to SML and test the resulting code on 378 benchmarks from the literature, comparing to Redlog, Z3, Wolfram Engine, and SMT-RAT. This identified inconsistencies in some tools, underscoring the significance of a verified approach for the intricacies of real arithmetic. Soundness and Completeness of an Axiomatic System for First-Order Logic https://www.isa-afp.org/entries/FOL_Axiomatic.html https://www.isa-afp.org/entries/FOL_Axiomatic.html Asta Halkjær From 24 Sep 2021 00:00:00 +0000 This work is a formalization of the soundness and completeness of an axiomatic system for first-order logic. The proof system is based on System Q1 by Smullyan and the completeness proof follows his textbook "First-Order Logic" (Springer-Verlag 1968). The completeness proof is in the Henkin style where a consistent set is extended to a maximal consistent set using Lindenbaum's construction and Henkin witnesses are added during the construction to ensure saturation as well. The resulting set is a Hintikka set which, by the model existence theorem, is satisfiable in the Herbrand universe. Complex Bounded Operators https://www.isa-afp.org/entries/Complex_Bounded_Operators.html https://www.isa-afp.org/entries/Complex_Bounded_Operators.html Jose Manuel Rodriguez Caballero, Dominique Unruh 18 Sep 2021 00:00:00 +0000 We present a formalization of bounded operators on complex vector spaces. Our formalization contains material on complex vector spaces (normed spaces, Banach spaces, Hilbert spaces) that complements and goes beyond the developments of real vectors spaces in the Isabelle/HOL standard library. We define the type of bounded operators between complex vector spaces (cblinfun) and develop the theory of unitaries, projectors, extension of bounded linear functions (BLT theorem), adjoints, Loewner order, closed subspaces and more. For the finite-dimensional case, we provide code generation support by identifying finite-dimensional operators with matrices as formalized in the <a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a> AFP entry. A Formalization of Weighted Path Orders and Recursive Path Orders https://www.isa-afp.org/entries/Weighted_Path_Order.html https://www.isa-afp.org/entries/Weighted_Path_Order.html Christian Sternagel, René Thiemann, Akihisa Yamada 16 Sep 2021 00:00:00 +0000 We define the weighted path order (WPO) and formalize several properties such as strong normalization, the subterm property, and closure properties under substitutions and contexts. Our definition of WPO extends the original definition by also permitting multiset comparisons of arguments instead of just lexicographic extensions. Therefore, our WPO not only subsumes lexicographic path orders (LPO), but also recursive path orders (RPO). We formally prove these subsumptions and therefore all of the mentioned properties of WPO are automatically transferable to LPO and RPO as well. Such a transformation is not required for Knuth–Bendix orders (KBO), since they have already been formalized. Nevertheless, we still provide a proof that WPO subsumes KBO and thereby underline the generality of WPO. Extension of Types-To-Sets https://www.isa-afp.org/entries/Types_To_Sets_Extension.html https://www.isa-afp.org/entries/Types_To_Sets_Extension.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 In their article titled From Types to Sets by Local Type Definitions in Higher-Order Logic and published in the proceedings of the conference Interactive Theorem Proving in 2016, Ondřej Kunčar and Andrei Popescu propose an extension of the logic Isabelle/HOL and an associated algorithm for the relativization of the type-based theorems to more flexible set-based theorems, collectively referred to as Types-To-Sets. One of the aims of their work was to open an opportunity for the development of a software tool for applied relativization in the implementation of the logic Isabelle/HOL of the proof assistant Isabelle. In this article, we provide a prototype of a software framework for the interactive automated relativization of theorems in Isabelle/HOL, developed as an extension of the proof language Isabelle/Isar. The software framework incorporates the implementation of the proposed extension of the logic, and builds upon some of the ideas for further work expressed in the original article on Types-To-Sets by Ondřej Kunčar and Andrei Popescu and the subsequent article Smooth Manifolds and Types to Sets for Linear Algebra in Isabelle/HOL that was written by Fabian Immler and Bohua Zhan and published in the proceedings of the International Conference on Certified Programs and Proofs in 2019. IDE: Introduction, Destruction, Elimination https://www.isa-afp.org/entries/Intro_Dest_Elim.html https://www.isa-afp.org/entries/Intro_Dest_Elim.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 The article provides the command mk_ide for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The command mk_ide enables the automated synthesis of the introduction, destruction and elimination rules from arbitrary definitions of constant predicates stated in Isabelle/HOL. Conditional Transfer Rule https://www.isa-afp.org/entries/Conditional_Transfer_Rule.html https://www.isa-afp.org/entries/Conditional_Transfer_Rule.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 This article provides a collection of experimental utilities for unoverloading of definitions and synthesis of conditional transfer rules for the object logic Isabelle/HOL of the formal proof assistant Isabelle written in Isabelle/ML. Conditional Simplification https://www.isa-afp.org/entries/Conditional_Simplification.html https://www.isa-afp.org/entries/Conditional_Simplification.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 The article provides a collection of experimental general-purpose proof methods for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The methods in the collection offer functionality that is similar to certain aspects of the functionality provided by the standard proof methods of Isabelle that combine classical reasoning and rewriting, such as the method auto, but use a different approach for rewriting. More specifically, these methods allow for the side conditions of the rewrite rules to be solved via intro-resolution. Category Theory for ZFC in HOL III: Universal Constructions https://www.isa-afp.org/entries/CZH_Universal_Constructions.html https://www.isa-afp.org/entries/CZH_Universal_Constructions.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 The article provides a formalization of elements of the theory of universal constructions for 1-categories (such as limits, adjoints and Kan extensions) in the object logic ZFC in HOL of the formal proof assistant Isabelle. The article builds upon the foundations established in the AFP entry Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories. Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories https://www.isa-afp.org/entries/CZH_Foundations.html https://www.isa-afp.org/entries/CZH_Foundations.html Mihails Milehins 06 Sep 2021 00:00:00 +0000 This article provides a foundational framework for the formalization of category theory in the object logic ZFC in HOL of the formal proof assistant Isabelle. More specifically, this article provides a formalization of canonical set-theoretic constructions internalized in the type V associated with the ZFC in HOL, establishes a design pattern for the formalization of mathematical structures using sequences and locales, and showcases the developed infrastructure by providing formalizations of the elementary theories of digraphs and semicategories. The methodology chosen for the formalization of the theories of digraphs and semicategories (and categories in future articles) rests on the ideas that were originally expressed in the article Set-Theoretical Foundations of Category Theory written by Solomon Feferman and Georg Kreisel. Thus, in the context of this work, each of the aforementioned mathematical structures is represented as a term of the type V embedded into a stage of the von Neumann hierarchy. - - Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories - https://www.isa-afp.org/entries/CZH_Elementary_Categories.html - https://www.isa-afp.org/entries/CZH_Elementary_Categories.html - Mihails Milehins - 06 Sep 2021 00:00:00 +0000 - -This article provides a formalization of the foundations of the theory -of 1-categories in the object logic ZFC in HOL of the formal proof -assistant Isabelle. The article builds upon the foundations that were -established in the AFP entry Category Theory for ZFC in HOL -I: Foundations: Design Patterns, Set Theory, Digraphs, -Semicategories. - - - A data flow analysis algorithm for computing dominators - https://www.isa-afp.org/entries/Dominance_CHK.html - https://www.isa-afp.org/entries/Dominance_CHK.html - Nan Jiang - 05 Sep 2021 00:00:00 +0000 - -This entry formalises the fast iterative algorithm for computing dominators -due to Cooper, Harvey and Kennedy. It gives a specification of computing -dominators on a control -flow graph where each node refers to its reverse post order number. A -semilattice of reversed-ordered list which represents dominators is -built and a Kildall-style algorithm on the semilattice is defined for -computing dominators. Finally the soundness and completeness of the -algorithm are proved w.r.t. the specification. - - - Solving Cubic and Quartic Equations - https://www.isa-afp.org/entries/Cubic_Quartic_Equations.html - https://www.isa-afp.org/entries/Cubic_Quartic_Equations.html - René Thiemann - 03 Sep 2021 00:00:00 +0000 - -We formalize Cardano's formula to solve a cubic equation -$$ax^3 + bx^2 + cx + d = 0,$$ as well as Ferrari's formula to -solve a quartic equation. We further turn both formulas into -executable algorithms based on the algebraic number implementation in -the AFP. To this end we also slightly extended this library, namely by -making the minimal polynomial of an algebraic number executable, and -by defining and implementing $n$-th roots of complex -numbers. - - - Logging-independent Message Anonymity in the Relational Method - https://www.isa-afp.org/entries/Logging_Independent_Anonymity.html - https://www.isa-afp.org/entries/Logging_Independent_Anonymity.html - Pasquale Noce - 26 Aug 2021 00:00:00 +0000 - -In the context of formal cryptographic protocol verification, -logging-independent message anonymity is the property for a given -message to remain anonymous despite the attacker's capability of -mapping messages of that sort to agents based on some intrinsic -feature of such messages, rather than by logging the messages -exchanged by legitimate agents as with logging-dependent message -anonymity. -This paper illustrates how logging-independent message -anonymity can be formalized according to the relational method for -formal protocol verification by considering a real-world protocol, -namely the Restricted Identification one by the BSI. This sample model -is used to verify that the pseudonymous identifiers output by user -identification tokens remain anonymous under the expected conditions. - - - The Theorem of Three Circles - https://www.isa-afp.org/entries/Three_Circles.html - https://www.isa-afp.org/entries/Three_Circles.html - Fox Thomson, Wenda Li - 21 Aug 2021 00:00:00 +0000 - -The Descartes test based on Bernstein coefficients and Descartes’ rule -of signs effectively (over-)approximates the number of real roots of a -univariate polynomial over an interval. In this entry we formalise the -theorem of three circles, which gives sufficient conditions for when -the Descartes test returns 0 or 1. This is the first step for -efficient root isolation. - - - Fresh identifiers - https://www.isa-afp.org/entries/Fresh_Identifiers.html - https://www.isa-afp.org/entries/Fresh_Identifiers.html - Andrei Popescu, Thomas Bauereiss - 16 Aug 2021 00:00:00 +0000 - -This entry defines a type class with an operator returning a fresh -identifier, given a set of already used identifiers and a preferred -identifier. The entry provides a default instantiation for any -infinite type, as well as executable instantiations for natural -numbers and strings. - - - CoSMed: A confidentiality-verified social media platform - https://www.isa-afp.org/entries/CoSMed.html - https://www.isa-afp.org/entries/CoSMed.html - Thomas Bauereiss, Andrei Popescu - 16 Aug 2021 00:00:00 +0000 - -This entry contains the confidentiality verification of the -(functional kernel of) the CoSMed social media platform. The -confidentiality properties are formalized as instances of BD Security -[<a href="https://doi.org/10.4230/LIPIcs.ITP.2021.3">1</a>, -<a href="https://www.isa-afp.org/entries/Bounded_Deducibility_Security.html">2</a>]. -An innovation in the deployment of BD Security compared to previous -work is the use of dynamic declassification triggers, incorporated as -part of inductive bounds, for providing stronger guarantees that -account for the repeated opening and closing of access windows. To -further strengthen the confidentiality guarantees, we also prove -"traceback" properties about the accessibility decisions -affecting the information managed by the system. - diff --git a/web/statistics.html b/web/statistics.html --- a/web/statistics.html +++ b/web/statistics.html @@ -1,302 +1,303 @@ Archive of Formal Proofs

Statistics

- - - - + + + +

Number of Articles:	644
Number of Authors:	414
Number of lemmas:	~188,600
Lines of Code:	~3,272,400
Number of Articles:	651
Number of Authors:	419
Number of lemmas:	~191,700
Lines of Code:	~3,311,200

Most used AFP articles:

- + + + + + + - - - - - + - +

	Name	Used by ? articles
1.	List-Index	19	20
2.	Show	14
3.	Collections	13
4.	Coinductive	12
	Collections	12
	Jordan_Normal_Form	12
	Regular-Sets	12
4.
5.	Landau_Symbols	11
	Polynomial_Factorization	11
5.
6.	Abstract-Rewriting	10
	Automatic_Refinement	10
	Deriving	10

Growth in number of articles:

Growth in lines of code:

Growth in number of authors:

Size of articles:

\ No newline at end of file diff --git a/web/topics.html b/web/topics.html --- a/web/topics.html +++ b/web/topics.html @@ -1,1016 +1,1027 @@ Archive of Formal Proofs

Index by Topic

Computer science

Artificial intelligence

AI_Planning_Languages_Semantics Verified_SAT_Based_AI_Planning

Automata and formal languages

Partial_Order_Reduction C2KA_DistributedSystems Posix-Lexing LocalLexing KBPs Regular-Sets Regex_Equivalence MSO_Regex_Equivalence Formula_Derivatives Myhill-Nerode Universal_Turing_Machine CYK Presburger-Automata Functional-Automata Statecharts Stuttering_Equivalence Coinductive_Languages Tree-Automata Kleene_Algebra KAT_and_DRA KAD Regular_Algebras Markov_Models Probabilistic_System_Zoo CAVA_Automata LTL LTL_to_GBA CAVA_LTL_Modelchecker Probabilistic_Timed_Automata Finite_Automata_HF LTL_to_DRA Timed_Automata Stochastic_Matrices Buchi_Complementation Transition_Systems_and_Automata Factored_Transition_System_Bounding LTL_Master_Theorem MFOTL_Monitor Adaptive_State_Counting MFODL_Monitor_Optimized LTL_Normal_Form Extended_Finite_State_Machines Extended_Finite_State_Machine_Inference Combinatorics_Words Combinatorics_Words_Lyndon Combinatorics_Words_Graph_Lemma + Regular_Tree_Relations

Algorithms

Knuth_Morris_Pratt Probabilistic_While Comparison_Sort_Lower_Bound Quick_Sort_Cost TortoiseHare Selection_Heap_Sort VerifyThis2018 CYK Boolean_Expression_Checkers Efficient-Mergesort SATSolverVerification MuchAdoAboutTwo First_Order_Terms + MDP-Algorithms Monad_Memo_DP Hidden_Markov_Models Imperative_Insertion_Sort Formal_SSA ROBDD Median_Of_Medians_Selection Fisher_Yates Optimal_BST IMP2 Auto2_Imperative_HOL List_Inversions IMP2_Binary_Heap MFOTL_Monitor Adaptive_State_Counting Generic_Join VerifyThis2019 Generalized_Counting_Sort MFODL_Monitor_Optimized Sliding_Window_Algorithm PAC_Checker Regression_Test_Selection + Gale_Shapley Graph: DFS_Framework Prpu_Maxflow Floyd_Warshall Roy_Floyd_Warshall Dijkstra_Shortest_Path EdmondsKarp_Maxflow Depth-First-Search GraphMarkingIBP Transitive-Closure Transitive-Closure-II Gabow_SCC Kruskal Prim_Dijkstra_Simple Relational_Minimum_Spanning_Trees Distributed: DiskPaxos GenClock ClockSynchInst Heard_Of Consensus_Refined Abortable_Linearizable_Modules IMAP-CRDT CRDT Chandy_Lamport OpSets Stellar_Quorums WOOT_Strong_Eventual_Consistency Progress_Tracking Concurrent: ConcurrentGC Online: List_Update Geometry: Closest_Pair_Points Approximation: Approximation_Algorithms Mathematical: FFT Gauss-Jordan-Elim-Fun UpDown_Scheme Polynomials Gauss_Jordan Echelon_Form QR_Decomposition Hermite Groebner_Bases Diophantine_Eqns_Lin_Hom Taylor_Models LLL_Basis_Reduction Signature_Groebner BenOr_Kozen_Reif Smith_Normal_Form Safe_Distance Modular_arithmetic_LLL_and_HNF_algorithms Virtual_Substitution Optimization: Simplex Quantum computing: Isabelle_Marries_Dirac Projective_Measurements Registers

Concurrency

FLP Concurrent_Ref_Alg Concurrent_Revisions Store_Buffer_Reduction TESL_Language Process calculi: Noninterference_Generic_Unwinding AODV AWN CCS Pi_Calculus Psi_Calculi Encodability_Process_Calculi Circus Noninterference_Sequential_Composition Noninterference_Concurrent_Composition Modal_Logics_for_NTS HOL-CSP CSP_RefTK

Data structures

Generic_Deriving Random_BSTs Randomised_BSTs List_Interleaving Refine_Imperative_HOL Amortized_Complexity Dynamic_Tables AVL-Trees BDD BinarySearchTree Splay_Tree Root_Balanced_Tree Skew_Heap Pairing_Heap Priority_Queue_Braun Binomial-Queues Binomial-Heaps Finger-Trees Trie FinFun Collections Containers FileRefinement Datatype_Order_Generator Deriving List-Index List-Infinite Matrix Matrix_Tensor Huffman Lazy-Lists-II IEEE_Floating_Point Native_Word XML ROBDD IMAP-CRDT Word_Lib CRDT KD_Tree Taylor_Models Treaps Skip_Lists Weight_Balanced_Trees OpSets Optimal_BST Core_DOM Core_SC_DOM Shadow_SC_DOM SC_DOM_Components Auto2_Imperative_HOL IMP2_Binary_Heap Priority_Search_Trees Interval_Arithmetic_Word32 ADS_Functor Relational_Disjoint_Set_Forests Shadow_DOM DOM_Components Finite-Map-Extras Hood_Melville_Queue BTree Fresh_Identifiers Van_Emde_Boas_Trees

Functional programming

Hardware

SPARCv8 X86_Semantics

Machine learning

Deep_Learning Inductive_Inference

Networks

UPF_Firewall IP_Addresses Simple_Firewall Iptables_Semantics Routing LOFT

Programming languages

Clean Decl_Sem_Fun_PL Language definitions: CakeML WebAssembly pGCL GPU_Kernel_PL LightweightJava CoreC++ FeatherweightJava Jinja JinjaThreads Locally-Nameless-Sigma AutoFocus-Stream FocusStreamsCaseStudies Isabelle_Meta_Model Simpl Complx Safe_OCL Isabelle_C JinjaDCI Lambda calculi: Higher_Order_Terms Launchbury PCF POPLmark-deBruijn Lam-ml-Normalization LambdaMu Binding_Syntax_Theory LambdaAuth Type systems: Name_Carrying_Type_Inference MiniML Possibilistic_Noninterference SIFUM_Type_Systems Dependent_SIFUM_Type_Systems Strong_Security WHATandWHERE_Security VolpanoSmith Physical_Quantities MiniSail Logics: ConcurrentIMP Refine_Monadic Automatic_Refinement MonoBoolTranAlgebra Simpl Separation_Algebra Separation_Logic_Imperative_HOL Relational-Incorrectness-Logic Abstract-Hoare-Logics Kleene_Algebra KAT_and_DRA KAD BytecodeLogicJmlTypes DataRefinementIBP RefinementReactive SIFPL TLA Ribbon_Proofs Separata Complx Differential_Dynamic_Logic Hoare_Time IMP2 UTP QHLProver Differential_Game_Logic Correctness_Algebras Registers Compiling: CakeML_Codegen Compiling-Exceptions-Correctly NormByEval Density_Compiler VeriComp IMP_Compiler Static analysis: RIPEMD-160-SPARK Program-Conflict-Analysis Shivers-CFA Slicing HRB-Slicing InfPathElimination Abs_Int_ITP2012 Dominance_CHK Transformations: Call_Arity Refine_Imperative_HOL WorkerWrapper Monad_Memo_DP Formal_SSA Minimal_SSA Misc: JiveDataStoreModel Pop_Refinement Case_Labeling Interpreter_Optimizations

Security

Multi_Party_Computation Noninterference_Generic_Unwinding Noninterference_Ipurge_Unwinding Relational_Method UPF UPF_Firewall CISC-Kernel Noninterference_CSP Key_Agreement_Strong_Adversaries Security_Protocol_Refinement Attack_Trees Inductive_Confidentiality Possibilistic_Noninterference SIFUM_Type_Systems Dependent_SIFUM_Type_Systems Dependent_SIFUM_Refinement Relational-Incorrectness-Logic Strong_Security WHATandWHERE_Security VolpanoSmith SIFPL HotelKeyCards InformationFlowSlicing InformationFlowSlicing_Inter CryptoBasedCompositionalProperties Probabilistic_Noninterference HyperCTL Bounded_Deducibility_Security Network_Security_Policy_Verification Noninterference_Inductive_Unwinding Password_Authentication_Protocol Noninterference_Sequential_Composition Noninterference_Concurrent_Composition SPARCv8 Modular_Assembly_Kit_Security LambdaAuth Stateful_Protocol_Composition_and_Typing Automated_Stateful_Protocol_Verification IFC_Tracking CoCon BD_Security_Compositional CoSMed CoSMeDis Logging_Independent_Anonymity Cryptography: Game_Based_Crypto Sigma_Commit_Crypto CryptHOL Constructive_Cryptography RSAPSS Elliptic_Curves_Group_Law Constructive_Cryptography_CM

Semantics

Launchbury Clean Transformer_Semantics HOL-CSP QHLProver TESL_Language Isabelle_C CSP_RefTK X86_Semantics Registers

System description languages

Circus ComponentDependencies Promela Featherweight_OCL DynamicArchitectures Architectural_Design_Patterns TESL_Language

Logic

Philosophical aspects

GoedelGod Types_Tableaus_and_Goedels_God GewirthPGCProof Lowe_Ontological_Argument AnselmGod PLM Aristotles_Assertoric_Syllogistic Mereology SimplifiedOntologicalArgument

General logic

Topological_Semantics Metalogic_ProofChecker Classical propositional logic: Free-Boolean-Algebra Classical first-order logic: FOL-Fitting FOL_Axiomatic Decidability of theories: MSO_Regex_Equivalence Formula_Derivatives Presburger-Automata LinearQuantifierElim Mechanization of proofs: Boolean_Expression_Checkers Verified-Prover Sort_Encodings PropResPI Resolution_FOL FOL_Harrison Ordered_Resolution_Prover Functional_Ordered_Resolution_Prover Binding_Syntax_Theory Saturation_Framework Saturation_Framework_Extensions Lambda calculus: LambdaMu Logics of knowledge and belief: Epistemic_Logic Blue_Eyes Public_Announcement_Logic Belief_Revision PAL Temporal logic: Nat-Interval-Logic LTL HyperCTL Allen_Calculus MFOTL_Monitor LTL_Normal_Form Modal logic: Modal_Logics_for_NTS Differential_Dynamic_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Logic MFODL_Monitor_Optimized SimplifiedOntologicalArgument Paraconsistent logics: Paraconsistency

Computability

Universal_Turing_Machine Recursion-Theory-I Inductive_Inference Minsky_Machines

Set theory

Ordinal Ordinals_and_Cardinals HereditarilyFinite ZFC_in_HOL Forcing Delta_System_Lemma Recursion-Addition Ordinal_Partitions CZH_Foundations

Proof theory

Propositional_Proof_Systems Completeness SequentInvertibility Incompleteness Abstract_Completeness SuperCalc Incredible_Proof_Machine Surprise_Paradox Abstract_Soundness Syntax_Independent_Logic Goedel_Incompleteness Goedel_HFSet_Semantic Goedel_HFSet_Semanticless Robinson_Arithmetic FOL_Seq_Calc1 FOL_Axiomatic

Rewriting

CakeML_Codegen Monad_Normalisation Lambda_Free_RPOs Lambda_Free_KBOs Lambda_Free_EPO Nested_Multisets_Ordinals Abstract-Rewriting First_Order_Terms Decreasing-Diagrams Decreasing-Diagrams-II Rewriting_Z Graph_Saturation Goodstein_Lambda Knuth_Bendix_Order Weighted_Path_Order

Mathematics

Order

LatticeProperties Stone_Algebras Allen_Calculus Order_Lattice_Props Complete_Non_Orders Szpilrajn

Algebra

Optics Subresultants Buildings Algebraic_VCs C2KA_DistributedSystems Multirelations Residuated_Lattices PseudoHoops Impossible_Geometry Gauss-Jordan-Elim-Fun Matrix_Tensor Kleene_Algebra KAT_and_DRA KAD Regular_Algebras Free-Groups CofGroups Finitely_Generated_Abelian_Groups Group-Ring-Module Robbins-Conjecture Valuation Rank_Nullity_Theorem Polynomials Relation_Algebra PSemigroupsConvolution Secondary_Sylow Jordan_Hoelder Cayley_Hamilton VectorSpace Echelon_Form QR_Decomposition Hermite Rep_Fin_Groups Jordan_Normal_Form Algebraic_Numbers Polynomial_Interpolation Polynomial_Factorization Perron_Frobenius Stochastic_Matrices Groebner_Bases Nullstellensatz Mason_Stothers Berlekamp_Zassenhaus Stone_Relation_Algebras Stone_Kleene_Relation_Algebras Orbit_Stabiliser Dirichlet_L Symmetric_Polynomials Taylor_Models LLL_Basis_Reduction LLL_Factorization Localization_Ring Quaternions Octonions Aggregation_Algebras Signature_Groebner Quantales Transformer_Semantics Farkas Groebner_Macaulay Linear_Inequalities Linear_Programming Jacobson_Basic_Algebra Hybrid_Systems_VCs Subset_Boolean_Algebras Power_Sum_Polynomials Formal_Puiseux_Series Matrices_for_ODEs Smith_Normal_Form Grothendieck_Schemes Factor_Algebraic_Polynomial + Hyperdual

Analysis

Banach_Steinhaus Fourier E_Transcendental Liouville_Numbers Descartes_Sign_Rule Euler_MacLaurin Real_Impl Lower_Semicontinuous Affine_Arithmetic Laplace_Transform Cauchy Integration Ordinary_Differential_Equations Polynomials Sqrt_Babylonian Sturm_Sequences Sturm_Tarski Special_Function_Bounds Landau_Symbols Error_Function Akra_Bazzi Zeta_Function Linear_Recurrences Lambert_W Cartan_FP Deep_Learning Cubic_Quartic_Equations Real_Power Stirling_Formula Lp Bernoulli Winding_Number_Eval Count_Complex_Roots Taylor_Models Green Irrationality_J_Hancl Budan_Fourier Smooth_Manifolds Transcendence_Series_Hancl_Rucki Hybrid_Systems_VCs Poincare_Bendixson Matrices_for_ODEs Irrational_Series_Erdos_Straus Three_Circles Complex_Bounded_Operators + Hyperdual

Measure theory

Hahn_Jordan_Decomposition

Geometry

Topology

Topology Knot_Theory Kuratowski_Closure_Complement Smooth_Manifolds Simplicial_complexes_and_boolean_functions

Graph theory

Combinatorics

Category theory

Category3 MonoidalCategory Category Category2 AxiomaticCategoryTheory Bicategory CZH_Foundations CZH_Elementary_Categories CZH_Universal_Constructions

Physics

No_FTL_observers Schutz_Spacetime Safe_Distance Physical_Quantities Quantum information: Isabelle_Marries_Dirac Projective_Measurements

Misc

FunWithFunctions FunWithTilings IMO2019

Tools

\ No newline at end of file

Abstract Rewriting

Algebraic Numbers in Isabelle/HOL

Amicable Numbers

Aristotle's Assertoric Syllogistic

The Factorization Algorithm of Berlekamp and Zassenhaus

Certification Monads

Collections Framework

Solving Cubic and Quartic Equations

Generating linear orders for datatypes

Decreasing Diagrams II

Deriving class instances for datatypes

Homogeneous Linear Diophantine Equations

Efficient Mergesort

Ergodic Theory

Inference of Extended Finite State Machines

A Formal Model of Extended Finite State Machines

Factorization of Polynomials with Algebraic Coefficients

Farkas' Lemma and Motzkin's Transposition Theorem

First-Order Terms

Gale-Shapley + + Algorithm + +

Gauss-Jordan Algorithm and Its Applications

A Probabilistic Proof of the Girth-Chromatic Number Theorem

Implementing the Goodstein Function in &lambda;-Calculus

HOLCF-Prelude

Hyperdual + + Numbers + + and + + Forward + + Differentiation + +

Imperative Insertion Sort

Irrationality Criteria for Series by Erdős and Straus

Irrational Rapidly Convergent Series

Matrices, Jordan Normal Forms, and Spectral Radius Theory

Knight's + + Tour + + Revisited + + Revisited + +

A Formalization of Knuth–Bendix Orders

A verified LLL algorithm

A verified factorization algorithm for integer polynomials with polynomial complexity

Lifting Definition Option

Linear Inequalities

List Index

Verified + + Algorithms + + for + + Solving + + Markov + + Decision + + Processes + +

Markov + + Decision + + Processes + + with + + Rewards + +

Executable Matrix Operations on Matrices of Arbitrary Dimensions

Minsky Machines

Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation

Octonions

Open Induction

Mutually Recursive Partial Functions

Perron-Frobenius Theorem for Spectral Radius Analysis

Polynomial Factorization

Polynomial Interpolation

Executable Multivariate Polynomials

Properties of Random Graphs -- Subgraph Containment

Implementing field extensions of the form Q[sqrt(b)]

Regular + + Tree + + Relations + +

The Z Property

Roth's + + Theorem + + on + + Arithmetic + + Progressions + +

Haskell's Show Class in Isabelle/HOL

An Incremental Simplex Algorithm with Unsatisfiable Core Generation

Computing N-th Roots using the Babylonian Method

Stochastic Matrices and the Perron-Frobenius Theorem

Subresultants

The Sunflower Lemma of Erdős and Rado

Szemerédi's Regularity Lemma

The Transcendence of Certain Infinite Series

Executable Transitive Closures

Executable Transitive Closures of Finite Relations

A Formalization of Weighted Path Orders and Recursive Path Orders

Well-Quasi-Orders

XML

Archive of Formal Proofs

Statistics

Statistics

Most used AFP articles:

Growth in number of articles:

Growth in lines of code:

Growth in number of authors:

Size of articles:

Index by Topic

Computer science

Artificial intelligence

Automata and formal languages

Algorithms

Concurrency

Implementing the Goodstein Function in λ-Calculus