diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,9581 +1,9655 @@ [Arith_Prog_Rel_Primes] title = Arithmetic progressions and relative primes author = José Manuel Rodríguez Caballero 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 Putnam exam problems of 2002. 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 , Jose Manuel Rodriguez Caballero 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ć , Danijela Simić 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ć , Filip Marić , Pierre Boutry 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 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 , Lars 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, Deriving allows the automatic instantiation of comparators, linear orders, equality, and hashing. Show 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 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 , 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 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 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 paper. 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 topic = Mathematics/Number theory date = 2018-06-23 notify = eberlm@in.tum.de 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 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 , Peter 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 topic = Mathematics/Geometry, Mathematics/Number theory date = 2017-07-13 notify = eberlm@in.tum.de 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 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 undergraduate dissertation. [Propositional_Proof_Systems] title = Propositional Proof Systems author = Julius Michaelis , Tobias 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 , Frank Zeyda 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) [Game_Based_Crypto] title = Game-based cryptography in HOL author = Andreas Lochbihler , S. Reza Sefidgar <>, Bhargav Bhatt 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 , David Butler 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 , Andreas Lochbihler 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 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 , 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 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 , Andreas Lochbihler 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 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 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 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, if-then-else 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 if-then-else as functions. [Dict_Construction] title = Dictionary Construction author = Lars 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 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 verified compiler from Isabelle to CakeML. 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 Blanchette’s λ-free higher-order terms. Furthermore, I implement translation functions between de-Bruijn terms and named terms and prove their correctness. [Subresultants] title = Subresultants author = Sebastiaan Joosten , René Thiemann , Akihisa Yamada 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 topic = Computer science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de 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 topic = Computer science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de 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 topic = Computer science/Data structures date = 2017-04-04 notify = eberlm@in.tum.de 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 topic = Computer science/Data structures date = 2018-10-19 notify = eberlm@in.tum.de 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 topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-12 notify = eberlm@in.tum.de 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 PlanetMath article by Roger Lipsett.

[Pi_Transcendental] title = The Transcendence of π author = Manuel Eberl topic = Mathematics/Number theory date = 2018-09-28 notify = eberlm@in.tum.de 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.

[DFS_Framework] title = A Framework for Verifying Depth-First Search Algorithms author = Peter Lammich , René Neumann 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 , 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 , 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 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 , Georg Struth 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 , Jason 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 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 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 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 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. 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)
[MonoidalCategory] title = Monoidal Categories author = Eugene W. Stark 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. 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)
[Card_Multisets] title = Cardinality of Multisets author = Lukas Bulwahn 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 , Roy Dyckhoff , Christian Urban 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 topic = Computer science/Automata and formal languages date = 2017-04-28 notify = steven@recursivemind.com abstract = This formalisation accompanies the paper Local Lexing 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 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 The Max-Flow Min-Cut theorem for countable networks 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 operations on discrete distributions from finite version of the max-flow min-cut theorem (revision a7a198f5bab0)
[Liouville_Numbers] title = Liouville numbers author = Manuel Eberl 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 = eberlm@in.tum.de [Triangle] title = Basic Geometric Properties of Triangles author = Manuel Eberl 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 = eberlm@in.tum.de [Prime_Harmonic_Series] title = The Divergence of the Prime Harmonic Series author = Manuel Eberl 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 = eberlm@in.tum.de [Descartes_Sign_Rule] title = Descartes' Rule of Signs author = Manuel Eberl 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 = eberlm@in.tum.de [Euler_MacLaurin] title = The Euler–MacLaurin Formula author = Manuel Eberl topic = Mathematics/Analysis date = 2017-03-10 notify = eberlm@in.tum.de 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 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 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 , Georg Struth 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 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 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 = [List_Interleaving] title = Reasoning about Lists via List Interleaving author = Pasquale Noce 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 , Georg Struth 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 , Tony 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 , Tobias 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 Verified Analysis of List Update Algorithms by Haslbeck and Nipkow.

notify = nipkow@in.tum.de [ConcurrentIMP] title = Concurrent IMP author = Peter Gammie 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 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 , Lukas Brügger , Burkhart Wolff 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 , Lukas Brügger<>, Burkhart 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 , Peter Höfner 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 , René Thiemann 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 , René Thiemann 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 , Sergey Tverdyshev , Oto Havle , Holger Blasum , Bruno Langenstein , Werner Stephan , Yakoub Nemouchi , Abderrahmane Feliachi , Burkhart Wolff , Julien Schmaltz 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 http://www.euromils.eu.

notify = [pGCL] title = pGCL for Isabelle author = David Cock 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 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 , Peter 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 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 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 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 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 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 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 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 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 Bengtson's thesis. notify = [Pi_Calculus] title = The pi-calculus in nominal logic author = Jesper Bengtson 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 Bengtson's thesis. notify = [Psi_Calculi] title = Psi-calculi in Isabelle author = Jesper Bengtson 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 Bengtson's thesis. notify = [Encodability_Process_Calculi] title = Analysing and Comparing Encodability Criteria for Process Calculi author = Kirstin Peters , Rob van Glabbeek 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 , Burkhart Wolff , Marie-Claude Gaudel contributors = Makarius Wenzel 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 , Peter 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 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 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 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 , 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 , Simon Wimmer topic = Computer science/Algorithms date = 2018-04-27 notify = lammich@in.tum.de abstract = VerifyThis 2018 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 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 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 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 , Lawrence C. Paulson 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 , Julius Michaelis , Lars 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 , Julius Michaelis , Maximilian Haslbeck 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 Verified iptables Firewall Analysis, IFIP Networking 2016. [Iptables_Semantics] title = Iptables Semantics author = Cornelius Diekmann , Lars 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 Simple_Firewall) 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 fffuu. The tool does not require any input —except for the iptables-save 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 , Cornelius 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 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 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 MSc thesis, which contains natural-language explanations of some of the more interesting proofs. notify = tjm1983@gmail.com [General-Triangle] title = The General Triangle Is Unique author = Joachim Breitner 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 , Matthew Parkinson 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 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 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 , Tobias Nipkow contributors = Manuel Eberl 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 , Dmitriy Traytel 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. The formalization is described in a paper of the same name presented at Interactive Theorem Proving 2014. 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 , Tobias 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 ICFP 2013 functional pearl. notify = traytel@in.tum.de, nipkow@in.tum.de [Formula_Derivatives] title = Derivatives of Logical Formulas author = Dmitriy Traytel 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 Coalgebraic Decision Procedure for WS1S 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 contributors = Manuel Eberl 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 , Sebastiaan J. C. Joosten 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 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 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 , 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 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 , Florian Kammüller 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 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 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 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 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 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 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 , 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 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. notify = c.sternagel@gmail.com [SATSolverVerification] title = Formal Verification of Modern SAT Solvers author = Filip Marić 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:

  • a solver based on classical DPLL procedure (using only a backtrack-search with unit propagation),
  • a very general solver with backjumping and learning (similar to the description given in (Nieuwenhuis et al., 2006)), and
  • a solver with a specific conflict analysis algorithm (similar to the description given in (Krstic et al., 2007)).
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 , René Thiemann 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 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 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 , Stephan 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 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 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 "Verification of Clock Synchronization Algorithms: Experiments on a combination of deductive tools" in proceedings of AVOCS 2005. In this work the correctness of Schneider schema was also verified using Isabelle (entry GenClock 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 , Stephan 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 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 , Christoph Sprenger 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 , 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 , Viktor Kuncak , Giuliano Losa 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 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 paper published in the proceedings of the conference on Interactive Theorem Proving ITP 2015. An extended version of this publication is available here. 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 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 companion paper. notify = nipkow@in.tum.de [AVL-Trees] title = AVL Trees author = Tobias 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 gerwin.klein@nicta.com.au. 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 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 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 Amortized Complexity. extra-history = Change history: [2016-07-12]: Moved splay heaps here from Amortized_Complexity [Root_Balanced_Tree] title = Root-Balanced Tree author = Tobias 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 Verified Root-Balanced Trees 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 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 Amortized Complexity. notify = nipkow@in.tum.de [Pairing_Heap] title = Pairing Heap author = Hauke Brinkop , Tobias 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 Amortized Complexity. 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 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 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 , Finn Nielsen , Peter 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 , Stefan Körner , Peter 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 , Tobias 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 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 contributors = Andreas Lochbihler , 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 contributors = René Thiemann 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 , Viktor 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 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 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. notify = rene.thiemann@uibk.ac.at [Deriving] title = Deriving class instances for datatypes author = Christian Sternagel , René Thiemann 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 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.

notify = rene.thiemann@uibk.ac.at [List-Index] title = List Index date = 2010-02-20 author = Tobias 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 , René 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 CeTA 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 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 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 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 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 {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. notify = rene.thiemann@uibk.ac.at [Coinductive] title = Coinductive topic = Computer science/Functional programming author = Andreas Lochbihler contributors = Johannes Hölzl 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 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 online.)

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 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 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 , Dimitrios Vytiniotis 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 , Tobias 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 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 , Florian Kammüller , Bianca Lutz , Henry Sudhof 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 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 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 , Burkhart 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 Featherweight OCL 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 , Burkhart 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 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 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 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 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 let) 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 , Rafal Kolanski , Andrew Boyton 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 , Rene Meis 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 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 , Johannes Hölzl 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 article 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 , Heiko Mantel , Daniel Schoepe 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 = grewe@cs.tu-darmstadt.de [Dependent_SIFUM_Type_Systems] title = A Dependent Security Type System for Concurrent Imperative Programs author = Toby Murray , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah 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 , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah 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 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 , Alexander Lux , Heiko Mantel , Jens Sauer 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 = grewe@cs.tu-darmstadt.de [WHATandWHERE_Security] title = A Formalization of Declassification with WHAT-and-WHERE-Security author = Sylvia Grewe , Alexander Lux , Heiko Mantel , Jens Sauer 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 = grewe@cs.tu-darmstadt.de [VolpanoSmith] title = A Correctness Proof for the Volpano/Smith Security Typing System author = Gregor Snelting , Daniel Wasserrab 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 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 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 , Tjark Weber 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 , Georg Struth 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 , Walter Guttmann , Peter Höfner , Georg Struth , Tjark Weber 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 , Georg Struth 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 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 , 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 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 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 , Stephan Merz date = 2011-11-19 topic = Computer science/Programming languages/Logics abstract = We mechanise the logic TLA* [Merz 1999], an extension of Lamport's Temporal Logic of Actions (TLA) [Lamport 1994] 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:

  • a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*;
  • a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas;
  • a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification;
  • a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems.
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 [Chaudhuri et al 2010]. notify = ggrov@inf.ed.ac.uk [Compiling-Exceptions-Correctly] title = Compiling Exceptions Correctly author = Tobias 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 Hutton and Wright. notify = nipkow@in.tum.de [NormByEval] title = Normalization by Evaluation author = Klaus Aehlig , Tobias 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 , Markus Müller-Olm 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 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 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 date = 2009-11-13 topic = Computer science/Programming languages/Static analysis abstract = After verifying dynamic and static interprocedural slicing, 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 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 , 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 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 date = 2010-03-23 topic = Computer science/Security abstract =

In this contribution, we show how correctness proofs for intra- and interprocedural slicing 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 InformationFlowSlicing_Inter for the inter-procedural part.

extra-history = Change history: [2016-06-10]: The original entry InformationFlowSlicing contained both the inter- and intra-procedural case was split into two for easier maintenance. notify = [InformationFlowSlicing_Inter] title = Inter-Procedural Information Flow Noninterference via Slicing author = Daniel Wasserrab date = 2010-03-23 topic = Computer science/Security abstract =

In this contribution, we show how correctness proofs for intra- and interprocedural slicing 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 InformationFlowSlicing for the intra-procedural part.

extra-history = Change history: [2016-06-10]: The original entry InformationFlowSlicing contained both the inter- and intra-procedural case was split into two for easier maintenance. notify = [ComponentDependencies] title = Formalisation and Analysis of Component Dependencies author = Maria Spichkova 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 [pdf]. notify = lp15@cam.ac.uk [Ordinal] title = Countable Ordinals author = Brian Huffman 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 <> 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 contributors = Asta Halkjær From 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 author = Asta Halkjær From 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). [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 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 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 , Andrei Popescu 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 , Uwe Waldmann , Daniel Wand 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 , Jasmin Christian Blanchette , Uwe Waldmann , Daniel Wand 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 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 , Mathias Fleury , Dmitriy Traytel 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 , René 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 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. 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 , René 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 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. [Free-Groups] title = Free Groups author = Joachim Breitner 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 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 [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 , Jesús Aransay 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 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 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 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 , Johannes Hölzl 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:

  • 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.
  • HOL-ODE-Examples: Applications of the numerical algorithms to concrete systems of ODEs.
  • Lorenz_C0, Lorenz_C1: Verified algorithms for checking C1-information according to Tucker's proof, computation of C0-information.

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 , René Thiemann , Alexander Maletzky , Fabian Immler , Florian Haftmann , Andreas Lochbihler , Alexander Bentkamp 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 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]. 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 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 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 = eberlm@in.tum.de [Sturm_Tarski] title = The Sturm-Tarski Theorem author = Wenda Li 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 , Tobias 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. See here for the corresponding paper. notify = hoelzl@in.tum.de [Probabilistic_System_Zoo] title = A Zoo of Probabilistic Systems author = Johannes Hölzl , Andreas Lochbihler , Dmitriy Traytel 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 , Johannes Hölzl , Tobias Nipkow date = 2014-10-09 topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling abstract = Bhat et al. [TACAS 2013] 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 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 contributors = Benedikt Seidl 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 , Peter 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 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 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 , Peter Lammich , René Neumann , Tobias Nipkow , Alexander Schimpf , 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 CAV 2013 paper 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

  • Fermat's Last Theorem for exponents 3 and 4 and
  • the parametrisation of Pythagorean Triples.
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Perfect-Number-Thm] title = Perfect Number Theorem author = Mark Ijbema 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:
  • any prime number of the form 4m+1 can be written as the sum of two squares;
  • any natural number can be written as the sum of four squares
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Lehmer] title = Lehmer's Theorem author = Simon Wimmer , Lars Noschinski 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 , Lars Noschinski 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 , Shuwei Hu , Tobias 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 , Johannes Hölzl 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 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 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 here. notify = nipkow@in.tum.de [SenSocialChoice] title = Some classical results in Social Choice Theory author = Peter Gammie 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 , Christoph Lange, Colin Rowat 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, Topology, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called LList_Topology. It develops the topology of lazy lists. notify = lcp@cl.cam.ac.uk [Knot_Theory] title = Knot Theory author = T.V.H. Prathamesh 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 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 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 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 n(i) 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 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 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 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 Flyspeck project. The IJCAR 2006 paper by Nipkow, Bauer and Schultz refers to the original version of Hales' proof, the ITP 2011 paper by Nipkow 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 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:
  • 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. 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 , Tobias 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 , Stefan 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 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 ``Top 100 Mathematical Theorems''. notify = lukas.bulwahn@gmail.com [Euler_Partition] title = Euler's Partition Theorem author = Lukas Bulwahn 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 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 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 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 equinumerous was slightly too weak in the original submission and has been fixed in revision 8c2b5b3c995f. notify = lcp@cl.cam.ac.uk [Category2] title = Category Theory author = Alexander Katovsky 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 here [pdf]. notify = alexander.katovsky@cantab.net [FunWithFunctions] title = Fun With Functions author = Tobias 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 , Lawrence C. Paulson 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 Larry Paulson, 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 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 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 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 contributors = Fabian Hellauer , Fabian 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 contributors = Peter 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 , René Thiemann 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 date = 2013-11-17 topic = Logic/Set theory abstract = The theory of hereditarily finite sets is formalised, following the development 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 formalised separately. 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 date = 2013-11-17 topic = Logic/Proof theory abstract = Gödel's two incompleteness theorems are formalised, following a careful presentation by Swierczkowski, in the theory of hereditarily finite sets. 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 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 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 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 , Bruno Woltzenlogel Paleo 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 , Christoph Benzmüller 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 , Christoph Benzmüller 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 , Christoph Benzmüller 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 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 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 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 , Frédéric Tuong , Burkhart Wolff 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]: afp-devel@ea3b38fc54d6 and hol-testgen@12148
   Update of Featherweight OCL including a change in the abstract.
[2014-01-16]: afp-devel@9091ce05cb20 and hol-testgen@10241
   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 , Georg Struth , Tjark Weber 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 , Victor B. F. Gomes , Ian J. Hayes , Georg Struth 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 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 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 , Stefan Hetzl , Florian Pollak 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 , Johannes Hölzl 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 , Peter Lammich , Andrei Popescu 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 , Peter Lammich 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 input-output automata. 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 [Network_Security_Policy_Verification] title = Network Security Policy Verification author = Cornelius 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.
  • Secure auto-completion of scenario-specific knowledge, which eases usability.
  • Security violations can be repaired by tightening the policy iff the security invariants hold for the deny-all policy.
  • An algorithm to compute a security policy.
  • A formalization of stateful connection semantics in network security mechanisms.
  • An algorithm to compute a secure stateful implementation of a policy.
  • An executable implementation of all the theory.
  • Examples, ranging from an aircraft cabin data network to the analysis of a large real-world firewall.
  • More examples: A fully automated translation of high-level security goals to both firewall and SDN configurations (see Examples/Distributed_WebApp.thy).
For a detailed description, see 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 , Andrei Popescu , Dmitriy Traytel 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 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 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 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 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 = eberlm@in.tum.de [Error_Function] title = The Error Function author = Manuel Eberl topic = Mathematics/Analysis date = 2018-02-06 notify = eberlm@in.tum.de 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 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 = eberlm@in.tum.de [Dirichlet_Series] title = Dirichlet Series author = Manuel Eberl topic = Mathematics/Number theory date = 2017-10-12 notify = eberlm@in.tum.de abstract = This entry is a formalisation of much of Chapters 2, 3, and 11 of Apostol's “Introduction to Analytic Number Theory”. This includes:

  • Definitions and basic properties for several number-theoretic functions (Euler's φ, Möbius μ, Liouville's λ, the divisor function σ, von Mangoldt's Λ)
  • Executable code for most of these functions, the most efficient implementations using the factoring algorithm by Thiemann et al.
  • Dirichlet products and formal Dirichlet series
  • Analytic results connecting convergent formal Dirichlet series to complex functions
  • Euler product expansions
  • Asymptotic estimates of number-theoretic functions including the density of squarefree integers and the average number of divisors of a natural number
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 , Manuel Eberl 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 Introduction to Analytic Number Theory. Subjects that are covered are:

  • periodic arithmetic functions and their finite Fourier series
  • (generalised) Ramanujan sums
  • Gauss sums and separable characters
  • induced moduli and primitive characters
  • the Pólya—Vinogradov inequality
[Zeta_Function] title = The Hurwitz and Riemann ζ Functions author = Manuel Eberl topic = Mathematics/Number theory, Mathematics/Analysis date = 2017-10-12 notify = eberlm@in.tum.de 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:

  • the Stieltjes constants and the Laurent expansion of ζ(s) at s = 1
  • the non-vanishing of ζ(s) for ℜ(z) ≥ 1
  • the relationship between ζ(a,s) and Γ
  • the special values at negative integers and positive even integers
  • Hurwitz's formula and the reflection formula for ζ(s)
  • the Hadjicostas–Chapman formula

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 topic = Mathematics/Analysis date = 2017-10-12 notify = eberlm@in.tum.de 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.

[Lambert_W] title = The Lambert W Function on the Reals author = Manuel Eberl topic = Mathematics/Analysis date = 2020-04-24 notify = eberlm@in.tum.de 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 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 , Jesús Aransay 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 , Jesús Aransay 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 , Jesús Aransay 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 , Jesús Aransay 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 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 , Alexandra Maximova 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 AFP entry 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 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 casify, 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 casify.

As examples, this work contains verification condition generators producing named cases for three languages: The Hoare language from HOL/Library, 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 DPT_SAT_Solver, 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 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 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 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 , Akihisa Yamada contributors = Alexander Bentkamp 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 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 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 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 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 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 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 +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 Universal + Turing Machine 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 , 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 , Andreas Lochbihler 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 , Akihisa Yamada , Sebastiaan Joosten 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 , Akihisa Yamada 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 , Akihisa Yamada 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 [Perron_Frobenius] title = Perron-Frobenius Theorem for Spectral Radius Analysis author = Jose Divasón , Ondřej Kunčar , René Thiemann , Akihisa Yamada 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 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 , Denis Lohner 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 Braun et al., 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 CompCertSSA project with it.

A more detailed description of the verified SSA construction can be found in the paper Verified Construction of Static Single Assignment Form, CC 2016.

notify = denis.lohner@kit.edu [Minimal_SSA] title = Minimal Static Single Assignment Form author = Max Wagner , Denis Lohner topic = Computer science/Programming languages/Transformations date = 2017-01-17 notify = denis.lohner@kit.edu abstract =

This formalization is an extension to "Verified Construction of Static Single Assignment Form". In their work, the authors have shown that Braun et al.'s static single assignment (SSA) construction algorithm 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 Cytron et al..

[PropResPI] title = Propositional Resolution and Prime Implicates Generation author = Nicolas 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 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 , Stefan Berghofer , Cezary Kaliszyk 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 , Cezary Kaliszyk 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 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 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 , Maximilian Haslbeck , Peter Lammich , Lars 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 , István Németi 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 [Groebner_Bases] title = Gröbner Bases Theory author = Fabian Immler , 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 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 Ideals, Varieties, and Algorithms by Cox, Little and O'Shea. [Bell_Numbers_Spivey] title = Spivey's Generalized Recurrence for Bell Numbers author = Lukas Bulwahn 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 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 = eberlm@in.tum.de [SDS_Impossibility] title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness author = Manuel Eberl 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 = eberlm@in.tum.de [Median_Of_Medians_Selection] title = The Median-of-Medians Selection Algorithm author = Manuel Eberl topic = Computer science/Algorithms date = 2017-12-21 notify = eberlm@in.tum.de 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 topic = Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de 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 , Paul-David Brodmann , Tim Jungnickel , Christina Rickmann , Henning Seidler , Anke Stüber , Arno Wilhelm-Weidner , Kirstin Peters , Uwe 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 , 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 , Denis Lohner date = 2016-05-20 topic = Logic/Proof theory abstract = The Incredible Proof Machine 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 , 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 notify = eberlm@in.tum.de 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 notify = eberlm@in.tum.de 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 contributors = Lawrence C. Paulson topic = Mathematics/Number theory date = 2017-01-17 notify = eberlm@in.tum.de 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 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 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].

[Sch18] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". Journal of Automated Reasoning, 2018.
[Sch16] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016.
[Sch15] Anders Schlichtkrull. "Formalization of Resolution Calculus in Isabelle". https://people.compute.dtu.dk/andschl/Thesis.pdf. MSc thesis. Technical University of Denmark, 2015.
[BA12] Mordechai Ben-Ari. Mathematical Logic for Computer Science. 3rd. Springer, 2012.
[CL73] Chin-Liang Chang and Richard Char-Tung Lee. Symbolic Logic and Mechanical Theorem Proving. 1st. Academic Press, Inc., 1973.
[Lei97] Alexander Leitsch. The Resolution Calculus. Texts in theoretical computer science. Springer, 1997.
[IsaFoL] IsaFoL authors. IsaFoL: Isabelle Formalization of Logic. https://bitbucket.org/jasmin_blanchette/isafol. 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 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 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 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 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 notify = eberlm@in.tum.de 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 Graham Jameson.

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 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 , Sebastiaan Joosten , René Thiemann , Akihisa Yamada 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 , Lawrence C. Paulson 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 topic = Mathematics/Probability theory, Mathematics/Geometry date = 2017-06-06 notify = eberlm@in.tum.de 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 , David Sanan , Alwen Tiu , Yang Liu 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 , David Sanan , Alwen Tiu , Rajeev Gore , Ranald Clouston 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 , Cornelius 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 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 , Lars-Henrik Eriksson , Joachim Parrow , Johannes Borgström , Ramunas Gutkovas 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 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 ITP 2012 paper. 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 Concrete Semantics. [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 , Jørgen Villadsen 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 , Ian J. Hayes , Andrius Velykis 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 , Anders Schlichtkrull , Jørgen Villadsen 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. https://content.iospress.com/articles/ai-communications/aic764

See also: Students' Proof Assistant (SPA). https://github.com/logic-tools/spa

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, Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-24 notify = eberlm@in.tum.de 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 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. [Stone_Kleene_Relation_Algebras] title = Stone-Kleene Relation Algebras author = 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 , Andrei Popescu , Dmitriy Traytel 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 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. [Elliptic_Curves_Group_Law] title = The Group Law for Elliptic Curves author = Stefan Berghofer 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 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 submission guidelines 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 , Martin Kleppmann, Dominic P. Mulligan, Alastair R. Beresford 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, Brian Huffman<>, Neil Mitchell<>, Christian Sternagel 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 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 available on arXiv. [DynamicArchitectures] title = Dynamic Architectures author = Diego Marmsoler 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 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 , Victor B. F. Gomes , Dominic P. Mulligan 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 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 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 Principia Logico-Metaphysica (PLM) 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 known to be challenging.

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 as promoted by Christoph Benzmüller.

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 Multidimensional binary search trees used for associative searching and An Algorithm for Finding Best Matches in Logarithmic Expected Time. 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 , Tobias 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 , Tobias Nipkow , Simon Robillard 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, independent set, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. [Diophantine_Eqns_Lin_Hom] title = Homogeneous Linear Diophantine Equations author = Florian Messner , Julian Parsert , Jonas Schöpf , Christian Sternagel 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 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 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 a rectangle box or a 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). [Buchi_Complementation] title = Büchi Complementation author = Julian Brunner 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:
  1. Definition of odd rankings and proof that an automaton rejects a word iff there exists an odd ranking for it.
  2. Definition of the complement automaton and proof that it accepts exactly those words for which there is an odd ranking.
  3. Verified implementation of the complement automaton using the Isabelle Collections Framework.
[Transition_Systems_and_Automata] title = Transition Systems and Automata author = Julian Brunner 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 , 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 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 topic = Mathematics/Number theory, Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de 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 topic = Mathematics/Algebra date = 2018-09-25 notify = eberlm@in.tum.de 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:

  • 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).
  • 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.
  • 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.

Both the symmetry property itself and the witness for the Fundamental Theorem are executable.

[Taylor_Models] title = Taylor Models author = Christoph Traut<>, Fabian 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 , Lawrence C. Paulson 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. [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 , Jasmin Christian Blanchette , Dmitriy Traytel , Uwe Waldmann 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 , Dmitriy Traytel 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 , Andrei Popescu , Dmitriy Traytel 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 , Maximilian Haslbeck , Sebastiaan Joosten , René 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 , Sebastiaan Joosten , René Thiemann , Akihisa Yamada 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 , Manuel Eberl , Tobias Nipkow topic = Computer science/Data structures date = 2018-02-06 notify = eberlm@in.tum.de 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 , Manuel Eberl 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 topic = Mathematics/Number theory date = 2020-01-17 notify = eberlm@in.tum.de 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 , Tobias 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 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 , 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 Hirai and Yamamoto 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 , Manuel Eberl , Christian Saile , Christian Stricker topic = Mathematics/Games and economics date = 2018-03-22 notify = eberlm@in.tum.de 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 Brandt et al., 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 , Joshua Schneider 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
  1. BNFCCs are closed under functor composition and least and greatest fixpoints,
  2. subtypes inherit the BNFCC structure under conditions that generalise those for the BNF case, and
  3. BNFCCs preserve quotients under mild conditions.
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 , Richard Gay , Sylvia Grewe , Heiko Mantel , Henning Sudbrock , Markus Tasch 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 , Dana 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 , Victor B. F. Gomes , Dominic P. Mulligan , Alastair R. Beresford 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 , Wenda Li 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 , 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 Monadification, Memoization and Dynamic Programming, thus yielding dynamic programming algorithms. [Projective_Geometry] title = Projective Geometry author = Anthony Bordg 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 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, Cezary Kaliszyk 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ć , Mirko Spasić , René 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 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 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 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 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. [Prime_Number_Theorem] title = The Prime Number Theorem author = Manuel Eberl , Lawrence C. Paulson topic = Mathematics/Number theory date = 2018-09-19 notify = eberlm@in.tum.de 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 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 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 , Bohua Zhan 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 = eberlm@in.tum.de 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 `What is a Matroid?'.

[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 paper by the author 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 , Jasmin Christian Blanchette , Dmitriy Traytel 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 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 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 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 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 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 , Michael 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. [Store_Buffer_Reduction] title = A Reduction Theorem for Store Buffers author = Ernie Cohen , Norbert Schirmer 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 , Simon Wimmer 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:
  • Bisection Square Root,
  • Extended Euclid,
  • Exponentiation by Squaring,
  • Binary Search,
  • Insertion Sort,
  • Quicksort,
  • Depth First Search.
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 , Max W. Haslbeck , René 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 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 , Frank Zeyda<>, Yakoub Nemouchi , Pedro Ribeiro<>, Burkhart Wolff 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 , Lina Ye , Burkhart Wolff 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 topic = Mathematics/Number theory date = 2019-02-11 notify = eberlm@in.tum.de 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 , Peter 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 topic = Computer science/Algorithms date = 2019-02-01 notify = eberlm@in.tum.de 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 topic = Mathematics/Number theory date = 2019-02-21 notify = eberlm@in.tum.de abstract =

This entry is a formalisation of Chapter 4 (and parts of Chapter 3) of Apostol's Introduction to Analytic Number Theory. 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 OCL type system, its abstract syntax and expression typing rules. The theory does not define a concrete syntax and a semantics. In contrast to Featherweight OCL, 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 safe navigation operations. 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 , 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 , Wenda Li 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 , Andrei Popescu 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 , Salomon Sickert 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 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. Miller et al. 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 a paper draft. [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 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 , Alban Reynaud <>, René 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 , Cezary Kaliszyk 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 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. [Complete_Non_Orders] title = Complete Non-Orders and Fixed Points author = Akihisa Yamada , Jérémy 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 , Tobias 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 , Tobias 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 , Dmitriy Traytel 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 RV 2019 paper, 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 contributors = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen 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. [Szpilrajn] title = Szpilrajn Extension Theorem author = Peter Zeller topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = We formalize the Szpilrajn extension theorem, also known as order-extension principal: Every strict partial order can be extended to a strict linear order. [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van , Frédéric Boulanger , Burkhart Wolff 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:

  • the behavior of the sub-systems is observed only at a series of discrete instants,
  • events may occur in different sub-systems at unrelated times, leading to polychronous systems, which do not necessarily have a common base clock,
  • 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,
  • the domain of time (discrete, rational, continuous...) may be different in the subsystems, leading to polytimed systems,
  • 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).
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 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 topic = Mathematics/Misc date = 2019-08-05 notify = eberlm@in.tum.de 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 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 Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting. 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 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. [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, Ngo, Ré, and Rudra 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 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 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. [VerifyThis2019] title = VerifyThis 2019 -- Polished Isabelle Solutions author = Peter Lammich<>, Simon Wimmer 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 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 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 Differential_Dynamic_Logic 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 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 , Yong Kiam Tan 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 , Burkhart 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 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 Filaseta's presentation of Beukers's proof.

[Hybrid_Logic] title = Formalizing a Seligman-Style Tableau System for Hybrid Logic author = Asta Halkjær From 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 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. 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)
[Subset_Boolean_Algebras] title = A Hierarchy of Algebras for Boolean Subsets author = Walter Guttmann , Bernhard Möller 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 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 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 , Lars 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 , Edgar Gonzàlez 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 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 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 on the Matryoshka website. 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 , 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:
  • 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;
  • 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;
  • alternative proofs of fairness (and hence saturation and ultimately refutational completeness) for the given clause procedures GC and LGC, based on invariance.
[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 , Joshua Schneider , Dmitriy Traytel 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 forthcoming paper at IJCAR 2020, significantly extends previous work on a verified monitor for MFOTL. Apart from the addition of regular expressions and aggregations, we implemented multi-way joins and a specialized sliding window algorithm to further optimize the monitor. [Sliding_Window_Algorithm] title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows author = Lukas Heimes<>, Dmitriy Traytel , 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 sliding window algorithm (SWA) 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 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 , Ognjen Marić 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 Canton, 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 topic = Mathematics/Algebra date = 2020-04-24 notify = eberlm@in.tum.de 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.

[Gaussian_Integers] title = Gaussian Integers author = Manuel Eberl topic = Mathematics/Number theory date = 2020-04-24 notify = eberlm@in.tum.de 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:

  1. The characterisation of all positive integers that can be written as sums of two squares
  2. Euclid's formula for primitive Pythagorean triples

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 , Miguel Pagano , Pedro Sánchez Terraf 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. [Recursion-Addition] title = Recursion Theorem in ZF author = Georgy Dunaev 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 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 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 , Wenda Li 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 [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. [Knuth_Bendix_Order] title = A Formalization of Knuth–Bendix Orders author = Christian Sternagel , René 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 , Sebastian Mödersheim , Achim D. Brucker 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 , Sebastian Mödersheim , Achim D. Brucker , Anders Schlichtkrull 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 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 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 , Fabian 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 , Peter Höfner 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 topic = Mathematics/Number theory date = 2020-08-04 notify = ak2110@cam.ac.uk -abstract = +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 topic = Mathematics/Combinatorics, Logic/Set theory date = 2020-08-03 notify = lp15@cam.ac.uk -abstract = +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 topic = Computer science/Data structures date = 2020-08-26 notify = walter.guttmann@canterbury.ac.nz -abstract = +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. +[PAC_Checker] +title = Practical Algebraic Calculus Checker +author = Mathias Fleury , Daniela 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 +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. + diff --git a/thys/BirdKMP/HOLCF_ROOT.thy b/thys/BirdKMP/HOLCF_ROOT.thy new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/HOLCF_ROOT.thy @@ -0,0 +1,275 @@ +(*<*) +theory HOLCF_ROOT +imports + "HOLCF-Prelude.HOLCF_Prelude" +begin + +(*>*) +section\Extra HOLCF\ + +lemma lfp_fusion: + assumes "g\\ = \" + assumes "g oo f = h oo g" + shows "g\(fix\f) = fix\h" +proof(induct rule: parallel_fix_ind) + case 2 show "g\\ = \" by fact + case (3 x y) + from \g\x = y\ \g oo f = h oo g\ show "g\(f\x) = h\y" + by (simp add: cfun_eq_iff) +qed simp + +lemma predE: + obtains (strict) "p\\ = \" | (FF) "p = (\ x. FF)" | (TT) "p = (\ x. TT)" +using flat_codom[where f=p and x=\] by (cases "p\\"; force simp: cfun_eq_iff) + +lemma retraction_cfcomp_strict: + assumes "f oo g = ID" + shows "f\\ = \" +using assms retraction_strict by (clarsimp simp: cfun_eq_iff) + +lemma match_Pair_csplit[simp]: "match_Pair\x\k = k\(cfst\x)\(csnd\x)" +by (cases x) simp + +lemmas oo_assoc = assoc_oo \\Normalize name\ + +lemma If_cancel[simp]: "(If b then x else x) = seq\b\x" +by (cases b) simp_all + +lemma seq_below[iff]: "seq\x\y \ y" +by (simp add: seq_conv_if) + +lemma seq_strict_distr: "f\\ = \ \ seq\x\(f\y) = f\(seq\x\y)" +by (cases "x = \"; clarsimp) + +lemma strictify_below[iff]: "strictify\f \ f" +unfolding strictify_def by (clarsimp simp: cfun_below_iff) + +lemma If_distr: + "\f \ = \; cont f\ \ f (If b then t else e) = (If b then f t else f e)" + "\cont t'; cont e'\ \ (If b then t' else e') x = (If b then t' x else e' x)" + "(If b then t''' else e''')\x = (If b then t'''\x else e'''\x)" + "\g \ = \; cont g\ \ g (If b then t'' else e'') y = (If b then g t'' y else g e'' y)" +by (case_tac [!] b) simp_all + +lemma If2_split_asm: "P (If2 Q x y) \ \(Q = \ \ \P \ \ Q = TT \ \P x \ Q = FF \ \P y)" + by (cases Q) (simp_all add: If2_def) + +lemmas If2_splits = split_If2 If2_split_asm + +lemma If2_cont[simp, cont2cont]: + assumes "cont i" + assumes "cont t" + assumes "cont e" + shows "cont (\x. If2 (i x) (t x) (e x))" +using assms unfolding If2_def by simp + +lemma If_else_FF[simp]: "(If b then t else FF) = (b andalso t)" +by (cases b) simp_all + +lemma If_then_TT[simp]: "(If b then TT else e) = (b orelse e)" +by (cases b) simp_all + +lemma If_cong: + assumes "b = b'" + assumes"b = TT \ t = t'" + assumes "b = FF \ e = e'" + shows "(If b then t else e) = (If b' then t' else e')" +using assms by (cases b) simp_all + +lemma If_tr: "(If b then t else e) = ((b andalso t) orelse (neg\b andalso e))" +by (cases b) simp_all + +lemma If_andalso: + shows "If p andalso q then t else e = If p then If q then t else e else e" +by (cases p) simp_all + +lemma If_else_absorb: + assumes "c = \ \ e = \" + assumes "c = TT \ e = t" + shows "If c then t else e = e" +using assms by (cases c; clarsimp) + +lemma andalso_cong: "\P = P'; P' = TT \ Q = Q'\ \ (P andalso Q) = (P' andalso Q')" +by (cases P) simp_all + +lemma andalso_weaken_left: + assumes "P = TT \ Q = TT" + assumes "P = FF \ Q \ \" + assumes "P = \ \ Q \ FF" + shows "P = (Q andalso P)" +using assms by (cases P; cases Q; simp) + +lemma orelse_cong: "\P = P'; P' = FF \ Q = Q'\ \ (P orelse Q) = (P' orelse Q')" +by (cases P) simp_all + +lemma orelse_conv[simp]: + "((x orelse y) = TT) \ (x = TT \ (x = FF \ y = TT))" + "((x orelse y) = \) \ (x = \ \ (x = FF \ y = \))" +by (cases x; cases y; simp)+ + +lemma csplit_cfun2: "cont F \ (\ x. F x) = (\ (x, y). F (x, y))" +by (clarsimp simp: cfun_eq_iff prod_cont_iff) + +lemma csplit_cfun3: "cont F \ (\ x. F x) = (\ (x, y, z). F (x, y, z))" +by (clarsimp simp: cfun_eq_iff prod_cont_iff) + +definition convol :: "('a::cpo \ 'b::cpo) \ ('a \ 'c::cpo) \ 'a \ 'b \ 'c" where + "convol = (\ f g x. (f\x, g\x))" + +abbreviation convol_syn :: "('a::cpo \ 'b::cpo) \ ('a \ 'c::cpo) \ 'a \ 'b \ 'c" (infix "&&" 65) where + "f && g \ convol\f\g" + +lemma convol_strict[simp]: + "convol\\\\ = \" +unfolding convol_def by simp + +lemma convol_simp[simp]: "(f && g)\x = (f\x, g\x)" +unfolding convol_def by simp + +definition map_prod :: "('a::cpo \ 'c::cpo) \ ('b::cpo \ 'd) \ 'a \ 'b \ 'c \ 'd" where + "map_prod = (\ f g (x, y). (f\x, g\y))" + +abbreviation map_prod_syn :: "('a \ 'c) \ ('b \ 'd) \ 'a \ 'b \ 'c \ 'd" (infix "**" 65) where + "f ** g \ map_prod\f\g" + +lemma map_prod_cfcomp[simp]: "(f ** m) oo (g ** n) = (f oo g) ** (m oo n)" +unfolding map_prod_def by (clarsimp simp: cfun_eq_iff) + +lemma map_prod_ID[simp]: "ID ** ID = ID" +unfolding map_prod_def by (clarsimp simp: cfun_eq_iff) + +lemma map_prod_app[simp]: "(f ** g)\x = (f\(cfst\x), g\(csnd\x))" +unfolding map_prod_def by (cases x) (clarsimp simp: cfun_eq_iff) + +lemma map_prod_cfst[simp]: "cfst oo (f ** g) = f oo cfst" +by (clarsimp simp: cfun_eq_iff) + +lemma map_prod_csnd[simp]: "csnd oo (f ** g) = g oo csnd" +by (clarsimp simp: cfun_eq_iff) + + +subsection\ Extra HOLCF Prelude. \ + +lemma eq_strict[simp]: "eq\(\::'a::Eq_strict) = \" +by (simp add: cfun_eq_iff) + +lemma Integer_le_both_plus_1[simp]: + fixes m :: Integer + shows "le\(m + 1)\(n + 1) = le\m\n" +by (cases m; cases n; simp add: one_Integer_def) + +lemma plus_eq_MkI_conv: + "l + n = MkI\m \ (\l' n'. l = MkI\l' \ n = MkI\n' \ m = l' + n')" +by (cases l, simp) (cases n, auto) + +lemma lt_defined: + fixes x :: Integer + shows + "lt\x\y = TT \ (x \ \ \ y \ \)" + "lt\x\y = FF \ (x \ \ \ y \ \)" +by (cases x; cases y; clarsimp)+ + +lemma le_defined: + fixes x :: Integer + shows + "le\x\y = TT \ (x \ \ \ y \ \)" + "le\x\y = FF \ (x \ \ \ y \ \)" +by (cases x; cases y; clarsimp)+ + +text\Induction on \Integer\, following the setup for the \int\ type.\ + +definition Integer_ge_less_than :: "int \ (Integer \ Integer) set" + where "Integer_ge_less_than d = {(MkI\z', MkI\z) |z z'. d \ z' \ z' < z}" + +lemma wf_Integer_ge_less_than: "wf (Integer_ge_less_than d)" +proof(rule wf_subset) + show "Integer_ge_less_than d \ measure (\z. nat (if z = \ then d else (THE z'. z = MkI\z') - d))" + unfolding Integer_ge_less_than_def by clarsimp +qed simp + + +subsection\ Element equality \label{sec:equality} \ + +text\ + +To avoid many extraneous headaches that take us far away from the +interesting parts of our derivation, we assume that the elements of +the pattern and text are drawn from a @{class \pcpo\} +where, if the @{const \eq\} function on this type is +given defined arguments, then its result is defined and coincides with +@{term \(=)\}. + +Note this effectively restricts us to @{class \flat\} +element types; see @{cite [cite_macro=citet] \\S4.12\ +"Paulson:1987"} for a discussion. + +\ + +class Eq_def = Eq_eq + + assumes eq_defined: "\x \ \; y \ \\ \ eq\x\y \ \" +begin + +lemma eq_bottom_iff[simp]: "(eq\x\y = \) \ (x = \ \ y = \)" +using eq_defined by auto + +lemma eq_defined_reflD[simp]: + "(eq\a\a = TT) \ a \ \" + "(TT = eq\a\a) \ a \ \" + "a \ \ \ eq\a\a = TT" +using eq_refl by auto + +lemma eq_FF[simp]: + "(FF = eq\xs\ys) \ (xs \ \ \ ys \ \ \ xs \ ys)" + "(eq\xs\ys = FF) \ (xs \ \ \ ys \ \ \ xs \ ys)" +by (metis (mono_tags, hide_lams) Exh_tr dist_eq_tr(5) eq_TT_dest eq_bottom_iff eq_self_neq_FF')+ + +lemma eq_TT[simp]: + "(TT = eq\xs\ys) \ (xs \ \ \ ys \ \ \ xs = ys)" + "(eq\xs\ys = TT) \ (xs \ \ \ ys \ \ \ xs = ys)" +by (auto simp: local.eq_TT_dest) + +end + +instance Integer :: Eq_def by standard simp + + +subsection \Recursive let bindings\ + +text\ + +@{verbatim \ +Title: HOL/HOLCF/ex/Letrec.thy +Author: Brian Huffman +\} + +See \S\ref{sec:KMP:final_version} for an example use. + +\ + +definition + CLetrec :: "('a::pcpo \ 'a \ 'b::pcpo) \ 'b" where + "CLetrec = (\ F. prod.snd (F\(\ x. prod.fst (F\x))))" + +nonterminal recbinds and recbindt and recbind + +syntax + "_recbind" :: "logic \ logic \ recbind" ("(2_ =/ _)" 10) + "" :: "recbind \ recbindt" ("_") + "_recbindt" :: "recbind \ recbindt \ recbindt" ("_,/ _") + "" :: "recbindt \ recbinds" ("_") + "_recbinds" :: "recbindt \ recbinds \ recbinds" ("_;/ _") + "_Letrec" :: "recbinds \ logic \ logic" ("(Letrec (_)/ in (_))" 10) + +translations + (recbindt) "x = a, (y,ys) = (b,bs)" == (recbindt) "(x,y,ys) = (a,b,bs)" + (recbindt) "x = a, y = b" == (recbindt) "(x,y) = (a,b)" + +translations + "_Letrec (_recbinds b bs) e" == "_Letrec b (_Letrec bs e)" + "Letrec xs = a in (e,es)" == "CONST CLetrec\(\ xs. (a,e,es))" + "Letrec xs = a in e" == "CONST CLetrec\(\ xs. (a,e))" + +(*<*) + +end +(*>*) diff --git a/thys/BirdKMP/KMP.thy b/thys/BirdKMP/KMP.thy new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/KMP.thy @@ -0,0 +1,1994 @@ +(*<*) +theory KMP +imports + Theory_Of_Lists +begin + +hide_const abs + +(*>*) +section\ Knuth-Morris-Pratt matching according to Bird \label{sec:KMP} \ + + +subsection\ Step 1: Specification \label{sec:KMP:specification} \ + +text\ + +We begin with the specification of string matching given by @{cite [cite_macro=citet] \Chapter~16\ +"Bird:PearlsofFAD:2010"}. (References to ``Bird'' in the following are to this text.) Note that +we assume @{const \eq\} has some nice properties (see \S\ref{sec:equality}) and +use strict lists. + +\ + +fixrec endswith :: "[:'a::Eq_def:] \ [:'a:] \ tr" where +[simp del]: "endswith\pat = selem\pat oo stails" + +fixrec matches :: "[:'a::Eq_def:] \ [:'a:] \ [:Integer:]" where +[simp del]: "matches\pat = smap\slength oo sfilter\(endswith\pat) oo sinits" + +text\ + +Bird describes @{term "matches\pat\xs"} as returning ``a list of integers \p\ such that \pat\ is a +suffix of @{term "stake\p\xs"}.'' + +The following examples illustrate this behaviour: + +\ + +lemma "matches\[::]\[::] = [:0:]" +unfolding matches.unfold endswith.unfold by simp + +lemma "matches\[::]\[:10::Integer, 20, 30:] = [:0, 1, 2, 3:]" +unfolding matches.unfold endswith.unfold by simp + +lemma "matches\[:1::Integer,2,3,1,2:]\[:1,2,1,2,3,1,2,3,1,2:] = [:7, 10:]" +unfolding matches.unfold endswith.unfold +by (simp add: sfilter_scons_let del: sfilter_strict_scons sfilter.simps) + +lemma endswith_strict[simp]: + "endswith\\ = \" + "endswith\pat\\ = \" +by (fixrec_simp; simp add: cfun_eq_iff)+ + +lemma matches_strict[simp]: + "matches\\ = \" + "matches\pat\\ = \" +by (fixrec_simp; clarsimp simp: cfun_eq_iff)+ + +text\ + +Bird's strategy for deriving KMP from this specification is encoded in the following lemmas: +if we can rewrite @{const \endswith\} as a composition of a predicate with a +@{const \sfoldl\}, then we can rewrite @{const \matches\} into a @{const \sscanl\}. + +\ + +lemma fork_sfoldl: + shows "sfoldl\f1\z1 && sfoldl\f2\z2 = sfoldl\(\ (a, b) z. (f1\a\z, f2\b\z))\(z1, z2)" (is "?lhs = ?rhs") +proof(rule cfun_eqI) + fix xs show "?lhs\xs = ?rhs\xs" + by (induct xs arbitrary: z1 z2) simp_all +qed + +lemma smap_sfilter_split_cfcomp: \\ Bird (16.4) \ + assumes "f\\ = \" + assumes "p\\ = \" + shows "smap\f oo sfilter\(p oo g) = smap\cfst oo sfilter\(p oo csnd) oo smap\(f && g)" (is "?lhs = ?rhs") +proof(rule cfun_eqI) + fix xs show "?lhs\xs = ?rhs\xs" + using assms by (induct xs) (simp_all add: If2_def[symmetric] split: If2_splits) +qed + +lemma Bird_strategy: + assumes endswith: "endswith\pat = p oo sfoldl\op\z" + assumes step: "step = (\ (n, x) y. (n + 1, op\x\y))" + assumes "p\\ = \" \\ We can reasonably expect the predicate to be strict \ + shows "matches\pat = smap\cfst oo sfilter\(p oo csnd) oo sscanl\step\(0, z)" +apply (simp add: matches.simps assoc_oo endswith) +apply (subst smap_sfilter_split_cfcomp, fastforce, fact) +apply (subst slength_sfoldl) +apply (subst fork_sfoldl) +apply (simp add: oo_assoc[symmetric]) +apply (subst sinits_sscanl) +apply (fold step) +apply (rule refl) +done + +text\ + +Bird proceeds by reworking @{const \endswith\} into the form required by @{thm [source] "Bird_strategy"}. +This is eased by an alternative definition of @{const \endswith\}. + +\ + +lemma sfilter_supto: + assumes "0 \ d" + shows "sfilter\(\ x. le\(MkI\n - x)\(MkI\d))\(supto\(MkI\m)\(MkI\n)) + = supto\(MkI\(if m \ n - d then n - d else m))\(MkI\n)" (is "?sfilterp\?suptomn = _") +proof(cases "m \ n - d") + case True + moreover + from True assms have "?sfilterp\?suptomn = ?sfilterp\(supto\(MkI\m)\(MkI\(n - d - 1)) :@ supto\(MkI\(n - d))\(MkI\n))" + using supto_split1 by auto + moreover from True assms have "?sfilterp\(supto\(MkI\m)\(MkI\(n - d - 1))) = [::]" by auto + ultimately show ?thesis by (clarsimp intro!: trans[OF sfilter_cong[OF refl] sfilter_const_TT]) +next + case False then show ?thesis + by (clarsimp intro!: trans[OF sfilter_cong[OF refl] sfilter_const_TT]) +qed + +lemma endswith_eq_sdrop: "endswith\pat\xs = eq\pat\(sdrop\(slength\xs - slength\pat)\xs)" +proof(cases "pat = \" "xs = \" rule: bool.exhaust[case_product bool.exhaust]) + case False_False then show ?thesis + by (cases "endswith\pat\xs"; + simp only: endswith.simps cfcomp2 stails_sdrop'; + force simp: zero_Integer_def one_Integer_def elim: slengthE) +qed simp_all + +lemma endswith_def2: \\ Bird p127 \ + shows "endswith\pat\xs = eq\pat\(shead\(sfilter\(\ x. prefix\x\pat)\(stails\xs)))" (is "?lhs = ?rhs") +proof(cases "pat = \" "xs = \" rule: bool.exhaust[case_product bool.exhaust]) + case False_False + from False_False obtain patl xsl where *: "slength\xs = MkI\xsl" "0 \ xsl" "slength\pat = MkI\patl" "0 \ patl" + by (meson Integer.exhaust slength_bottom_iff slength_ge_0) + let ?patl_xsl = "if patl \ xsl then xsl - patl else 0" + have "?rhs = eq\pat\(shead\(sfilter\(\ x. le\(slength\x)\(slength\pat) andalso prefix\x\pat)\(stails\xs)))" + by (subst prefix_slength_strengthen) simp + also have "\ = eq\pat\(shead\(sfilter\(\ x. prefix\x\pat)\(sfilter\(\ x. le\(slength\x)\(slength\pat))\(stails\xs))))" + by (simp add: sfilter_sfilter') + also have "\ = eq\pat\(shead\(smap\(\ k. sdrop\k\xs)\(sfilter\(\ k. prefix\(sdrop\k\xs)\pat)\(sfilter\(\ k. le\(slength\(sdrop\k\xs))\(MkI\patl))\(supto\(MkI\0)\(MkI\xsl))))))" + using \slength\xs = MkI\xsl\ \slength\pat = MkI\patl\ + by (simp add: stails_sdrop' sfilter_smap' cfcomp1 zero_Integer_def) + also have "\ = eq\pat\(shead\(smap\(\ k. sdrop\k\xs)\(sfilter\(\ k. prefix\(sdrop\k\xs)\pat)\(sfilter\(\ k. le\(MkI\xsl - k)\(MkI\patl))\(supto\(MkI\0)\(MkI\xsl))))))" + using \slength\xs = MkI\xsl\ + by (subst (2) sfilter_cong[where p'="\ x. le\(MkI\xsl - x)\(MkI\patl)"]; fastforce simp: zero_Integer_def) + also have "\ = If prefix\(sdrop\(MkI\?patl_xsl)\xs)\pat + then eq\pat\(sdrop\(MkI\?patl_xsl)\xs) + else eq\pat\(shead\(smap\(\ k. sdrop\k\xs)\(sfilter\(\ x. prefix\(sdrop\x\xs)\pat)\(supto\(MkI\(?patl_xsl + 1))\(MkI\xsl)))))" + using False_False \0 \ xsl\ \0 \ patl\ + by (subst sfilter_supto) (auto simp: If_distr one_Integer_def) + also have "\ = ?lhs" (is "If ?c then _ else ?else = _") + proof(cases ?c) + case TT with \slength\xs = MkI\xsl\ \slength\pat = MkI\patl\ + show ?thesis by (simp add: endswith_eq_sdrop sdrop_neg zero_Integer_def) + next + case FF \\ Recursive case: the lists generated by \supto\ are too short \ + have "?else = shead\(smap\(\ x. eq\pat\(sdrop\x\xs))\(sfilter\(\ x. prefix\(sdrop\x\xs)\pat)\(supto\(MkI\(?patl_xsl + 1))\(MkI\xsl))))" + using FF by (subst shead_smap_distr[where f="eq\pat", symmetric]) (auto simp: cfcomp1) + also have "\ = shead\(smap\(\ x. seq\x\FF)\(sfilter\(\ x. prefix\(sdrop\x\xs)\pat)\(supto\(MkI\(?patl_xsl + 1))\(MkI\xsl))))" + using False_False * by (subst smap_cong[OF refl, where f'="\ x. seq\x\FF"]) (auto simp: zero_Integer_def split: if_splits) + also from * FF have "\ = ?lhs" + apply (auto 0 0 simp: shead_smap_distr seq_conv_if endswith_eq_sdrop zero_Integer_def dest!: prefix_FF_not_snilD) + apply (metis (full_types) le_MkI_MkI linorder_not_less order_refl prefix_FF_not_snilD sdrop_all zless_imp_add1_zle) + using FF apply fastforce + apply (metis add.left_neutral le_MkI_MkI linorder_not_less order_refl prefix_FF_not_snilD sdrop_0(1) sdrop_all zero_Integer_def zless_imp_add1_zle) + done + finally show ?thesis using FF by simp + qed (simp add: False_False) + finally show ?thesis .. +qed simp_all + +text\ + +Bird then generalizes @{term \sfilter\(\ x. prefix\x\pat) oo stails\} to @{term \split\}, +where ``\split\pat\xs\ splits \pat\ into two lists \us\ and \vs\ so that +@{prop \us :@ vs = pat\} and \us\ is the longest suffix of \xs\ that is a prefix of \pat\.'' + +\ + +fixrec split :: "[:'a::Eq_def:] \ [:'a:] \ [:'a:] \ [:'a:]" where \\ Bird p128 \ +[simp del]: "split\pat\xs = If prefix\xs\pat then (xs, sdrop\(slength\xs)\pat) else split\pat\(stail\xs)" + +lemma split_strict[simp]: + shows "split\\ = \" + and "split\pat\\ = \" +by fixrec_simp+ + +lemma split_bottom_iff[simp]: "(split\pat\xs = \) \ (pat = \ \ xs = \)" +by (cases "pat = \"; clarsimp) (induct xs; subst split.unfold; simp) + +lemma split_snil[simp]: + assumes "pat \ \" + shows "split\pat\[::] = ([::], pat)" +using assms by fixrec_simp + +lemma split_pattern: \\ Bird p128, observation \ + assumes "xs \ \" + assumes "split\pat\xs = (us, vs)" + shows "us :@ vs = pat" +using assms +proof(cases "pat = \", simp, induct xs arbitrary: us vs) + case snil then show ?case by (subst (asm) split.unfold) simp +next + case (scons x xs) then show ?case + by (subst (asm) (3) split.unfold) + (fastforce dest: prefix_sdrop_slength simp: If2_def[symmetric] split: If2_splits) +qed simp + +lemma endswith_split: \\ Bird p128, after defining \split\ \ + shows "endswith\pat = snull oo csnd oo split\pat" +proof(rule cfun_eqI) + fix xs show "endswith\pat\xs = (snull oo csnd oo split\pat)\xs" + proof(cases "pat = \", simp, induct xs) + case (scons x xs) then show ?case + unfolding endswith_def2 + by (subst split.unfold) + (fastforce dest: prefix_sdrop_prefix_eq simp: If2_def[symmetric] If_distr snull_eq_snil split: If2_splits) + qed (simp_all add: snull_eq_snil endswith.simps) +qed + +lemma split_length_lt: + assumes "pat \ \" + assumes "xs \ \" + shows "lt\(slength\(prod.fst (split\pat\xs)))\(slength\xs + 1) = TT" +using assms +proof(induct xs) + case (scons x xs) then show ?case + by (subst split.unfold) + (auto simp: If2_def[symmetric] one_Integer_def split: If2_splits elim!: slengthE elim: lt_trans) +qed simp_all + +text\ + +The predicate \p\ required by @{thm [source] "Bird_strategy"} is therefore \snull oo csnd\. It +remains to find \op\ and \z\ such that: + +\<^item> @{term \split\pat\[::] = z\} +\<^item> @{term \split\pat\(xs :@ [:x:]) = op\(split\pat\xs)\x\} + +\ +text\ + +so that @{term \split = sfoldl\op\z\}. + +We obtain @{term \z = ([::], pat)\} directly from the definition of @{term \split\}. + +Bird derives \op\ on the basis of this crucial observation: + +\ + +lemma split_snoc: \\ Bird p128 \ + shows "split\pat\(xs :@ [:x:]) = split\pat\(cfst\(split\pat\xs) :@ [:x:])" +proof(cases "pat = \", simp, cases "x = \", simp, induct xs) + case (scons x xs) then show ?case + apply - + apply (subst (1 3) split.unfold) + apply (clarsimp simp: If2_def[symmetric] split: If2_splits; intro conjI impI) + apply (subst split.unfold; fastforce) + apply (subst split.unfold; fastforce) + apply (simp add: append_prefixD) + done +qed simp_all + +fixrec \\ Bird p129 \ + op :: "[:'a::Eq_def:] \ [:'a:] \ [:'a:] \ 'a \ [:'a:] \ [:'a:]" +where +[simp del]: + "op\pat\(us, vs)\x = + ( If prefix\[:x:]\vs then (us :@ [:x:], stail\vs) + else If snull\us then ([::], pat) + else op\pat\(split\pat\(stail\us))\x )" + +lemma op_strict[simp]: + "op\pat\\ = \" + "op\pat\(us, \) = \" + "op\pat\usvs\\ = \" +by fixrec_simp+ + +text\ + +Bird demonstrates that @{const \op\} is partially correct wrt @{const \split\}, i.e., +@{prop "op\pat\(split\pat\xs)\x \ split\pat\(xs :@ [:x:])"}. For total correctness we +essentially prove that @{const \op\} terminates on well-defined arguments with an inductive argument. + +\ + +lemma op_induct[case_names step]: + fixes usvs:: "[:'a:] \ 'b" + assumes step: "\usvs. (\usvs'. lt\(slength\(cfst\usvs'))\(slength\(cfst\usvs)) = TT \ P usvs') \ P usvs" + shows "P usvs" +proof(induct usvs rule: wf_induct) + let ?r = "{ (usvs', usvs) |(usvs :: [:'a:] \ 'b) (usvs' :: [:'a:] \ 'b). lt\(slength\(cfst\usvs'))\(slength\(cfst\usvs)) = TT }" + show "wf ?r" + proof(rule wf_subset[OF wf_inv_image[where f="\(x, _). slength\x", OF wf_subset[OF wf_Integer_ge_less_than[where d=0]]]]) + let ?rslen = "{ (slength\us', slength\us) |(us :: [:'a:]) (us' :: [:'a:]). lt\(slength\us')\(slength\us) = TT }" + show "?rslen \ Integer_ge_less_than 0" + apply (clarsimp simp: Integer_ge_less_than_def zero_Integer_def) + apply (metis Integer.exhaust dist_eq_tr(4) dist_eq_tr(6) lt_Integer_bottom_iff lt_MkI_MkI slength_ge_0) + done + show "?r \ inv_image ?rslen (\(x, _). slength\x)" by (auto 0 3) + qed + fix usvs + assume "\usvs'. (usvs', usvs) \ ?r \ P usvs'" + then show "P usvs" + by - (rule step; clarsimp; metis eq_fst_iff) +qed + +lemma op_induct'[case_names step]: + assumes step: "\us. (\us'. lt\(slength\us')\(slength\us) = TT \ P us') \ P us" + shows "P us" +by (rule op_induct[where P="P \ prod.fst" and usvs="(us, vs)" for vs::unit, simplified]) + (fastforce intro: step) + +lemma split_snoc_op: + "split\pat\(xs :@ [:x:]) = op\pat\(split\pat\xs)\x" +proof(induct "split\pat\xs" arbitrary: xs rule: op_induct) + case (step xs) show ?case + proof(cases "pat = \" "xs = \" "x = \" rule: bool.exhaust[case_product bool.exhaust bool.exhaust]) + case False_False_False + obtain us vs where *: "split\pat\xs = (us, vs)" by fastforce + from False_False_False * have **: "prefix\(us :@ [:x:])\pat = prefix\[:x:]\vs" + using split_pattern same_prefix_prefix sappend_bottom_iff by blast + from False_False_False * ** + have ***: "sdrop\(slength\(us :@ [:x:]))\pat = stail\vs" if "prefix\(us :@ [:x:])\pat = TT" + using sdrop_sappend_same[where xs="us :@ [:x:]"] that + by (cases vs; clarsimp) (fastforce dest!: split_pattern) + from False_False_False * ** *** show ?thesis + apply - + apply (subst split_snoc) + apply (subst split.unfold) + apply (subst op.unfold) + apply (fastforce simp: If2_def[symmetric] snull_FF_conv split: If2_splits intro: step split_length_lt) + done + qed simp_all +qed + +lemma split_sfoldl_op: + assumes "pat \ \" + shows "sfoldl\(op\pat)\([::], pat) = split\pat" (is "?lhs = ?rhs") +proof - + have "?lhs\xs = ?rhs\xs" for xs + using assms by (induct xs rule: srev_induct) (simp_all add: split_snoc_op) + then show ?thesis by (simp add: cfun_eq_iff) +qed + +lemma matches_op: + shows "matches\pat = smap\cfst oo sfilter\(snull oo csnd oo csnd) + oo sscanl\(\ (n, usvs) x. (n + 1, op\pat\usvs\x))\(0, ([::], pat))" (is "?lhs = ?rhs") +proof(cases "pat = \") + case True + then have "?lhs\xs = ?rhs\xs" for xs by (cases xs; clarsimp) + then show ?thesis by (simp add: cfun_eq_iff) +next + case False then show ?thesis + apply (subst (2) oo_assoc) + apply (rule Bird_strategy) + apply (simp_all add: endswith_split split_sfoldl_op oo_assoc) + done +qed + +text\ + +Using @{thm [source] "split_sfoldl_op"} we can rewrite @{const \op\} into a more perspicuous form +that exhibits how KMP handles the failure of the text to continue matching the pattern: + +\ + +fixrec + op' :: "[:'a::Eq_def:] \ [:'a:] \ [:'a:] \ 'a \ [:'a:] \ [:'a:]" +where +[simp del]: + "op'\pat\(us, vs)\x = + ( If prefix\[:x:]\vs then (us :@ [:x:], stail\vs) \ \ continue matching \ + else If snull\us then ([::], pat) \ \ fail at the start of the pattern: discard \x\ \ + else sfoldl\(op'\pat)\([::], pat)\(stail\us :@ [:x:]) \ \ fail later: discard \shead\us\ and determine where to restart \ + )" + +text\ + +Intuitively if \x\ continues the pattern match then we +extend the @{const \split\} of \pat\ +recorded in \us\ and \vs\. Otherwise we +need to find a prefix of \pat\ to continue matching +with. If we have yet to make any progress (i.e., \us = +[::]\) we restart with the entire \pat\ (aka +\z\) and discard \x\. Otherwise, because a +match cannot begin with @{term \us :@ [:x:]\}, we @{const +\split\} \pat\ (aka \z\) by +iterating @{const \op'\} over @{term +\stail\us :@ [:x:]\}. The remainder of the +development is about memoising this last computation. + +This is not yet the full KMP algorithm as it lacks what we call the +`K' optimisation, which we add in \S\ref{sec:KMP:data_refinement}. +Note that a termination proof for @{const "op'"} in HOL is tricky due +to its use of higher-order nested recursion via @{const +\sfoldl\}. + +\ + +lemma op'_strict[simp]: + "op'\pat\\ = \" + "op'\pat\(us, \) = \" + "op'\pat\usvs\\ = \" +by fixrec_simp+ + +lemma sfoldl_op'_strict[simp]: + "op'\pat\(sfoldl\(op'\pat)\(us, \)\xs)\x = \" +by (induct xs arbitrary: x rule: srev_induct) simp_all + +lemma op'_op: + shows "op'\pat\usvs\x = op\pat\usvs\x" +proof(cases "pat = \" "x = \" rule: bool.exhaust[case_product bool.exhaust]) + case True_False then show ?thesis + apply (subst op'.unfold) + apply (subst op.unfold) + apply simp + done +next + case False_False then show ?thesis + proof(induct usvs arbitrary: x rule: op_induct) + case (step usvs x) + have *: "sfoldl\(op'\pat)\([::], pat)\xs = sfoldl\(op\pat)\([::], pat)\xs" + if "lt\(slength\xs)\(slength\(cfst\usvs)) = TT" for xs + using that + proof(induct xs rule: srev_induct) + case (ssnoc x' xs') + from ssnoc(1,2,4) have "lt\(slength\xs')\(slength\(cfst\usvs)) = TT" + using lt_slength_0(2) lt_trans by auto + moreover + from step(2) ssnoc(1,2,4) have "lt\(slength\(cfst\(split\pat\xs')))\(slength\(cfst\usvs)) = TT" + using lt_trans split_length_lt by (auto 10 0) + ultimately show ?case by (simp add: ssnoc.hyps split_sfoldl_op split_snoc_op step) + qed simp_all + from step.prems show ?case + apply (subst op'.unfold) + apply (subst op.unfold) + apply (clarsimp simp: If2_def[symmetric] snull_FF_conv split_sfoldl_op[symmetric] * split: If2_splits) + apply (clarsimp simp: split_sfoldl_op step split_length_lt) + done + qed +qed simp_all + + +subsection\ Step 2: Data refinement and the `K' optimisation \label{sec:KMP:data_refinement} \ + +text\ + +Bird memoises the restart computation in @{const \op'\} in two steps. The first reifies +the control structure of @{const \op'\} into a non-wellfounded tree, which we discuss here. The +second increases the sharing in this tree; see \S\ref{sec:KMP:increase_sharing}. + +Briefly, we cache the @{term \sfoldl\(op'\pat)\([::], pat)\(stail\us :@ [:x:])\} +computation in @{const \op'\} by finding a ``representation'' type @{typ "'t"} +for the ``abstract'' type @{typ \[:'a::Eq_def:] \ [:'a:]\}, a +pair of functions @{term \rep :: [:'a::Eq_def:] \ [:'a:] \ 't\}, +@{term \abs :: 't \ [:'a::Eq_def:] \ [:'a:]\} where @{prop \abs oo rep = ID\}, and then +finding a derived form of @{const \op'\} that works on @{typ "'t"} rather +than @{typ "[:'a::Eq_def:] \ [:'a:]"}. We also take the opportunity to add the `K' optimisation in the form of the @{term \next\} +function. + +As such steps are essentially @{emph \deus ex machina\}, we try to provide some intuition +after showing the new definitions. + +\ + +domain 'a tree \\ Bird p130 \ + = Null + | Node (label :: 'a) (lazy left :: "'a tree") (lazy right :: "'a tree") \\ Strict in the label @{typ "'a"} \ + +(*<*) + +lemma tree_injects'[simp]: \\ An unconditional form of @{thm [source] tree.injects}. \ + "(Node\a\l\r = Node\a'\l'\r') \ (a = a' \ (a \ \ \ l = l' \ r = r'))" +by (cases "a = \"; clarsimp) + +lemma match_Null_match_Node_tree_case: "match_Null\t\k1 +++ match_Node\t\k2 = tree_case\k1\k2\t" +by (cases t) simp_all + +lemma match_Node_mplus_match_Node: "match_Node\x\k1 +++ match_Node\x\k2 = match_Node\x\(\ v l r. k1\v\l\r +++ k2\v\l\r)" +by (cases x; clarsimp) + +lemma tree_case_distr: + "f\\ = \ \ f\(tree_case\g\h\t) = tree_case\(f\g)\(\ x l r. f\(h\x\l\r))\t" + "(tree_case\g'\h'\t)\z = tree_case\(g'\z)\(\ x l r. h'\x\l\r\z)\t" +by (case_tac [!] t) simp_all + +lemma tree_case_cong: + assumes "t = t'" + assumes "t' = Null \ n = n'" + assumes "\v l r. \t' = Node\v\l\r; v \ \\ \ c v l r = c' v l r" + assumes "cont (\(x, y, z). c x y z)" + assumes "cont (\(x, y, z). c' x y z)" + shows "tree_case\n\(\ v l r. c v l r)\t = tree_case\n'\(\ v l r. c' v l r)\t'" +using assms by (cases t; cases t'; clarsimp simp: prod_cont_iff) + +lemma tree_take_smaller: + assumes "tree_take i\t = tree_take i\u" + assumes "j \ i" + shows "tree_take j\t = tree_take j\u" +using assms by (metis min.orderE tree.take_take) + +fixrec tree_map' :: "('a \ 'b) \ 'a tree \ 'b tree" where + "tree_map'\f\Null = Null" +| "a \ \ \ tree_map'\f\(Node\a\l\r) = Node\(f\a)\(tree_map'\f\l)\(tree_map'\f\r)" + +lemma tree_map'_strict[simp]: "tree_map'\f\\ = \" +by fixrec_simp + +lemma tree_map'_ID': "tree_map'\ID\xs = xs" +by (induct xs) simp_all + +lemma tree_map'_ID[simp]: "tree_map'\ID = ID" +by (clarsimp simp: cfun_eq_iff tree_map'_ID') + +lemma tree_map'_strict_scons[simp]: + assumes "f\\ = \" + shows "tree_map'\f\(Node\a\l\r) = Node\(f\a)\(tree_map'\f\l)\(tree_map'\f\r)" +using assms by (cases "a = \"; clarsimp) + +lemma tree_map'_comp'[simp]: + assumes "f\\ = \" + shows "tree_map'\f\(tree_map'\g\t) = tree_map'\(f oo g)\t" +using assms by (induct t) simp_all + +lemma tree_map'_comp[simp]: + assumes "f\\ = \" + shows "tree_map'\f oo tree_map'\g = tree_map'\(f oo g)" +using assms by (clarsimp simp: cfun_eq_iff) + +lemma tree_unique: \\ Adapted from @{cite [cite_macro=citet] "Matthews:1999"} for \emph{contractive functions}. \ + fixes x :: "'a tree" + assumes xfx: "x = f\x" + assumes f: "\i t u. tree_take i\t = tree_take i\u + \ tree_take (Suc i)\(f\t) = tree_take (Suc i)\(f\u)" + shows "x = fix\f" +proof(rule tree.take_lemma) + fix i show "tree_take i\x = tree_take i\(fix\f)" + proof(induct i) + case (Suc i) from xfx f[OF Suc, folded fix_eq] show ?case by simp + qed simp +qed + +(*>*) + +fixrec "next" :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ ([:'a:] \ [:'a:]) tree" where + "next\[::]\t = t" +| "\x \ \; xs \ \\ \ + next\(x :# xs)\Null = Null" +| "\x \ \; xs \ \\ \ + next\(x :# xs)\(Node\(us, [::])\l\r) = Node\(us, [::])\l\r" +| "\v \ \; vs \ \; x \ \; xs \ \\ \ + next\(x :# xs)\(Node\(us, v :# vs)\l\r) = If eq\x\v then l else Node\(us, v :# vs)\l\r" + +fixrec \\ Bird p131 ``an even simpler form'', with the `K' optimisation \ + root2 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op2 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and rep2 :: "[:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +and left2 :: "[:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +and right2 :: "[:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root2\pat = rep2\pat\([::], pat)" +| "op2\pat\Null\x = root2\pat" +| "usvs \ \ \ + op2\pat\(Node\usvs\l\r)\x = If prefix\[:x:]\(csnd\usvs) then r else op2\pat\l\x" +| [simp del]: + "rep2\pat\usvs = Node\usvs\(left2\pat\usvs)\(right2\pat\usvs)" +| "left2\pat\([::], vs) = next\vs\Null" +| "\u \ \; us \ \\ \ + left2\pat\(u :# us, vs) = next\vs\(sfoldl\(op2\pat)\(root2\pat)\us)" \\ Note the use of @{term \op2\} and @{const \next\}. \ +| "right2\pat\(us, [::]) = Null" \\ Unreachable \ +| "\v \ \; vs \ \\ \ + right2\pat\(us, v :# vs) = rep2\pat\(us :@ [:v:], vs)" + +fixrec abs2 :: "([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:]" where + "usvs \ \ \ abs2\(Node\usvs\l\r) = usvs" + +fixrec matches2 :: "[:'a::Eq_def:] \ [:'a:] \ [:Integer:]" where +[simp del]: "matches2\pat = smap\cfst oo sfilter\(snull oo csnd oo abs2 oo csnd) + oo sscanl\(\ (n, x) y. (n + 1, op2\pat\x\y))\(0, root2\pat)" + +text\ + +\begin{figure} + \centering + \begin{tikzpicture}[ + shorten >=1pt, + node distance=1.5cm, + on grid, + auto, + initial text=, + thick, + accepting/.style = {rectangle,minimum size=0.3cm} + ] + \node[state,accepting] (q_0i) {}; + \node[state,initial] (q_0) [right=of q_0i] {$q_0$}; + \node[state] (q_1) [right=of q_0] {$q_1$}; + \node[state] (q_2) [right=of q_1] {$q_2$}; + \node[state] (q_3) [right=of q_2] {$q_3$}; + \node[state] (q_4) [right=of q_3] {$q_4$}; + \node[state,double] (q_5) [right=of q_4] {$q_5$}; + \node[state,accepting] (q_5r) [right=of q_5] {}; + + \path[->] (q_0) edge [bend left] node [above] {0} (q_1) + (q_1) edge [bend left] node [above] {1} (q_2) + (q_2) edge [bend left] node [above] {0} (q_3) + (q_3) edge [bend left] node [above] {0} (q_4) + (q_4) edge [bend left] node [above] {1} (q_5) + (q_5) edge [bend left] node [above] {*} (q_5r); + + \path[->] (q_0) edge [bend right] (q_0i) + (q_1) edge [bend left] (q_0) + (q_2) edge [bend left] (q_0) % MP + (q_2) edge [bend left,color=red] (q_0i) % K opt + (q_3) edge [bend left] (q_1) + (q_4) edge [bend left] (q_1) % MP + (q_4) edge [bend left,color=red] (q_0) % K opt + (q_5) edge [bend left] (q_2); + \end{tikzpicture} + \caption{An example from @{cite [cite_macro=citet] + \\S2.1\ "CrochemoreRytter:2002"}. The MP tree for the + pattern $01001$ is drawn in black: right transitions are labelled + with a symbol, whereas left transitions are unlabelled. The two + `K'-optimised left transitions are shown in red. The boxes denote + @{const \Null\}. The root node is $q_0$.} + \label{fig:example_tree} +\end{figure} + +This tree can be interpreted as a sort of automaton\footnote{@{cite +[cite_macro=citet] \\S3.1\ "Bird:2012"} suggests it can +be thought of as a doubly-linked list, following @{cite +[cite_macro=citet] "TakeichiAkama:1990"}.)}, where @{const +\op2\} goes @{const \right\} if the pattern +continues with the next element of the text, and @{const +\left\} otherwise, to determine how much of a prefix of +the pattern could still be in play. Figure~\ref{fig:example_tree} +visualises such an automaton for the pattern $01001$, used by @{cite +[cite_macro=citet] \\S2.1\ "CrochemoreRytter:2002"} to +illustrate the difference between Morris-Pratt (MP) and +Knuth-Morris-Pratt (KMP) preprocessing as we discuss below. Note that +these are not the classical Mealy machines that correspond to regular +expressions, where all outgoing transitions are labelled with symbols. + +The following lemma shows how our sample automaton is encoded as a non-wellfounded tree. + +\ + +lemma concrete_tree_KMP: + shows "root2\[:0::Integer, 1, 0, 0, 1:] + = (\ q0. Node\([::], [:0, 1, 0, 0, 1:]) + \Null + \(\ q1. Node\([:0:], [:1, 0, 0, 1:]) + \q0 + \(\ q2. Node\([:0,1:], [:0, 0, 1:]) + \Null \\ K optimisation: MP \q0\ \ + \(Node\([:0,1,0:], [:0, 1:]) + \q1 + \(Node\([:0,1,0,0:], [:1:]) + \q0 \\ K optimisation: MP \q1\ \ + \(Node\([:0,1,0,0,1:], [::])\q2\Null))))))" +(is "?lhs = fix\?F") +proof(rule tree_unique) \<^marker>\tag invisible\ + note rep2.simps[simp] + show "?lhs = ?F\?lhs" + apply (subst root2.unfold; simp) + apply (rule tree_unique; simp) + apply (intro conjI) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; fastforce) + apply (rule tree_unique; simp) + apply (intro conjI) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; fastforce) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; simp) + apply (subst (1 2) root2.unfold; fastforce) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; simp) + apply (subst (1) root2.unfold; fastforce) + apply (rename_tac i t u; case_tac i; clarsimp) + apply (rename_tac t u i; case_tac i; clarsimp) + apply (rename_tac t u i; case_tac i; clarsimp) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + apply (rule parallel_fix_ind; simp) + apply (rename_tac i t u x y; case_tac i; clarsimp) + apply (rename_tac i; case_tac i; clarsimp; intro conjI) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + apply (rename_tac i; case_tac i; clarsimp) + apply (rename_tac i; case_tac i; clarsimp) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + done + fix i :: nat + fix t u :: "([:Integer:] \ [:Integer:]) tree" + assume "tree_take i\t = tree_take i\u" + then show "tree_take (Suc i)\(?F\t) = tree_take (Suc i)\(?F\u)" + apply simp + apply (rule parallel_fix_ind; simp) + apply (case_tac i; clarsimp; intro conjI) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + apply (rule parallel_fix_ind; simp) + apply (rename_tac j t0 t1; case_tac j; clarsimp) + apply (rename_tac j; case_tac j; clarsimp; intro conjI) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + apply (rename_tac j; case_tac j; clarsimp; intro conjI) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + apply (rename_tac j; case_tac j; clarsimp) + apply (meson Suc_n_not_le_n linear tree_take_smaller) + done +qed + +text\ + +The sharing that we expect from a lazy (call-by-need) evaluator is here implied by the use of +nested fixed points. + +The KMP preprocessor is expressed by the @{const \left2\} function, where @{const \op2\} is used +to match the pattern against itself; the use of @{const \op2\} in @{const \matches2\} (``the driver'') +is responsible for matching the (preprocessed) pattern against the text. This formally cashes in +an observation by @{cite [cite_macro=citet] \\S5\ "vanderWoude:1989"}, that these two algorithms +are essentially the same, which has eluded other presentations\footnote{For instance, contrast +our shared use of @{const \op2\} with the separated \texttt{match} +and \texttt{rematch} functions of @{cite [cite_macro=citet] \Figure~1\ "AgerDanvyRohde:2006"}.}. + +Bird uses @{const \Null\} on a left path to signal to the driver that it should discard the +current element of the text and restart matching from the beginning of the pattern (i.e, +@{const \root2\}). This is a step towards the removal of @{term \us\} in \S\ref{sec:KMP:step8}. + +Note that the @{const \Null\} at the end of the rightmost path is unreachable: the rightmost +@{const \Node\} has @{term "vs = [::]"} and therefore @{const \op2\} always takes the left branch. + +The `K' optimisation is perhaps best understood by example. Consider +the automaton in Figure~\ref{fig:example_tree}, and a text beginning +with \texttt{011}. Using the MP (black) transitions we take the path +$\rightarrow q_0 \stackrel{{\mathtt{0}}}{\rightarrow} q_1 +\stackrel{\mathtt{1}}{\rightarrow} \overbrace{q_2 \rightarrow q_0 +\rightarrow \Box}$. Now, due to the failure of the comparison of the +current element of the text (\texttt{1}) at $q_2$, we can predict that +the (identical) comparison at node $q_0$ will fail as well, and +therefore have $q_2$ left-branch directly to $\Box$. This saves a +comparison in the driver at the cost of another in the preprocessor +(in @{const \next\}). These optimisations are the red +arrows in the diagram, and can in general save an arbitrary number of +driver comparisons; consider the pattern $\mathtt{1}^n$ for instance. + +More formally, @{const \next\} ensures that the heads of +the suffixes of the pattern (@{term \vs\}) on consecutive +labels on left paths are distinct; see below for a proof of this fact +in our setting, and @{cite [cite_macro=citet] \\S3.3.4\ +"Gusfield:1997"} for a classical account. Unlike Bird's suggestion +(p134), our @{const \next\} function is not recursive. + +We note in passing that while MP only allows \Null\ on +the left of the root node, \Null\ can be on the left of +any KMP node except for the rightmost +(i.e., the one that signals a complete pattern match) where no optimisation is possible. + +We proceed with the formalities of the data refinement. + +\ + +schematic_goal root2_op2_rep2_left2_right2_def: \ \ Obtain the definition of these functions as a single fixed point \ + "( root2 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op2 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , rep2 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , left2 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , right2 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding op2_def root2_def rep2_def left2_def right2_def by simp + +lemma abs2_strict[simp]: + "abs2\\ = \" + "abs2\Null = \" +by fixrec_simp+ + +lemma next_strict[simp]: + "next\\ = \" + "next\xs\\ = \" + "next\(x :# xs)\(Node\(us, \)\l\r) = \" + apply fixrec_simp + apply (cases xs; fixrec_simp; simp) +apply (cases "x = \"; cases "xs = \"; cases "us = \"; fixrec_simp) +done + +lemma next_Null[simp]: + assumes "xs \ \" +shows "next\xs\Null = Null" +using assms by (cases xs) simp_all + +lemma next_snil[simp]: + assumes "xs \ \" + shows "next\xs\(Node\(us, [::])\l\r) = Node\(us, [::])\l\r" +using assms by (cases xs) simp_all + +lemma op2_rep2_left2_right2_strict[simp]: + "op2\pat\\ = \" + "op2\pat\(Node\(us, \)\l\r) = \" + "op2\pat\(Node\usvs\l\r)\\ = \" + "rep2\pat\\ = \" + "left2\pat\(\, vs) = \" + "left2\pat\(us, \) = \" + "right2\pat\(us, \) = \" + apply fixrec_simp + apply (cases "us = \"; fixrec_simp; simp) + apply (cases "usvs = \"; fixrec_simp; simp) + apply fixrec_simp + apply fixrec_simp + apply (cases us; fixrec_simp) +apply fixrec_simp +done + +lemma snd_abs_root2_bottom[simp]: "prod.snd (abs2\(root2\\)) = \" +by (simp add: root2.unfold rep2.unfold) + +lemma abs_rep2_ID'[simp]: "abs2\(rep2\pat\usvs) = usvs" +by (cases "usvs = \"; subst rep2.unfold; clarsimp) + +lemma abs_rep2_ID: "abs2 oo rep2\pat = ID" +by (clarsimp simp: cfun_eq_iff) + +lemma rep2_snoc_right2: \\ Bird p131 \ + assumes "prefix\[:x:]\vs = TT" + shows "rep2\pat\(us :@ [:x:], stail\vs) = right2\pat\(us, vs)" +using assms by (cases "x = \"; cases vs; clarsimp) + +lemma not_prefix_op2_next: + assumes "prefix\[:x:]\xs = FF" + shows "op2\pat\(next\xs\(rep2\pat\usvs))\x = op2\pat\(rep2\pat\usvs)\x" +proof - + obtain us vs where "usvs = (us, vs)" by force + with assms show ?thesis + by (cases xs; cases us; clarsimp; cases vs; + clarsimp simp: rep2.simps prefix_singleton_FF If2_def[symmetric] split: If2_splits) +qed + +text\ + +Bird's appeal to \foldl_fusion\ (p130) is too weak to +justify this data refinement as his condition (iii) requires the +worker functions to coincide on all representation values. Concretely +he asks that: + +\begin{center} + @{prop "rep2\pat\(op\pat\(abs2\t)\x) = op2\pat\t\x"} \\Bird (17.2)\ +\end{center} + +where \t\ is an arbitrary tree. This does not hold for junk representations +such as: + +\begin{center} + @{term \t = Node\(pat, [::])\Null\Null\} +\end{center} + +Using worker/wrapper fusion @{cite [cite_macro=citep] +"GillHutton:2009" and "Gammie:2011"} specialised to @{const +\sscanl\} (@{thm [source] "sscanl_ww_fusion"}) we only +need to establish this identity for valid representations, i.e., when +\t\ lies under the image of \rep2\. In +pictures, we show that this diagram commutes: + +\begin{center} + \begin{tikzcd}[column sep=8em] + usvs \arrow[r, "\\ usvs. op\pat\usvs\x\"] \arrow[d, "\rep2\pat\"] & usvs' \arrow[d, "\rep2\pat\"] \\ + t \arrow[r, "\\ usvs. op2\pat\usvs\x \"] & t' + \end{tikzcd} +\end{center} + +Clearly this result self-composes: after an initial @{term +\rep2\pat\} step, we can repeatedly simulate +@{const \op\} steps with @{const \op2\} steps. + +\ + +lemma op_op2_refinement: + assumes "pat \ \" + shows "rep2\pat\(op\pat\usvs\x) = op2\pat\(rep2\pat\usvs)\x" +proof(cases "x = \" "usvs = \" rule: bool.exhaust[case_product bool.exhaust]) + case False_False + then have "x \ \" "usvs \ \" by simp_all + then show ?thesis + proof(induct usvs arbitrary: x rule: op_induct) + case (step usvs) + obtain us vs where usvs: "usvs = (us, vs)" by fastforce + have *: "sfoldl\(op2\pat)\(root2\pat)\xs = rep2\pat\(split\pat\xs)" if "lt\(slength\xs)\(slength\us) = TT" for xs + using that + proof(induct xs rule: srev_induct) + case (ssnoc x xs) + from ssnoc(1,2,4) have IH: "sfoldl\(op2\pat)\(root2\pat)\xs = rep2\pat\(split\pat\xs)" + by - (rule ssnoc; auto intro: lt_trans dest: lt_slength_0) + obtain us' vs' where us'vs': "split\pat\xs = (us', vs')" by fastforce + from \pat \ \\ ssnoc(1,2,4) usvs show ?case + apply (clarsimp simp: split_sfoldl_op[symmetric] IH) + apply (rule step(1)[simplified abs_rep2_ID', simplified, symmetric]) + using lt_trans split_length_lt split_sfoldl_op apply fastforce+ + done + qed (fastforce simp: \pat \ \\ root2.unfold)+ + have **: "If snull\us then rep2\pat\([::], pat) else rep2\pat\(op\pat\(split\pat\(stail\us))\x) + = op2\pat\(left2\pat\(us, vs))\x" if "prefix\[:x:]\vs = FF" + proof(cases us) + case snil with that show ?thesis + by simp (metis next_Null op2.simps(1) prefix.simps(1) prefix_FF_not_snilD root2.simps) + next + case (scons u' us') + from \pat \ \\ scons have "lt\(slength\(cfst\(split\pat\us')))\(slength\us) = TT" + using split_length_lt by fastforce + from \pat \ \\ \x \ \\ usvs that scons this show ?thesis + by (clarsimp simp: * step(1)[simplified abs_rep2_ID'] not_prefix_op2_next) + qed simp + from \usvs \ \\ usvs show ?case + apply (subst (2) rep2.unfold) + apply (subst op2.unfold) + apply (subst op.unfold) + apply (clarsimp simp: If_distr rep2_snoc_right2 ** cong: If_cong) + done + qed +qed (simp_all add: rep2.unfold) + +text\ + +Therefore the result of this data refinement is extensionally equal to +the specification: + +\ + +lemma data_refinement: + shows "matches = matches2" +proof(intro cfun_eqI) + fix pat xs :: "[:'a:]" show "matches\pat\xs = matches2\pat\xs" + proof(cases "pat = \") + case True then show ?thesis by (cases xs; clarsimp simp: matches2.simps) + next + case False then show ?thesis + unfolding matches2.simps + apply (subst matches_op) \\ Continue with previous derivation. \ + apply (subst sscanl_ww_fusion[where wrap="ID ** abs2" and unwrap="ID ** rep2\pat" and f'="\ (n, x) y. (n + 1, op2\pat\x\y)"]) + apply (simp add: abs_rep2_ID) + apply (simp add: op_op2_refinement) + apply (simp add: oo_assoc sfilter_smap root2.unfold) + apply (simp add: oo_assoc[symmetric]) + done + qed +qed + +text\ + +This computation can be thought of as a pair coroutines with a +producer (@{const \root2\}/@{const \rep2\}) +/ consumer (@{const \op2\}) structure. It turns out that +laziness is not essential (see \S\ref{sec:implementations}), though it +does depend on being able to traverse incompletely defined trees. + +The key difficulty in defining this computation in HOL using present +technology is that @{const \op2\} is neither terminating +nor @{emph \friendly\} in the terminology of @{cite [cite_macro=citet] +"BlanchetteEtAl:2017"}. + +While this representation works for automata with this sort of +structure, it is unclear how general it is; in particular it may not +work so well if @{const \left\} branches can go forward +as well as back. See also the commentary in @{cite [cite_macro=citet] +"HinzeJeuring:2001"}, who observe that sharing is easily lost, and so +it is probably only useful in ``closed'' settings like the present +one, unless the language is extended in unusual ways @{cite +[cite_macro=citep] "JeanninEtAl:2017"}. + +\label{thm:k_property} + +We conclude by proving that @{const \rep2\} produces +trees that have the `K' property, viz that labels on consecutive nodes +on a left path do not start with the same symbol. This also +establishes the productivity of @{const \root2\}. The +pattern of proof used here -- induction nested in coinduction -- +recurs in \S\ref{sec:KMP:increase_sharing}. + +\ + +coinductive K :: "([:'a::Eq:] \ [:'a:]) tree \ bool" where + "K Null" +| "\ usvs \ \; K l; K r; + \v vs. csnd\usvs = v :# vs \ l = Null \ (\v' vs'. csnd\(label\l) = v' :# vs' \ eq\v\v' = FF) + \ \ K (Node\usvs\l\r)" + +declare K.intros[intro!, simp] + +lemma sfoldl_op2_root2_rep2_split: + assumes "pat \ \" + shows "sfoldl\(op2\pat)\(root2\pat)\xs = rep2\pat\(split\pat\xs)" +proof(induct xs rule: srev_induct) + case (ssnoc x xs) with \pat \ \\ ssnoc show ?case by (clarsimp simp: split_sfoldl_op[symmetric] op_op2_refinement) +qed (simp_all add: \pat \ \\ root2.unfold) + +lemma K_rep2: + assumes "pat \ \" + assumes "us :@ vs = pat" + shows "K (rep2\pat\(us, vs))" +using assms +proof(coinduction arbitrary: us vs) + case (K us vs) then show ?case + proof(induct us arbitrary: vs rule: op_induct') + case (step us) + from step.prems have "us \ \" "vs \ \" by auto + show ?case + proof(cases us) + case bottom with \us \ \\ show ?thesis by simp + next + case snil with step.prems show ?thesis by (cases vs; force simp: rep2.simps) + next + case (scons u' us') + from \pat \ \\ scons \us \ \\ \vs \ \\ + obtain usl vsl where splitl: "split\pat\us' = (usl, vsl)" "usl \ \" "vsl \ \" "usl :@ vsl = pat" + by (metis (no_types, hide_lams) Rep_cfun_strict1 prod.collapse sappend_strict sappend_strict2 split_pattern) + from scons obtain l r where r: "rep2\pat\(us, vs) = Node\(us, vs)\l\r" by (simp add: rep2.simps) + moreover + have "(\us vs. l = rep2\pat\(us, vs) \ us :@ vs = pat) \ K l" + proof(cases vs) + case snil with scons splitl r show ?thesis + by (clarsimp simp: rep2.simps sfoldl_op2_root2_rep2_split) + next + case scons + with \pat \ \\ \us = u' :# us'\ \u' \ \\ \us' \ \\ \vs \ \\ r splitl show ?thesis + apply (clarsimp simp: rep2.simps sfoldl_op2_root2_rep2_split) + apply (cases vsl; cases usl; clarsimp simp: If2_def[symmetric] sfoldl_op2_root2_rep2_split split: If2_splits) + apply (rename_tac ul' usl') + apply (cut_tac us'="prod.fst (split\pat\usl')" and vs="prod.snd (split\pat\usl')" in step(1); clarsimp simp: split_pattern) + apply (metis fst_conv lt_trans slength.simps(2) split_length_lt step.prems(1)) + apply (erule disjE; clarsimp simp: sfoldl_op2_root2_rep2_split) + apply (rename_tac b l r) + apply (case_tac b; clarsimp simp: rep2.simps) + apply (auto simp: If2_def[symmetric] rep2.simps dest: split_pattern[rotated] split: If2_splits) + done + qed (simp add: \vs \ \\) + moreover + from \us :@ vs = pat\ \us \ \\ \vs \ \\ r + have "(\usr vsr. r = rep2\pat\(usr, vsr) \ usr :@ vsr = pat) \ K r" + by (cases vs; clarsimp simp: rep2.simps) + moreover + have "l = Null \ (\v' vs'. csnd\(label\l) = v' :# vs' \ eq\v\v' = FF)" if "vs = v :# vs'" for v vs' + proof(cases vsl) + case snil with \us :@ vs = pat\ \us = u' :# us'\ splitl show ?thesis + using split_length_lt[where pat=pat and xs=us'] + by (force elim: slengthE simp: one_Integer_def split: if_splits) + next + case scons + from splitl have "lt\(slength\usl)\(slength\us' + 1) = TT" + by (metis fst_conv fst_strict split_bottom_iff split_length_lt) + with scons \pat \ \\ \us = u' :# us'\ \u' \ \\ \us' \ \\ \vs \ \\ r splitl \vs = v :# vs'\ show ?thesis + using step(1)[OF _ \pat \ \\, where us'="prod.fst (split\pat\us')" and vs="prod.snd (split\pat\us')"] + by (clarsimp simp: rep2.simps sfoldl_op2_root2_rep2_split If2_def[symmetric] split: If2_splits) + qed (simp add: \vsl \ \\) + moreover note \pat \ \\ \us \ \\ \vs \ \\ + ultimately show ?thesis by auto + qed + qed +qed + +theorem K_root2: + assumes "pat \ \" + shows "K (root2\pat)" +using assms unfolding root2.unfold by (simp add: K_rep2) + +text\ + +The remaining steps are as follows: + +\<^item> 3. introduce an accumulating parameter (\grep\). +\<^item> 4. inline \rep\ and simplify. +\<^item> 5. simplify to Bird's ``simpler forms.'' +\<^item> 6. memoise \left\. +\<^item> 7. simplify, unfold \prefix\. +\<^item> 8. discard \us\. +\<^item> 9. factor out \pat\. + +\ + + +subsection\ Step 3: Introduce an accumulating parameter (grep) \ + +text\ + +Next we prepare for the second memoization step (\S\ref{sec:KMP:increase_sharing}) +by introducing an accumulating parameter to @{const \rep2\} that supplies the value of the left +subtree. + +We retain @{const \rep2\} as a wrapper for now, and inline @{const \right2\} to speed up +simplification. + +\ + +fixrec \\ Bird p131 / p132 \ + root3 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op3 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and rep3 :: "[:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +and grep3 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root3\pat = rep3\pat\([::], pat)" +| "op3\pat\Null\x = root3\pat" +| "usvs \ \ \ + op3\pat\(Node\usvs\l\r)\x = If prefix\[:x:]\(csnd\usvs) then r else op3\pat\l\x" +| [simp del]: \\ Inline @{const \left2\}, factor out @{const \next\}. \ + "rep3\pat\usvs = grep3\pat\(case cfst\usvs of [::] \ Null | u :# us \ sfoldl\(op3\pat)\(root3\pat)\us)\usvs" +| [simp del]: \\ @{const \rep2\} with @{const \left2\} abstracted, @{const \right2\} inlined. \ + "grep3\pat\l\usvs = Node\usvs\(next\(csnd\usvs)\l)\(case csnd\usvs of + [::] \ Null + | v :# vs \ rep3\pat\(cfst\usvs :@ [:v:], vs))" + +schematic_goal root3_op3_rep3_grep3_def: + "( root3 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , rep3 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , grep3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding root3_def op3_def rep3_def grep3_def by simp + +lemma r3_2: + "(\ (root, op, rep, grep). (root, op, rep))\ + ( root3 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , rep3 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , grep3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = (\ (root, op, rep, left, right). (root, op, rep))\ + ( root2 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op2 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , rep2 :: [:'a::Eq_def:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , left2 :: [:'a::Eq_def:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , right2 :: [:'a::Eq_def:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree )" +unfolding root2_op2_rep2_left2_right2_def root3_op3_rep3_grep3_def +apply (simp add: match_snil_match_scons_slist_case match_Null_match_Node_tree_case slist_case_distr tree_case_distr) +apply (simp add: fix_cprod fix_const) \\ Very slow. Sensitive to tuple order due to the asymmetry of \fix_cprod\. \ +apply (simp add: slist_case_distr) +done + + +subsection\ Step 4: Inline rep \ + +text\ + +We further simplify by inlining @{const \rep3\} into @{const \root3\} and @{const \grep3\}. + +\ + +fixrec + root4 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op4 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and grep4 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root4\pat = grep4\pat\Null\([::], pat)" +| "op4\pat\Null\x = root4\pat" +| "usvs \ \ \ + op4\pat\(Node\usvs\l\r)\x = If prefix\[:x:]\(csnd\usvs) then r else op4\pat\l\x" +| [simp del]: + "grep4\pat\l\usvs = Node\usvs\(next\(csnd\usvs)\l)\(case csnd\usvs of + [::] \ Null + | v :# vs \ grep4\pat\(case cfst\usvs :@ [:v:] of + [::] \ Null \\ unreachable \ + | u :# us \ sfoldl\(op4\pat)\(root4\pat)\us)\(cfst\usvs :@ [:v:], vs))" + +schematic_goal root4_op4_grep4_def: + "( root4 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op4 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep4 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding root4_def op4_def grep4_def by simp + +lemma fix_syn4_permute: + assumes "cont (\(X1, X2, X3, X4). F1 X1 X2 X3 X4)" + assumes "cont (\(X1, X2, X3, X4). F2 X1 X2 X3 X4)" + assumes "cont (\(X1, X2, X3, X4). F3 X1 X2 X3 X4)" + assumes "cont (\(X1, X2, X3, X4). F4 X1 X2 X3 X4)" + shows "fix_syn (\(X1, X2, X3, X4). (F1 X1 X2 X3 X4, F2 X1 X2 X3 X4, F3 X1 X2 X3 X4, F4 X1 X2 X3 X4)) + = (\(x1, x2, x4, x3). (x1, x2, x3, x4)) + (fix_syn (\(X1, X2, X4, X3). (F1 X1 X2 X3 X4, F2 X1 X2 X3 X4, F4 X1 X2 X3 X4, F3 X1 X2 X3 X4)))" +by (induct rule: parallel_fix_ind) (use assms in \auto simp: prod_cont_iff\) + +lemma r4_3: + "( root4 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op4 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep4 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = (\ (root, op, rep, grep). (root, op, grep))\ + ( root3 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , rep3 :: [:'a:] \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree + , grep3 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree )" +unfolding root3_op3_rep3_grep3_def root4_op4_grep4_def +apply (clarsimp simp: slist_case_distr match_Null_match_Node_tree_case tree_case_distr eta_cfun) +apply (subst fix_syn4_permute; clarsimp simp: fix_cprod fix_const) \\ Slow \ +done + + +subsection\ Step 5: Simplify to Bird's ``simpler forms'' \ + +text\ + +The remainder of @{const \left2\} in @{const \grep4\} can be simplified by transforming the +@{text "case"} scrutinee from @{term "cfst\usvs :@ [:v:]"} into @{term "cfst\usvs"}. + +\ + +fixrec + root5 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op5 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and grep5 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root5\pat = grep5\pat\Null\([::], pat)" +| "op5\pat\Null\x = root5\pat" +| "usvs \ \ \ + op5\pat\(Node\usvs\l\r)\x = If prefix\[:x:]\(csnd\usvs) then r else op5\pat\l\x" +| [simp del]: + "grep5\pat\l\usvs = Node\usvs\(next\(csnd\usvs)\l)\(case csnd\usvs of + [::] \ Null + | v :# vs \ grep5\pat\(case cfst\usvs of \ \ was @{term \cfst\usvs :@ [:v:]\} \ + [::] \ root5\pat + | u :# us \ sfoldl\(op5\pat)\(root5\pat)\(us :@ [:v:]))\(cfst\usvs :@ [:v:], vs))" + +schematic_goal root5_op5_grep5_def: + "( root5 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op5 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep5 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding root5_def op5_def grep5_def by simp + +lemma op5_grep5_strict[simp]: + "op5\pat\\ = \" + "op5\pat\(Node\(us, \)\l\r) = \" + "op5\pat\(Node\usvs\l\r)\\ = \" + "grep5\pat\l\\ = \" + apply fixrec_simp + apply (cases "us = \"; fixrec_simp; simp) + apply (cases "usvs = \"; fixrec_simp; simp) +apply fixrec_simp +done + +lemma r5_4: + "( root5 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op5 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep5 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = ( root4 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op4 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep4 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree )" +unfolding root4_op4_grep4_def root5_op5_grep5_def +by (clarsimp simp: slist_case_distr slist_case_snoc stail_sappend cong: slist_case_cong) + + +subsection\ Step 6: Memoize left \label{sec:KMP:increase_sharing} \ + +text\ + +The last substantial step is to memoise the computation of the left subtrees by tying the knot. + +Note this makes the computation of \us\ in the tree redundant; we remove it in \S\ref{sec:KMP:step8}. + +\ + +fixrec \\ Bird p132 \ + root6 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op6 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and grep6 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root6\pat = grep6\pat\Null\([::], pat)" +| "op6\pat\Null\x = root6\pat" +| "usvs \ \ \ + op6\pat\(Node\usvs\l\r)\x = If prefix\[:x:]\(csnd\usvs) then r else op6\pat\l\x" +| [simp del]: + "grep6\pat\l\usvs = Node\usvs\(next\(csnd\usvs)\l)\(case csnd\usvs of + [::] \ Null + | v :# vs \ grep6\pat\(op6\pat\l\v)\(cfst\usvs :@ [:v:], vs))" + +schematic_goal root6_op6_grep6_def: + "( root6 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op6 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep6 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding root6_def op6_def grep6_def by simp + +lemma op6_grep6_strict[simp]: + "op6\pat\\ = \" + "op6\pat\(Node\(us, \)\l\r) = \" + "op6\pat\(Node\usvs\l\r)\\ = \" + "grep6\pat\l\\ = \" + apply fixrec_simp + apply (cases "us = \"; fixrec_simp; simp) + apply (cases "usvs = \"; fixrec_simp; simp) +apply fixrec_simp +done + +text\ + +Intuitively this step cashes in the fact that, in the context of +@{term \grep6\pat\l\usvs\}, @{term +"sfoldl\(op6\pat)\(root6\pat)\us"} is +equal to @{term \l\}. + +Connecting this step with the previous one is not simply a matter of +equational reasoning; we can see this by observing that the right +subtree of @{term \grep5\pat\l\usvs\} +does not depend on @{term \l\} whereas that of @{term +\grep6\pat\l\usvs\} does, and therefore +these cannot be extensionally equal. Furthermore the computations of +the corresponding @{term \root\}s do not proceed in +lockstep: consider the computation of the left subtree. + +For our purposes it is enough to show that the trees @{const +\root5\} and @{const \root6\} are equal, +from which it follows that @{prop "op6 = op5"} by induction on its +tree argument. The equality is established by exhibiting a @{emph +\tree bisimulation\} (@{const tree_bisim}) that relates +the corresponding ``producer'' \grep\ functions. Such a +relation \R\ must satisfy: + +\<^item> \R \ \\; +\<^item> \R Null Null\; and +\<^item> if \R (Node\x\l\r) (Node\x'\l'\r')\ then \x = x'\, \R l l'\, and \R r r'\. + +\ +text\ + +The following pair of \left\ functions define suitable left +paths from the corresponding @{term \root\}s. + +\ + +fixrec left5 :: "[:'a::Eq_def:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" where + "left5\pat\[::] = Null" +| "\u \ \; us \ \\ \ + left5\pat\(u :# us) = sfoldl\(op5\pat)\(root5\pat)\us" + +fixrec left6 :: "[:'a::Eq_def:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" where + "left6\pat\[::] = Null" +| "\u \ \; us \ \\ \ + left6\pat\(u :# us) = sfoldl\(op6\pat)\(root6\pat)\us" + +inductive \\ This relation is not inductive. \ + root_bisim :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ ([:'a:] \ [:'a:]) tree \ bool" + for pat :: "[:'a:]" +where + bottom: "root_bisim pat \ \" +| Null: "root_bisim pat Null Null" +| gl: "\pat \ \; us \ \; vs \ \\ + \ root_bisim pat (grep6\pat\(left6\pat\us)\(us, vs)) (grep5\pat\(left5\pat\us)\(us, vs))" + +declare root_bisim.intros[intro!, simp] + +lemma left6_left5_strict[simp]: + "left6\pat\\ = \" + "left5\pat\\ = \" +by fixrec_simp+ + +lemma op6_left6: "\us \ \; v \ \\ \ op6\pat\(left6\pat\us)\v = left6\pat\(us :@ [:v:])" +by (cases us) simp_all + +lemma op5_left5: "\us \ \; v \ \\ \ op5\pat\(left5\pat\us)\v = left5\pat\(us :@ [:v:])" +by (cases us) simp_all + +lemma root5_left5: "v \ \ \ root5\pat = left5\pat\[:v:]" +by simp + +lemma op5_sfoldl_left5: "\us \ \; u \ \; v \ \\ \ + op5\pat\(sfoldl\(op5\pat)\(root5\pat)\us)\v = left5\pat\(u :# us :@ [:v:])" +by simp + +lemma root_bisim_root: + assumes "pat \ \" + shows "root_bisim pat (root6\pat) (root5\pat)" +unfolding root6.unfold root5.unfold using assms +by simp (metis (no_types, lifting) left5.simps(1) left6.simps(1) root_bisim.simps slist.con_rews(3)) + +lemma next_grep6_cases[consumes 3, case_names gl nl]: + assumes "vs \ \" + assumes "xs \ \" + assumes "P (next\xs\(grep6\pat\(left6\pat\us)\(us, vs)))" + obtains (gl) "P (grep6\pat\(left6\pat\us)\(us, vs))" | (nl) "P (next\vs\(left6\pat\us))" +using assms +apply atomize_elim +apply (subst grep6.unfold) +apply (subst (asm) grep6.unfold) +apply (cases xs; clarsimp) +apply (cases vs; clarsimp simp: If2_def[symmetric] split: If2_splits) +done + +lemma root_bisim_op_next56: + assumes "root_bisim pat t6 t5" + assumes "prefix\[:x:]\xs = FF" + shows "op6\pat\(next\xs\t6)\x = op6\pat\t6\x \ op5\pat\(next\xs\t5)\x = op5\pat\t5\x" +using \root_bisim pat t6 t5\ +proof cases + case Null with assms(2) show ?thesis by (cases xs) simp_all +next + case (gl us vs) with assms(2) show ?thesis + apply (cases "x = \", simp) + apply (cases xs; clarsimp) + apply (subst (1 2) grep6.simps) + apply (subst (1 2) grep5.simps) + apply (cases vs; clarsimp simp: If2_def[symmetric] split: If2_splits) + done +qed simp + +text\ + +The main part of establishing that @{const \root_bisim\} +is a @{const \tree_bisim\} is in showing that the left +paths constructed by the \grep\s are @{const +\root_bisim\}-related. We do this by inducting over the +length of the pattern so far matched (\us\), as we did +when proving that this tree has the `K' property in +\S\ref{thm:k_property}. + +\ + +lemma + assumes "pat \ \" + shows root_bisim_op: "root_bisim pat t6 t5 \ root_bisim pat (op6\pat\t6\x) (op5\pat\t5\x)" \ \ unused \ + and root_bisim_next_left: "root_bisim pat (next\vs\(left6\pat\us)) (next\vs\(left5\pat\us))" (is "?rbnl us vs") +proof - + let ?ogl5 = "\us vs. op5\pat\(grep5\pat\(left5\pat\us)\(us, vs))\x" + let ?ogl6 = "\us vs. op6\pat\(grep6\pat\(left6\pat\us)\(us, vs))\x" + let ?for5 = "\us. sfoldl\(op5\pat)\(root5\pat)\us" + let ?for6 = "\us. sfoldl\(op6\pat)\(root6\pat)\us" + have "\?ogl6 us vs = Node\usvs\l\r; cfst\usvs \ \; x \ \\ \ le\(slength\(cfst\usvs))\(slength\us + 1) = TT" + and "\op6\pat\(next\xs\(grep6\pat\(left6\pat\us)\(us, vs)))\x = Node\usvs\l\r; cfst\usvs \ \; x \ \; us \ \; vs \ \\ \ le\(slength\(cfst\usvs))\(slength\us + 1) = TT" + and "\?for6 us = Node\usvs\l\r; cfst\usvs \ \\ \ lt\(slength\(cfst\usvs))\(slength\us + 1) = TT" + and "\us \ \; vs \ \\ \ root_bisim pat (?ogl6 us vs) (?ogl5 us vs)" + and "root_bisim pat (?for6 us) (?for5 us)" + and "?rbnl us vs" + for usvs l r xs us vs + proof(induct us arbitrary: usvs l r vs x xs rule: op_induct') + case (step us) + have rbl: "root_bisim pat (left6\pat\us) (left5\pat\us)" + by (cases us; fastforce intro: step(5) simp: left6.unfold left5.unfold) + { case (1 usvs l r vs x) + from rbl + have L: "le\(slength\(prod.fst usvs'))\(slength\us + 1) = TT" + if "op6\pat\(next\vs\(left6\pat\us))\x = Node\usvs'\l\r" + and "cfst\usvs' \ \" + and "vs \ \" + for usvs' l r + proof cases + case bottom with that show ?thesis by simp + next + case Null with that show ?thesis + apply simp + apply (subst (asm) root6.unfold) + apply (subst (asm) grep6.unfold) + apply (fastforce intro: le_plus_1) + done + next + case (gl us'' vs'') show ?thesis + proof(cases us) + case bottom with that show ?thesis by simp + next + case snil with that show ?thesis + apply simp + apply (subst (asm) root6.unfold) + apply (subst (asm) grep6.unfold) + apply clarsimp + done + next + case (scons ush ust) + moreover from that gl scons \x \ \\ have "le\(slength\(cfst\usvs'))\(slength\us'' + 1) = TT" + apply simp + apply (subst (asm) (2) grep6.unfold) + apply (fastforce dest: step(2, 3)[rotated]) + done + moreover from gl scons have "lt\(slength\us'')\(slength\(stail\us) + 1) = TT" + apply simp + apply (subst (asm) grep6.unfold) + apply (fastforce dest: step(3)[rotated]) + done + ultimately show ?thesis + apply clarsimp + apply (metis Integer_le_both_plus_1 Ord_linear_class.le_trans le_iff_lt_or_eq) + done + qed + qed + from 1 show ?case + apply (subst (asm) grep6.unfold) + apply (cases vs; clarsimp simp: If2_def[symmetric] split: If2_splits) + apply (rule L; fastforce) + apply (metis (no_types, lifting) ab_semigroup_add_class.add_ac(1) fst_conv grep6.simps le_refl_Integer sappend_snil_id_right slength.simps(2) slength_bottom_iff slength_sappend slist.con_rews(3) tree_injects') + apply (rule L; fastforce) + done } + note slength_ogl = this + { case (2 usvs l r vs x xs) + from 2 have "xs \ \" by clarsimp + from \vs \ \\ \xs \ \\ 2(1) show ?case + proof(cases rule: next_grep6_cases) + case gl with \cfst\usvs \ \\ \x \ \\ show ?thesis using slength_ogl by blast + next + case nl + from rbl show ?thesis + proof cases + case bottom with nl \cfst\usvs \ \\ show ?thesis by simp + next + case Null with nl \us \ \\ \vs \ \\ show ?thesis + apply simp + apply (subst (asm) root6.unfold) + apply (subst (asm) grep6.unfold) + apply (clarsimp simp: zero_Integer_def one_Integer_def elim!: slengthE) + done + next + case (gl us'' vs'') show ?thesis + proof(cases us) + case bottom with \us \ \\ show ?thesis by simp + next + case snil with gl show ?thesis by (subst (asm) grep6.unfold) simp + next + case (scons u' us') with 2 nl gl show ?thesis + apply clarsimp + apply (subst (asm) (4) grep6.unfold) + apply clarsimp + apply (drule step(3)[rotated]; clarsimp) + apply (drule step(2)[rotated]; clarsimp) + apply (clarsimp simp: lt_le) + apply (metis Integer_le_both_plus_1 Ord_linear_class.le_trans) + done + qed + qed + qed } + { case (3 usvs l r) show ?case + proof(cases us rule: srev_cases) + case snil with 3 show ?thesis + apply (subst (asm) root6.unfold) + apply (subst (asm) grep6.unfold) + apply fastforce + done + next + case (ssnoc u' us') + then have "root_bisim pat (?for6 us') (?for5 us')" by (fastforce intro: step(5)) + then show ?thesis + proof cases + case bottom with 3 ssnoc show ?thesis by simp + next + case Null with 3 ssnoc show ?thesis + apply simp + apply (subst (asm) root6.unfold) + apply (subst (asm) grep6.unfold) + apply (clarsimp simp: zero_Integer_def one_Integer_def elim!: slengthE) + done + next + case (gl us'' vs'') with 3 ssnoc show ?thesis + apply clarsimp + apply (subst (asm) (2) grep6.unfold) + apply (fastforce simp: zero_Integer_def one_Integer_def split: if_splits dest!: step(1)[rotated] step(3)[rotated] elim!: slengthE) + done + qed + qed (use 3 in simp) } + { case (4 vs x) show ?case + proof(cases "prefix\[:x:]\vs") + case bottom then show ?thesis + apply (subst grep6.unfold) + apply (subst grep5.unfold) + apply auto + done + next + case TT with \pat \ \\ \us \ \\ show ?thesis + apply (subst grep6.unfold) + apply (subst grep5.unfold) + apply (cases vs; clarsimp simp: op6_left6) + apply (cases us; clarsimp simp del: left6.simps left5.simps simp add: root5_left5) + apply (metis (no_types, lifting) op5_sfoldl_left5 root5_left5 root_bisim.simps sappend_bottom_iff slist.con_rews(3) slist.con_rews(4)) + done + next + case FF with \pat \ \\ \us \ \\ show ?thesis + apply (subst grep6.unfold) + apply (subst grep5.unfold) + using rbl + apply (auto simp: root_bisim_op_next56 elim!: root_bisim.cases intro: root_bisim_root) + apply (subst (asm) grep6.unfold) + apply (cases us; fastforce dest: step(3)[rotated] intro: step(4)) + done + qed } + { case 5 show ?case + proof(cases us rule: srev_cases) + case (ssnoc u' us') + then have "root_bisim pat (?for6 us') (?for5 us')" by (fastforce intro: step(5)) + then show ?thesis + proof cases + case (gl us'' vs'') with ssnoc show ?thesis + apply clarsimp + apply (subst (asm) grep6.unfold) + apply (fastforce dest: step(3)[rotated] intro: step(4)) + done + qed (use \pat \ \\ ssnoc root_bisim_root in auto) + qed (use \pat \ \\ root_bisim_root in auto) } + { case (6 vs) + from rbl \pat \ \\ show rbnl: "?rbnl us vs" + proof cases + case bottom then show ?thesis by fastforce + next + case Null then show ?thesis by (cases vs) auto + next + case (gl us'' vs'') then show ?thesis + apply clarsimp + apply (subst grep5.unfold) + apply (subst grep6.unfold) + apply (subst (asm) grep5.unfold) + apply (subst (asm) grep6.unfold) + apply (cases us; clarsimp; cases vs''; clarsimp) + apply (metis Rep_cfun_strict1 bottom left5.simps(2) left6.simps(2) next_snil next_strict(1) rbl) + apply (cases vs; clarsimp) + using rbl apply (fastforce dest: step(3)[rotated] intro: step(6) simp: If2_def[symmetric] simp del: eq_FF split: If2_splits)+ + done + qed } + qed + from \pat \ \\ this(4) show "root_bisim pat t6 t5 \ root_bisim pat (op6\pat\t6\x) (op5\pat\t5\x)" + by (auto elim!: root_bisim.cases intro: root_bisim_root) + show \root_bisim pat (next\vs\(left6\pat\us)) (next\vs\(left5\pat\us))\ by fact +qed + +text\ + +With this result in hand the remainder is technically fiddly but straightforward. + +\ + +lemmas tree_bisimI = iffD2[OF fun_cong[OF tree.bisim_def[unfolded atomize_eq]], rule_format] + +lemma tree_bisim_root_bisim: + shows "tree_bisim (root_bisim pat)" +proof(rule tree_bisimI, erule root_bisim.cases, goal_cases bottom Null Node) + case (Node x y us vs) then show ?case + apply (subst (asm) grep5.unfold) + apply (subst (asm) grep6.unfold) + apply hypsubst_thin + apply (clarsimp simp: root_bisim_next_left) + apply (cases vs; clarsimp) + apply (cases us; clarsimp simp del: left6.simps left5.simps simp add: op5_sfoldl_left5 op6_left6) + apply (metis (no_types, lifting) root5_left5 root_bisim.simps slist.con_rews(3,4)) + apply (metis (no_types, lifting) op5_sfoldl_left5 root_bisim.simps sappend_bottom_iff slist.con_rews(3, 4)) + done +qed simp_all + +lemma r6_5: + shows "(root6\pat, op6\pat) = (root5\pat, op5\pat)" +proof(cases "pat = \") + case True + from True have "root6\pat = root5\pat" + apply (subst root6.unfold) + apply (subst grep6.unfold) + apply (subst root5.unfold) + apply (subst grep5.unfold) + apply simp + done + moreover + from True \root6\pat = root5\pat\ have "op6\pat\t\x = op5\pat\t\x" for t x + by (induct t) simp_all + ultimately show ?thesis by (simp add: cfun_eq_iff) +next + case False + then have root: "root6\pat = root5\pat" + by (rule tree.coinduct[OF tree_bisim_root_bisim root_bisim_root]) + moreover + from root have "op6\pat\t\x = op5\pat\t\x" for t x by (induct t) simp_all + ultimately show ?thesis by (simp add: cfun_eq_iff) +qed + +text\ + +We conclude this section by observing that accumulator-introduction is a well known technique +(see, for instance, @{cite [cite_macro=citet] \\S13.6\ "Hutton:2016"}), but the examples in the +literature assume that the type involved is defined inductively. Bird adopts this strategy without +considering what the mixed inductive/coinductive rule is that justifies the preservation of total +correctness. + +The difficulty of this step is why we wired in the `K' opt earlier: it allows us to preserve the +shape of the tree all the way from the data refinement to the final version. + +\ + + +subsection\ Step 7: Simplify, unfold prefix \ + +text\ + +The next step (Bird, bottom of p132) is to move the case split in @{const \grep6\} on \vs\ above the +\Node\ constructor, which makes @{term \grep7\} strict in that parameter and therefore not +extensionally equal to @{const \grep6\}. We establish a weaker correspondence using fixed-point induction. + +We also unfold @{const \prefix\} in @{const \op6\}. + +\ + +fixrec + root7 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree" +and op7 :: "[:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree" +and grep7 :: "[:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree" +where + [simp del]: + "root7\pat = grep7\pat\Null\([::], pat)" +| "op7\pat\Null\x = root7\pat" +| "op7\pat\(Node\(us, [::])\l\r)\x = op7\pat\l\x" \\ Unfold \prefix\ \ +| "\v \ \; vs \ \\ \ + op7\pat\(Node\(us, v :# vs)\l\r)\x = If eq\x\v then r else op7\pat\l\x" +| [simp del]: + "grep7\pat\l\(us, [::]) = Node\(us, [::])\l\Null" \\ Case split on \vs\ hoisted above \Node\. \ +| "\v \ \; vs \ \\ \ + grep7\pat\l\(us, v :# vs) = Node\(us, v :# vs)\(next\(v :# vs)\l)\(grep7\pat\(op7\pat\l\v)\(us :@ [:v:], vs))" + +schematic_goal root7_op7_grep7_def: + "( root7 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op7 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep7 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = fix\?F" +unfolding root7_def op7_def grep7_def by simp + +lemma r7_6_aux: + assumes "pat \ \" + shows + "(\ (root, op, grep). (root\pat, seq\x\(op\pat\t\x), grep\pat\l\(us, vs)))\ + ( root7 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op7 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep7 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree ) + = (\ (root, op, grep). (root\pat, seq\x\(op\pat\t\x), seq\vs\(grep\pat\l\(us, vs))))\ + ( root6 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree + , op6 :: [:'a::Eq_def:] \ ([:'a:] \ [:'a:]) tree \ 'a \ ([:'a:] \ [:'a:]) tree + , grep6 :: [:'a:] \ ([:'a:] \ [:'a:]) tree \ [:'a:] \ [:'a:] \ ([:'a:] \ [:'a:]) tree )" +unfolding root6_op6_grep6_def root7_op7_grep7_def +proof(induct arbitrary: t x l us vs rule: parallel_fix_ind[case_names adm bottom step]) + case (step X Y t x l us vs) then show ?case + apply - + apply (cases X, cases Y) + apply (rename_tac r10 o10 g10 r9 o9 g9) + apply (clarsimp simp: cfun_eq_iff assms match_Node_mplus_match_Node match_Null_match_Node_tree_case tree_case_distr match_snil_match_scons_slist_case slist_case_distr If_distr) + apply (intro allI conjI) + apply (case_tac t; clarsimp) + apply (rename_tac us vs l r) + apply (case_tac "x = \"; clarsimp) + apply (case_tac vs; clarsimp; fail) + apply (case_tac vs; clarsimp) + apply (metis ID1 seq_simps(3)) + done +qed simp_all + +lemma r7_6: + assumes "pat \ \" + shows "root7\pat = root6\pat" + and "x \ \ \ op7\pat\t\x = op6\pat\t\x" +using r7_6_aux[OF assms] by (force simp: cfun_eq_iff dest: spec[where x=x])+ + + +subsection\ Step 8: Discard us \label{sec:KMP:step8} \ + +text\ + +We now discard \us\ from the tree as it is no longer used. This requires a new +definition of @{const \next\}. + +This is essentially another data refinement. + +\ + +fixrec next' :: "'a::Eq_def \ [:'a:] tree \ [:'a:] tree" where + "next'\x\Null = Null" +| "next'\x\(Node\[::]\l\r) = Node\[::]\l\r" +| "\v \ \; vs \ \; x \ \\ \ + next'\x\(Node\(v :# vs)\l\r) = If eq\x\v then l else Node\(v :# vs)\l\r" + +fixrec \\ Bird p133 \ + root8 :: "[:'a::Eq_def:] \ [:'a:] tree" +and op8 :: "[:'a:] \ [:'a:] tree \ 'a \ [:'a:] tree" +and grep8 :: "[:'a:] \ [:'a:] tree \ [:'a:] \ [:'a:] tree" +where +[simp del]: + "root8\pat = grep8\pat\Null\pat" +| "op8\pat\Null\x = root8\pat" +| "op8\pat\(Node\[::]\l\r)\x = op8\pat\l\x" +| "\v \ \; vs \ \\ \ + op8\pat\(Node\(v :# vs)\l\r)\x = If eq\x\v then r else op8\pat\l\x" +| "grep8\pat\l\[::] = Node\[::]\l\Null" +| "\v \ \; vs \ \\ \ + grep8\pat\l\(v :# vs) = Node\(v :# vs)\(next'\v\l)\(grep8\pat\(op8\pat\l\v)\vs)" + +fixrec ok8 :: "[:'a:] tree \ tr" where + "vs \ \ \ ok8\(Node\vs\l\r) = snull\vs" + +schematic_goal root8_op8_grep8_def: + "( root8 :: [:'a::Eq_def:] \ [:'a:] tree + , op8 :: [:'a:] \ [:'a:] tree \ 'a \ [:'a:] tree + , grep8 :: [:'a:] \ [:'a:] tree \ [:'a:] \ [:'a:] tree ) + = fix\?F" +unfolding op8_def root8_def grep8_def by simp + +lemma next'_strict[simp]: + "next'\x\\ = \" + "next'\\\(Node\(v :# vs)\l\r) = \" +by (cases "v :# vs = \"; fixrec_simp; clarsimp)+ + +lemma root8_op8_grep8_strict[simp]: + "grep8\pat\l\\ = \" + "op8\pat\\ = \" + "root8\\ = \" +by fixrec_simp+ + +lemma ok8_strict[simp]: + "ok8\\ = \" + "ok8\Null = \" +by fixrec_simp+ + +text\ + +We cannot readily relate @{const \next\} and @{const +\next'\} using worker/wrapper as the obvious abstraction +is not invertible. Conversely the desired result is easily shown by +fixed-point induction. + +\ + +lemma next'_next: + assumes "v \ \" + assumes "vs \ \" + shows "next'\v\(tree_map'\csnd\t) = tree_map'\csnd\(next\(v :# vs)\t)" +proof(induct t) + case (Node usvs' l r) with assms show ?case + apply (cases usvs'; clarsimp) + apply (rename_tac us'' vs'') + apply (case_tac vs''; clarsimp simp: If_distr) + done +qed (use assms in simp_all) + +lemma r8_7[simplified]: + shows "(\ (root, op, grep). ( root\pat + , op\pat\(tree_map'\csnd\t)\x + , grep\pat\(tree_map'\csnd\l)\(csnd\usvs)))\(root8, op8, grep8) + = (\ (root, op, grep). ( tree_map'\csnd\(root\pat) + , tree_map'\csnd\(op\pat\t\x) + , tree_map'\csnd\(grep\pat\l\usvs)))\(root7, op7, grep7)" +unfolding root7_op7_grep7_def root8_op8_grep8_def +proof(induct arbitrary: l t usvs x rule: parallel_fix_ind[case_names adm bottom step]) + case (step X Y l t usvs x) then show ?case + apply - + apply (cases X; cases Y) + apply (clarsimp simp: cfun_eq_iff next'_next + match_snil_match_scons_slist_case slist_case_distr + match_Node_mplus_match_Node match_Null_match_Node_tree_case tree_case_distr + cong: slist_case_cong) + apply (cases t; clarsimp simp: If_distr) + apply (rename_tac us vs l r) + apply (case_tac vs; fastforce) + done +qed simp_all + +text\ + +Top-level equivalence follows from \lfp_fusion\ specialized to \sscanl\ (@{thm [source] +"sscanl_lfp_fusion"}), which states that +\begin{center} + @{prop \smap\g oo sscanl\f\z = sscanl\f'\(g\z)\} +\end{center} +provided that \g\ is strict and the following diagram commutes for @{prop \x \ \\}: + +\begin{center} + \begin{tikzcd}[column sep=6em] + a \arrow[r, "\\ a. f\a\x\"] \arrow[d, "\g\"] & a' \arrow[d, "\g\"] \\ + b \arrow[r, "\\ a. f'\a\x\"] & b' + \end{tikzcd} +\end{center} + +\ + +lemma ok8_ok8: "ok8 oo tree_map'\csnd = snull oo csnd oo abs2" (is "?lhs = ?rhs") +proof(rule cfun_eqI) + fix t show "?lhs\t = ?rhs\t" + by (cases t; clarsimp) (metis ok8.simps ok8_strict(1) snull_strict tree.con_rews(3)) +qed + +lemma matches8: \\ Bird p133 \ + shows "matches\pat = smap\cfst oo sfilter\(ok8 oo csnd) oo sscanl\(\ (n, x) y. (n + 1, op8\pat\x\y))\(0, root8\pat)" (is "?lhs = ?rhs") +proof(cases "pat = \") + case True + then have "?lhs\xs = ?rhs\xs" for xs by (cases xs; clarsimp) + then show ?thesis by (simp add: cfun_eq_iff) +next + case False + then have *: "matches\pat = smap\cfst oo sfilter\(snull oo csnd oo abs2 oo csnd) oo sscanl\(\ (n, x) y. (n + 1, op7\pat\x\y))\(0, root7\pat)" + using data_refinement[where 'a='a] r3_2[where 'a='a] r4_3[where 'a='a] r5_4[where 'a='a] r6_5(1)[where pat=pat] r7_6[where pat=pat] + unfolding matches2.unfold by (fastforce simp: oo_assoc cfun_eq_iff csplit_def intro!: cfun_arg_cong sscanl_cong) + from \pat \ \\ show ?thesis + apply - + apply (subst conjunct1[OF r8_7]) + apply (subst sscanl_lfp_fusion[where g="ID ** tree_map'\csnd" and z="(0, root7\pat)", simplified, symmetric]) + prefer 2 + apply (subst oo_assoc, subst sfilter_smap, simp) + apply (simp add: oo_assoc) + apply (simp add: oo_assoc[symmetric]) + apply (subst oo_assoc, subst ok8_ok8) + apply (clarsimp simp: oo_assoc *) + apply (rule refl) (* instantiate schematic *) + apply (clarsimp simp: r8_7) + done +qed + + +subsection\ Step 9: Factor out pat (final version) \label{sec:KMP:final_version} \ + +text\ + +Finally we factor @{term \pat\} from these definitions and arrive +at Bird's cyclic data structure, which when executed using lazy +evaluation actually memoises the computation of @{const \grep8\}. + +The \Letrec\ syntax groups recursive bindings with +\,\ and separates these with \;\. Its lack +of support for clausal definitions, and that \texttt{HOLCF} +\case\ does not support nested patterns, leads to some +awkwardness. + +\ + +fixrec matchesf :: "[:'a::Eq_def:] \ [:'a:] \ [:Integer:]" where +[simp del]: "matchesf\pat = + (Letrec okf = (\ (Node\vs\l\r). snull\vs); + nextf = (\ x t. case t of + Null \ Null + | Node\vs\l\r \ (case vs of + [::] \ t + | v :# vs \ If eq\x\v then l else t)); + rootf = grepf\Null\pat, + opf = (\ t x. case t of + Null \ rootf + | Node\vs\l\r \ (case vs of + [::] \ opf\l\x + | v :# vs \ If eq\x\v then r else opf\l\x)), + grepf = (\ l vs. case vs of + [::] \ Node\[::]\l\Null + | v :# vs \ Node\(v :# vs)\(nextf\v\l)\(grepf\(opf\l\v)\vs)); + stepf = (\ (n, t) x. (n + 1, opf\t\x)) + in smap\cfst oo sfilter\(okf oo csnd) oo sscanl\stepf\(0, rootf))" + +lemma matchesf_ok8: "(\ (Node\vs\l\r). snull\vs) = ok8" +by (clarsimp simp: cfun_eq_iff; rename_tac x; case_tac x; clarsimp) + +lemma matchesf_next': + "(\ x t. case t of Null \ Null | Node\vs\l\r \ (case vs of [::] \ t | v :# vs \ If eq\x\v then l else t)) = next'" +apply (clarsimp simp: cfun_eq_iff next'.unfold + match_snil_match_scons_slist_case slist_case_distr + match_Node_mplus_match_Node match_Null_match_Node_tree_case tree_case_distr) +apply (simp cong: tree_case_cong) +apply (simp cong: slist_case_cong) +done + +lemma matchesf_8: + "fix\(\ (Rootf, Opf, Grepf). + ( Grepf\Null\pat + , \ t x. case t of Null \ Rootf | Node\vs\l\r \ + (case vs of [::] \ Opf\l\x | v :# vs \ If eq\x\v then r else Opf\l\x) + , \ l vs. case vs of [::] \ Node\[::]\l\Null | v :# vs \ Node\(v :# vs)\(next'\v\l)\(Grepf\(Opf\l\v)\vs)) ) += (\ (root, op, grep). (root\pat, op\pat, grep\pat))\(root8, op8, grep8)" +unfolding root8_op8_grep8_def +by (rule lfp_fusion[symmetric]) + (fastforce simp: cfun_eq_iff + match_snil_match_scons_slist_case slist_case_distr + match_Node_mplus_match_Node match_Null_match_Node_tree_case tree_case_distr)+ + +theorem matches_final: + shows "matches = matchesf" +by (clarsimp simp: cfun_eq_iff fix_const eta_cfun csplit_cfun3 CLetrec_def + matches8 matchesf.unfold matchesf_next' matchesf_ok8 matchesf_8[simplified eta_cfun]) + +text\ + +The final program above is easily syntactically translated into the +Haskell shown in Figure~\ref{fig:haskell-kmp}, and one can expect +GHC's list fusion machinery to compile the top-level driver into an +efficient loop. @{cite [cite_macro=citet] "LochbihlerMaximova:2015"} +have mechanised this optimisation for Isabelle/HOL's code generator +(and see also @{cite [cite_macro=citet] "Huffman:2009"}). + +As we lack both pieces of infrastructure we show such a fusion is sound +by hand. + +\ + +lemma fused_driver': + assumes "g\\ = \" + assumes "p\\ = \" + shows "smap\g oo sfilter\p oo sscanl\f\z + = (\ R. \ z xxs. case xxs of + [::] \ If p\z then [:g\z:] else [::] + | x :# xs \ let z' = f\z\x in If p\z then g\z :# R\z'\xs else R\z'\xs)\z" +(is "?lhs = ?rhs") +proof(rule cfun_eqI) + fix xs from assms show "?lhs\xs = ?rhs\xs" + by (induct xs arbitrary: z) (subst fix_eq; fastforce simp: If_distr Let_def)+ +qed + +(*<*) + +end +(*>*) diff --git a/thys/BirdKMP/ROOT b/thys/BirdKMP/ROOT new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/ROOT @@ -0,0 +1,14 @@ +chapter AFP + +session BirdKMP (AFP) = "HOLCF-Prelude" + + options [timeout=600] + theories + HOLCF_ROOT + Theory_Of_Lists + KMP + document_files + "root.bib" + "root.tex" + "programs/KMP.hs" + "programs/KMP.pl" + "programs/KMP.sml" diff --git a/thys/BirdKMP/Theory_Of_Lists.thy b/thys/BirdKMP/Theory_Of_Lists.thy new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/Theory_Of_Lists.thy @@ -0,0 +1,1243 @@ +(*<*) +theory Theory_Of_Lists +imports + HOLCF_ROOT +begin + +(*>*) +section\ Strict lists \label{sec:theory_of_lists} \ + +text\ + +Head- and tail-strict lists. Many technical Isabelle details are +lifted from \HOLCF-Prelude.Data_List\; names follow +HOL, prefixed with \s\. + +\ + +domain 'a slist ("[:_:]") = + snil ("[::]") +| scons (shead :: "'a") (stail :: "'a slist") (infixr ":#" 65) + +lemma scons_strict[simp]: "scons\\ = \" +by (clarsimp simp: cfun_eq_iff) + +lemma shead_bottom_iff[simp]: "(shead\xs = \) \ (xs = \ \ xs = [::])" +by (cases xs) simp_all + +lemma stail_bottom_iff[simp]: "(stail\xs = \) \ (xs = \ \ xs = [::])" +by (cases xs) simp_all + +lemma match_snil_match_scons_slist_case: "match_snil\xs\k1 +++ match_scons\xs\k2 = slist_case\k1\k2\xs" +by (cases xs) simp_all + +lemma slist_bottom': "slist_case\\\\\xs = \" +by (cases xs; simp) + +lemma slist_bottom[simp]: "slist_case\\\\ = \" +by (simp add: cfun_eq_iff slist_bottom') + +lemma slist_case_distr: + "f\\ = \ \ f\(slist_case\g\h\xs) = slist_case\(f\g)\(\ x xs. f\(h\x\xs))\xs" + "slist_case\g'\h'\xs\z = slist_case\(g'\z)\(\ x xs. h'\x\xs\z)\xs" +by (case_tac [!] xs) simp_all + +lemma slist_case_cong: + assumes "xs = xs'" + assumes "xs' = [::] \ n = n'" + assumes "\y ys. \xs' = y :# ys; y \ \; ys \ \\ \ c y ys = c' y ys" + assumes "cont (\(x, y). c x y)" + assumes "cont (\(x, y). c' x y)" + shows "slist_case\n\(\ x xs. c x xs)\xs = slist_case\n'\(\ x xs. c' x xs)\xs'" +using assms by (cases xs; cases xs'; clarsimp simp: prod_cont_iff) + + +text\ + +Section syntax for @{const \scons\} ala Haskell. + +\ + +syntax + "_scons_section" :: "'a \ [:'a:] \ [:'a:]" ("'(:#')") + "_scons_section_left" :: "'a \ [:'a:] \ [:'a:]" ("'(_:#')") +translations + "(x:#)" == "(CONST Rep_cfun) (CONST scons) x" + +abbreviation scons_section_right :: "[:'a:] \ 'a \ [:'a:]" ("'(:#_')") where + "(:#xs) \ \ x. x :# xs" + +syntax + "_strict_list" :: "args \ [:'a:]" ("[:(_):]") +translations + "[:x, xs:]" == "x :# [:xs:]" + "[:x:]" == "x :# [::]" + + +text\ + +Class instances. + +\ + +instantiation slist :: (Eq) Eq_strict +begin + +fixrec eq_slist :: "[:'a:] \ [:'a:] \ tr" where + "eq_slist\[::]\[::] = TT" +| "\x \ \; xs \ \\ \ eq_slist\(x :# xs)\[::] = FF" +| "\y \ \; ys \ \\ \ eq_slist\[::]\(y :# ys) = FF" +| "\x \ \; xs \ \; y \ \; ys \ \\ \ eq_slist\(x :# xs)\(y :# ys) = (eq\x\y andalso eq_slist\xs\ys)" + +instance proof + fix xs :: "[:'a:]" + show "eq\xs\\ = \" + by (cases xs) (subst eq_slist.unfold; simp)+ + show "eq\\\xs = \" + by (cases xs) (subst eq_slist.unfold; simp)+ +qed + +end + +instance slist :: (Eq_sym) Eq_sym +proof + fix xs ys :: "[:'a:]" + show "eq\xs\ys = eq\ys\xs" + proof (induct xs arbitrary: ys) + case snil + show ?case by (cases ys; simp) + next + case scons + then show ?case by (cases ys; simp add: eq_sym) + qed simp_all +qed + +instance slist :: (Eq_equiv) Eq_equiv +proof + fix xs ys zs :: "[:'a:]" + show "eq\xs\xs \ FF" + by (induct xs) simp_all + assume "eq\xs\ys = TT" and "eq\ys\zs = TT" then show "eq\xs\zs = TT" + proof (induct xs arbitrary: ys zs) + case (snil ys zs) then show ?case by (cases ys, simp_all) + next + case (scons x xs ys zs) with eq_trans show ?case + by (cases ys; cases zs) auto + qed simp_all +qed + +instance slist :: (Eq_eq) Eq_eq +proof + fix xs ys :: "[:'a:]" + show "eq\xs\xs \ FF" + by (induct xs) simp_all + assume "eq\xs\ys = TT" then show "xs = ys" + proof (induct xs arbitrary: ys) + case (snil ys) then show ?case by (cases ys) simp_all + next + case (scons x xs ys) then show ?case by (cases ys) auto + qed simp +qed + +instance slist :: (Eq_def) Eq_def +proof + fix xs ys :: "[:'a:]" + assume "xs \ \" and "ys \ \" + then show "eq\xs\ys \ \" + proof(induct xs arbitrary: ys) + case (snil ys) then show ?case by (cases ys) simp_all + next + case (scons a xs) then show ?case by (cases ys) simp_all + qed simp +qed + +lemma slist_eq_TT_snil[simp]: + fixes xs :: "[:'a::Eq:]" + shows "(eq\xs\[::] = TT) \ (xs = [::])" + "(eq\[::]\xs = TT) \ (xs = [::])" +by (cases xs; simp)+ + +lemma slist_eq_FF_snil[simp]: + fixes xs :: "[:'a::Eq:]" + shows "(eq\xs\[::] = FF) \ (\y ys. y \ \ \ ys \ \ \ xs = y :# ys)" + "(eq\[::]\xs = FF) \ (\y ys. y \ \ \ ys \ \ \ xs = y :# ys)" +by (cases xs; force)+ + + +subsection\ Some of the usual reasoning infrastructure \ + +inductive slistmem :: "'a \ [:'a:] \ bool" where + "\x \ \; xs \ \\ \ slistmem x (x :# xs)" +| "\slistmem x xs; y \ \\ \ slistmem x (y :# xs)" + +lemma slistmem_bottom1[iff]: + fixes x :: "'a" + shows "\ slistmem x \" +by rule (induct x "\::[:'a:]" rule: slistmem.induct; fastforce) + +lemma slistmem_bottom2[iff]: + fixes xs :: "[:'a:]" + shows "\ slistmem \ xs" +by rule (induct "\::'a" xs rule: slistmem.induct; fastforce) + +lemma slistmem_nil[iff]: + shows "\ slistmem x [::]" +by (fastforce elim: slistmem.cases) + +lemma slistmem_scons[simp]: + shows "slistmem x (y :# ys) \ (x = y \ x \ \ \ ys \ \) \ (slistmem x ys \ y \ \)" +proof - + have "x = y \ slistmem x ys" if "slistmem x (y :# ys)" + using that by (induct "x" "y :# ys" arbitrary: y ys rule: slistmem.induct; force) + then show ?thesis by (auto elim: slistmem.cases intro: slistmem.intros) +qed + +definition sset :: "[:'a:] \ 'a set" where + "sset xs = {x. slistmem x xs}" + +lemma sset_simp[simp]: + shows "sset \ = {}" + and "sset [::] = {}" + and "\x \ \; xs \ \\ \ sset (x :# xs) = insert x (sset xs)" +unfolding sset_def by (auto elim: slistmem.cases intro: slistmem.intros) + +lemma sset_defined[simp]: + assumes "x \ sset xs" + shows "x \ \" +using assms sset_def by force + +lemma sset_below: + assumes "y \ sset ys" + assumes "xs \ ys" + assumes "xs \ \" + obtains x where "x \ sset xs" and "x \ y" +using assms +proof(induct ys arbitrary: xs) + case (scons y ys xs) then show ?case by (cases xs) auto +qed simp_all + + +subsection\ Some of the usual operations \ + +text\ + +A variety of functions on lists. Drawn from @{cite [cite_macro=citet] +"Bird:1987"}, @{theory \HOL.List\} and +@{theory \HOLCF-Prelude.Data_List\}. The definitions vary because, +for instance, the strictness of some of those in +@{theory \HOLCF-Prelude.Data_List\} correspond neither to those in +Haskell nor Bird's expectations (specifically \stails\, +\inits\, \sscanl\). + +\ + +fixrec snull :: "[:'a:] \ tr" where + "snull\[::] = TT" +| "\x \ \; xs \ \\ \ snull\(x :# xs) = FF" + +lemma snull_strict[simp]: "snull\\ = \" +by fixrec_simp + +lemma snull_bottom_iff[simp]: "(snull\xs = \) \ (xs = \)" +by (cases xs) simp_all + +lemma snull_FF_conv: "(snull\xxs = FF) \ (\x xs. xxs \ \ \ xxs = x :# xs)" +by (cases xxs) simp_all + +lemma snull_TT_conv[simp]: "(snull\xs = TT) \ (xs = [::])" +by (cases xs) simp_all + +lemma snull_eq_snil: "snull\xs = eq\xs\[::]" +by (cases xs) simp_all + +fixrec smap :: "('a \ 'b) \ [:'a:] \ [:'b:]" where + "smap\f\[::] = [::]" +| "\x \\; xs \ \\ \ smap\f\(x :# xs) = f\x :# smap\f\xs" + +lemma smap_strict[simp]: "smap\f\\ = \" +by fixrec_simp + +lemma smap_bottom_iff[simp]: "(smap\f\xs = \) \ (xs = \ \ (\x\sset xs. f\x = \))" +by (induct xs) simp_all + +lemma smap_is_snil_conv[simp]: + "(smap\f\xs = [::]) \ (xs = [::])" + "( [::] = smap\f\xs) \ (xs = [::])" +by (cases xs; simp)+ + +lemma smap_strict_scons[simp]: + assumes "f\\ = \" + shows "smap\f\(x :# xs) = f\x :# smap\f\xs" +using assms by (cases "x :# xs = \"; fastforce) + +lemma smap_ID': "smap\ID\xs = xs" +by (induct xs) simp_all + +lemma smap_ID[simp]: "smap\ID = ID" +by (clarsimp simp: cfun_eq_iff smap_ID') + +lemma smap_cong: + assumes "xs = xs'" + assumes "\x. x \ sset xs \ f\x = f'\x" + shows "smap\f\xs = smap\f'\xs'" +using assms by (induct xs arbitrary: xs') auto + +lemma smap_smap'[simp]: + assumes "f\\ = \" + shows "smap\f\(smap\g\xs) = smap\(f oo g)\xs" +using assms by (induct xs) simp_all + +lemma smap_smap[simp]: + assumes "f\\ = \" + shows "smap\f oo smap\g = smap\(f oo g)" +using assms by (clarsimp simp: cfun_eq_iff) + +lemma sset_smap[simp]: + assumes "\x. x \ sset xs \ f\x \ \" + shows "sset (smap\f\xs) = { f\x | x. x \ sset xs }" +using assms by (induct xs) auto + +lemma shead_smap_distr: + assumes "f\\ = \" + assumes "\x. x\sset xs \ f\x \ \" + shows "shead\(smap\f\xs) = f\(shead\xs)" +using assms by (induct xs) simp_all + +fixrec sappend :: "[:'a:] \ [:'a:] \ [:'a:]" where + "sappend\[::]\ys = ys" +| "\x \ \; xs \ \\ \ sappend\(x :# xs)\ys = x :# sappend\xs\ys" + +abbreviation sappend_syn :: "'a slist \ 'a slist \ 'a slist" (infixr ":@" 65) where + "xs :@ ys \ sappend\xs\ys" + +lemma sappend_strict[simp]: "sappend\\ = \" +by fixrec_simp + +lemma sappend_strict2[simp]: "xs :@ \ = \" +by (induct xs) simp_all + +lemma sappend_bottom_iff[simp]: "(xs :@ ys = \) \ (xs = \ \ ys = \)" +by (induct xs) simp_all + +lemma sappend_scons[simp]: "(x :# xs) :@ ys = x :# xs :@ ys" +by (cases "x :# xs = \"; fastforce) + +lemma sappend_assoc[simp]: "(xs :@ ys) :@ zs = xs :@ (ys :@ zs)" +by (induct xs) simp_all + +lemma sappend_snil_id_left[simp]: "sappend\[::] = ID" +by (simp add: cfun_eq_iff) + +lemma sappend_snil_id_right[iff]: "xs :@ [::] = xs" +by (induct xs) simp_all + +lemma snil_append_iff[iff]: "xs :@ ys = [::] \ xs = [::] \ ys = [::]" +by (induct xs) simp_all + +lemma smap_sappend[simp]: "smap\f\(xs :@ ys) = smap\f\xs :@ smap\f\ys" +by (induct xs; cases "ys = \"; simp) + +lemma stail_sappend: "stail\(xs :@ ys) = (case xs of [::] \ stail\ys | z :# zs \ zs :@ ys)" +by (induct xs) simp_all + +lemma stail_append2[simp]: "xs \ [::] \ stail\(xs :@ ys) = stail\xs :@ ys" +by (induct xs) simp_all + +lemma slist_case_snoc: + "g\\\\ = \ \ slist_case\f\g\(xs :@ [:x:]) = g\(shead\(xs :@ [:x:]))\(stail\(xs :@ [:x:]))" +by (cases "x = \"; cases xs; clarsimp) + +fixrec sall :: "('a \ tr) \ [:'a:] \ tr" where + "sall\p\[::] = TT" +| "\x \ \; xs \ \\ \ sall\p\(x :# xs) = (p\x andalso sall\p\xs)" + +lemma sall_strict[simp]: "sall\p\\ = \" +by fixrec_simp + +lemma sall_const_TT[simp]: + assumes "xs \ \" + shows "sall\(\ x. TT)\xs = TT" +using assms by (induct xs) simp_all + +lemma sall_const_TT_conv[simp]: "(sall\(\ x. TT)\xs = TT) \ (xs \ \)" +by auto + +lemma sall_TT[simp]: "(sall\p\xs = TT) \ (xs \ \ \ (\x\sset xs. p\x = TT))" +by (induct xs) simp_all + +fixrec sfilter :: "('a \ tr) \ [:'a:] \ [:'a:]" where + "sfilter\p\[::] = [::]" +| "\x \ \; xs \ \\ \ sfilter\p\(x :# xs) = If p\x then x :# sfilter\p\xs else sfilter\p\xs" + +lemma sfilter_strict[simp]: "sfilter\p\\ = \" +by fixrec_simp + +lemma sfilter_bottom_iff[simp]: "(sfilter\p\xs = \) \ (xs = \ \ (\x\sset xs. p\x = \))" +by (induct xs) (use trE in auto) + +lemma sset_sfilter[simp]: + assumes "\x. x \ sset xs \ p\x \ \" + shows "sset (sfilter\p\xs) = {x |x. x \ sset xs \ p\x = TT}" +using assms by (induct xs) (fastforce simp: If2_def[symmetric] split: If2_splits)+ + +lemma sfilter_strict_scons[simp]: + assumes "p\\ = \" + shows "sfilter\p\(x :# xs) = If p\x then x :# sfilter\p\xs else sfilter\p\xs" +using assms by (cases "x = \"; cases "xs = \"; simp) + +lemma sfilter_scons_let: + assumes "p\\ = \" + shows "sfilter\p\(x :# xs) = (let xs' = sfilter\p\xs in If p\x then x :# xs' else xs')" +unfolding Let_def using assms by simp + +lemma sfilter_sappend[simp]: "sfilter\p\(xs :@ ys) = sfilter\p\xs :@ sfilter\p\ys" +by (cases "ys"; clarsimp) (induct xs; fastforce simp: If2_def[symmetric] split: If2_splits) + +lemma sfilter_const_FF[simp]: + assumes "xs \ \" + shows "sfilter\(\ x. FF)\xs = [::]" +using assms by (induct xs) simp_all + +lemma sfilter_const_FF_conv[simp]: "(sfilter\(\ x. FF)\xs = [::]) \ (xs \ \)" +by auto + +lemma sfilter_const_TT[simp]: "sfilter\(\ x. TT)\xs = xs" +by (induct xs) simp_all + +lemma sfilter_cong: + assumes "xs = xs'" + assumes "\x. x \ sset xs \ p\x = p'\x" + shows "sfilter\p\xs = sfilter\p'\xs'" +using assms by (induct xs arbitrary: xs') auto + +lemma sfilter_snil_conv[simp]: "sfilter\p\xs = [::] \ sall\(neg oo p)\xs = TT" +by (induct xs; force simp: If2_def[symmetric] split: If2_splits) + +lemma sfilter_sfilter': "sfilter\p\(sfilter\q\xs) = sfilter\(\ x. q\x andalso p\x)\xs" +proof(induct xs) + case (scons x xs) from scons(1, 2) show ?case + by (cases "sfilter\q\xs = \") + (simp_all add: If_distr If_andalso scons(3)[symmetric] del: sfilter_bottom_iff) +qed simp_all + +lemma sfilter_sfilter: "sfilter\p oo sfilter\q = sfilter\(\ x. q\x andalso p\x)" +by (clarsimp simp: cfun_eq_iff sfilter_sfilter') + +lemma sfilter_smap': + assumes "p\\ = \" + shows "sfilter\p\(smap\f\xs) = smap\f\(sfilter\(p oo f)\xs)" +using assms by (induct xs; simp add: If2_def[symmetric] split: If2_splits) (metis slist.con_rews(2) smap.simps(2) smap_strict) + +lemma sfilter_smap: + assumes "p\\ = \" + shows "sfilter\p oo smap\f = smap\f oo sfilter\(p oo f)" +using assms by (clarsimp simp: cfun_eq_iff sfilter_smap') + +fixrec sfoldl :: "('a::pcpo \ 'b::domain \ 'a) \ 'a \ [:'b:] \ 'a" where + "sfoldl\f\z\[::] = z" +| "\x \ \; xs \ \\ \ sfoldl\f\z\(x :# xs) = sfoldl\f\(f\z\x)\xs" + +lemma sfoldl_strict[simp]: "sfoldl\f\z\\ = \" +by fixrec_simp + +lemma sfoldl_strict_f[simp]: + assumes "f\\ = \" + shows "sfoldl\f\\\xs = \" +using assms by (induct xs) simp_all + +lemma sfoldl_cong: + assumes "xs = xs'" + assumes "z = z'" + assumes "\x z. x \ sset xs \ f\z\x = f'\z\x" + shows "sfoldl\f\z\xs = sfoldl\f'\z'\xs'" +using assms by (induct xs arbitrary: xs' z z') auto + +lemma sfoldl_sappend[simp]: + assumes "f\\ = \" + shows "sfoldl\f\z\(xs :@ ys) = sfoldl\f\(sfoldl\f\z\xs)\ys" +using assms by (cases "ys = \", force) (induct xs arbitrary: z; simp) + +fixrec sfoldr :: "('b \ 'a::pcpo \ 'a) \ 'a \ [:'b:] \ 'a" where + "sfoldr\f\z\[::] = z" +| "\x \ \; xs \ \\ \ sfoldr\f\z\(x :# xs) = f\x\(sfoldr\f\z\xs)" + +lemma sfoldr_strict[simp]: "sfoldr\f\z\\ = \" +by fixrec_simp + +fixrec sconcat :: "[:[:'a:]:] \ [:'a:]" where + "sconcat\[::] = [::]" +| "\x \ \; xs \ \\ \ sconcat\(x :# xs) = x :@ sconcat\xs" + +lemma sconcat_strict[simp]: "sconcat\\ = \" +by fixrec_simp + +lemma sconcat_scons[simp]: + shows "sconcat\(x :# xs) = x :@ sconcat\xs" +by (cases "x = \", force) (induct xs; fastforce) + +lemma sconcat_sfoldl_aux: "sfoldl\sappend\z\xs = z :@ sconcat\xs" +by (induct xs arbitrary: z) simp_all + +lemma sconcat_sfoldl: "sconcat = sfoldl\sappend\[::]" +by (clarsimp simp: cfun_eq_iff sconcat_sfoldl_aux) + +lemma sconcat_sappend[simp]: "sconcat\(xs :@ ys) = sconcat\xs :@ sconcat\ys" +by (induct xs) simp_all + +fixrec slength :: "[:'a:] \ Integer" +where + "slength\[::] = 0" +| "\x \ \; xs \ \\ \ slength\(x :# xs) = slength\xs + 1" + +lemma slength_strict[simp]: "slength\\ = \" +by fixrec_simp + +lemma slength_bottom_iff[simp]: "(slength\xs = \) \ (xs = \)" +by (induct xs) force+ + +lemma slength_ge_0: "slength\xs = MkI\n \ n \ 0" +by (induct xs arbitrary: n) (simp add: one_Integer_def plus_eq_MkI_conv; force)+ + +lemma slengthE: + shows "\xs \ \; \n. \slength\xs = MkI\n; 0 \ n\ \ Q\ \ Q" +by (meson Integer.exhaust slength_bottom_iff slength_ge_0) + +lemma slength_0_conv[simp]: + "(slength\xs = 0) \ (xs = [::])" + "(slength\xs = MkI\0) \ (xs = [::])" + "eq\0\(slength\xs) = snull\xs" + "eq\(slength\xs)\0 = snull\xs" +by (induct xs) (auto simp: one_Integer_def elim: slengthE) + +lemma le_slength_0[simp]: "(le\0\(slength\xs) = TT) \ (xs \ \)" +by (cases "slength\xs") (auto simp: slength_ge_0 zero_Integer_def) + +lemma lt_slength_0[simp]: + "xs \ \ \ lt\(slength\xs)\0 = FF" + "xs \ \ \ lt\(slength\xs)\(slength\xs + 1) = TT" +unfolding zero_Integer_def one_Integer_def by (auto elim: slengthE) + +lemma slength_smap[simp]: + assumes "\x. x \ \ \ f\x \ \" + shows "slength\(smap\f\xs) = slength\xs" +using assms by (induct xs) simp_all + +lemma slength_sappend[simp]: "slength\(xs :@ ys) = slength\xs + slength\ys" +by (cases "ys = \", force) (induct xs; force simp: ac_simps) + +lemma slength_sfoldl_aux: "sfoldl\(\ i _. i + 1)\z\xs = z + slength\xs" +by (induct xs arbitrary: z) (simp_all add: ac_simps) + +lemma slength_sfoldl: "slength = sfoldl\(\ i _. i + 1)\0" +by (clarsimp simp: cfun_eq_iff slength_sfoldl_aux) + +lemma le_slength_plus: + assumes "xs \ \" + assumes "n \ \" + shows "le\n\(slength\xs + n) = TT" +using assms by (cases n; force elim: slengthE) + +fixrec srev :: "[:'a:] \ [:'a:]" where + "srev\[::] = [::]" +| "\x \ \; xs \ \\ \ srev\(x :# xs) = srev\xs :@ [:x:]" + +lemma srev_strict[simp]: "srev\\ = \" +by fixrec_simp + +lemma srev_bottom_iff[simp]: "(srev\xs = \) \ (xs = \)" +by (induct xs) simp_all + +lemma srev_scons[simp]: "srev\(x :# xs) = srev\xs :@ [:x:]" +by (cases "x = \", clarsimp) (induct xs; force) + +lemma srev_sappend[simp]: "srev\(xs :@ ys) = srev\ys :@ srev\xs" +by (induct xs) simp_all + +lemma srev_srev_ident[simp]: "srev\(srev\xs) = xs" +by (induct xs) auto + +lemma srev_cases[case_names bottom snil ssnoc]: + assumes "xs = \ \ P" + assumes "xs = [::] \ P" + assumes "\y ys. \y \ \; ys \ \; xs = ys :@ [:y:]\ \ P" + shows "P" +using assms by (metis slist.exhaust srev.simps(1) srev_scons srev_srev_ident srev_strict) + +lemma srev_induct[case_names bottom snil ssnoc]: + assumes "P \" + assumes "P [::]" + assumes "\x xs. \x \ \; xs \ \; P xs\ \ P (xs :@ [:x:])" + shows "P xs" +proof - + have "P (srev\(srev\xs))" by (rule slist.induct[where x="srev\xs"]; simp add: assms) + then show ?thesis by simp +qed + +lemma sfoldr_conv_sfoldl: + assumes "\x. f\x\\ = \" \\\f\ must be strict in the accumulator.\ + shows "sfoldr\f\z\xs = sfoldl\(\ acc x. f\x\acc)\z\(srev\xs)" +using assms by (induct xs arbitrary: z) simp_all + +fixrec stake :: "Integer \ [:'a:] \ [:'a:]" where \\ Note: strict in both parameters. \ + "stake\\\\ = \" +| "i \ \ \ stake\i\[::] = [::]" +| "\x \ \; xs \ \\ \ stake\i\(x :# xs) = If le\i\0 then [::] else x :# stake\(i - 1)\xs" + +lemma stake_strict[simp]: + "stake\\ = \" + "stake\i\\ = \" +by fixrec_simp+ + +lemma stake_bottom_iff[simp]: "(stake\i\xs = \) \ (i = \ \ xs = \)" +by (induct xs arbitrary: i; clarsimp; case_tac i; clarsimp) + +lemma stake_0[simp]: + "xs \ \ \ stake\0\xs = [::]" + "xs \ \ \ stake\(MkI\0)\xs = [::]" + "stake\0\xs \ [::]" +by (cases xs; simp add: zero_Integer_def)+ + +lemma stake_scons[simp]: "le\1\i = TT \ stake\i\(x :# xs) = x :# stake\(i - 1)\xs" +by (cases i; cases "x = \"; cases "xs = \"; + simp add: zero_Integer_def one_Integer_def split: if_splits) + +lemma take_MkI_scons[simp]: + "0 < n \ stake\(MkI\n)\(x :# xs) = x :# stake\(MkI\(n - 1))\xs" +by (cases "x = \"; cases "xs = \"; simp add: zero_Integer_def one_Integer_def) + +lemma stake_numeral_scons[simp]: + "xs \ \ \ stake\1\(x :# xs) = [:x:]" + "stake\(numeral (Num.Bit0 k))\(x :# xs) = x :# stake\(numeral (Num.BitM k))\xs" + "stake\(numeral (Num.Bit1 k))\(x :# xs) = x :# stake\(numeral (Num.Bit0 k))\xs" +by (cases "x = \"; cases xs; simp add: zero_Integer_def one_Integer_def numeral_Integer_eq)+ + +lemma stake_all: + assumes "le\(slength\xs)\i = TT" + shows "stake\i\xs = xs" +using assms +proof(induct xs arbitrary: i) + case (scons x xs i) then show ?case + by (cases i; clarsimp simp: If2_def[symmetric] zero_Integer_def one_Integer_def split: If2_splits if_splits elim!: slengthE) +qed (simp_all add: le_defined) + +lemma stake_all_triv[simp]: "stake\(slength\xs)\xs = xs" +by (cases "xs = \") (auto simp: stake_all) + +lemma stake_append[simp]: "stake\i\(xs :@ ys) = stake\i\xs :@ stake\(i - slength\xs)\ys" +proof(induct xs arbitrary: i) + case (snil i) then show ?case by (cases i; simp add: zero_Integer_def) +next + case (scons x xs i) then show ?case + by (cases i; cases ys; clarsimp simp: If2_def[symmetric] zero_Integer_def one_Integer_def split: If2_splits elim!: slengthE) +qed simp_all + +fixrec sdrop :: "Integer \ [:'a:] \ [:'a:]" where \\ Note: strict in both parameters. \ + [simp del]: "sdrop\i\xs = If le\i\0 then xs else (case xs of [::] \ [::] | y :# ys \ sdrop\(i - 1)\ys)" + +lemma sdrop_strict[simp]: + "sdrop\\ = \" + "sdrop\i\\ = \" +by fixrec_simp+ + +lemma sdrop_bottom_iff[simp]: "(sdrop\i\xs = \) \ (i = \ \ xs = \)" +proof(induct xs arbitrary: i) + case (snil i) then show ?case by (subst sdrop.unfold) (cases i; simp) +next + case (scons x xs i) then show ?case by (subst sdrop.unfold) fastforce +qed simp + +lemma sdrop_snil[simp]: + assumes "i \ \" + shows "sdrop\i\[::] = [::]" +using assms by (subst sdrop.unfold; fastforce) + +lemma sdrop_snil_conv[simp]: "(sdrop\i\[::] = [::]) \ (i \ \)" +by (subst sdrop.unfold; fastforce) + +lemma sdrop_0[simp]: + "sdrop\0\xs = xs" + "sdrop\(MkI\0)\xs = xs" +by (subst sdrop.simps, simp add: zero_Integer_def)+ + +lemma sdrop_pos: + "le\i\0 = FF \ sdrop\i\xs = (case xs of [::] \ [::] | y :# ys \ sdrop\(i - 1)\ys)" +by (subst sdrop.simps, simp) + +lemma sdrop_neg: + "le\i\0 = TT \ sdrop\i\xs = xs" +by (subst sdrop.simps, simp) + +lemma sdrop_numeral_scons[simp]: + "x \ \ \ sdrop\1\(x :# xs) = xs" + "x \ \ \ sdrop\(numeral (Num.Bit0 k))\(x :# xs) = sdrop\(numeral (Num.BitM k))\xs" + "x \ \ \ sdrop\(numeral (Num.Bit1 k))\(x :# xs) = sdrop\(numeral (Num.Bit0 k))\xs" +by (subst sdrop.simps, + simp add: zero_Integer_def one_Integer_def numeral_Integer_eq; cases xs; simp)+ + +lemma sdrop_sappend[simp]: + "sdrop\i\(xs :@ ys) = sdrop\i\xs :@ sdrop\(i - slength\xs)\ys" +proof(induct xs arbitrary: i) + case (snil i) then show ?case by (cases i; simp add: zero_Integer_def) +next + case (scons x xs i) then show ?case + by (cases "ys = \"; cases "le\i\0"; cases i; + clarsimp simp: zero_Integer_def one_Integer_def sdrop_neg sdrop_pos add.commute diff_diff_add + split: if_splits elim!: slengthE) +qed simp + +lemma sdrop_all: + assumes "le\(slength\xs)\i = TT" + shows "sdrop\i\xs = [::]" +using assms +proof(induct xs arbitrary: i) + case (scons x xs i) then show ?case + by (subst sdrop.unfold; cases i; + clarsimp simp: If2_def[symmetric] zero_Integer_def one_Integer_def split: If2_splits if_splits elim!: slengthE) +qed (simp_all add: le_defined) + +lemma slength_sdrop[simp]: + "slength\(sdrop\i\xs) = If le\i\0 then slength\xs else If le\(slength\xs)\i then 0 else slength\xs - i" +proof(induct xs arbitrary: i) + case (snil i) then show ?case by (cases i; simp add: zero_Integer_def) +next + case (scons x xs i) then show ?case + by (subst sdrop.unfold; cases i; clarsimp simp: zero_Integer_def one_Integer_def elim!: slengthE) +qed simp + +lemma sdrop_not_snilD: + assumes "sdrop\(MkI\i)\xs \ [::]" + assumes "xs \ \" + shows "lt\(MkI\i)\(slength\xs) = TT \ xs \ [::]" +using assms +proof(induct xs arbitrary: i) + case (scons x xs i) then show ?case + by (subst (asm) (2) sdrop.unfold, clarsimp simp: zero_Integer_def one_Integer_def not_le sdrop_all elim!: slengthE) +qed simp_all + +lemma sdrop_sappend_same: + assumes "xs \ \" + shows "sdrop\(slength\xs)\(xs :@ ys) = ys" +using assms +proof(induct xs arbitrary: ys) + case (scons x xs ys) then show ?case + by (cases "ys = \"; subst sdrop.unfold; clarsimp simp: zero_Integer_def one_Integer_def elim!: slengthE) +qed simp_all + +fixrec sscanl :: "('a \ 'b \ 'a) \ 'a \ [:'b:] \ [:'a:]" where + "sscanl\f\z\[::] = z :# [::]" +| "\x \ \; xs \ \\ \ sscanl\f\z\(x :# xs) = z :# sscanl\f\(f\z\x)\xs" + +lemma sscanl_strict[simp]: + "sscanl\f\\\xs = \" + "sscanl\f\z\\ = \" +by (cases xs) fixrec_simp+ + +lemma sscanl_cong: + assumes "xs = xs'" + assumes "z = z'" + assumes "\x z. x \ sset xs \ f\z\x = f'\z\x" + shows "sscanl\f\z\xs = sscanl\f'\z'\xs'" +using assms by (induct xs arbitrary: xs' z z') auto + +lemma sscanl_lfp_fusion': + assumes "g\\ = \" + assumes *: "\acc x. x \ \ \ g\(f\acc\x) = f'\(g\acc)\x" + shows "smap\g\(sscanl\f\z\xs) = sscanl\f'\(g\z)\xs" +using assms by (induct xs arbitrary: z) simp_all + +lemma sscanl_lfp_fusion: + assumes "g\\ = \" + assumes *: "\acc x. x \ \ \ g\(f\acc\x) = f'\(g\acc)\x" + shows "smap\g oo sscanl\f\z = sscanl\f'\(g\z)" +using assms by (clarsimp simp: cfun_eq_iff sscanl_lfp_fusion') + +lemma sscanl_ww_fusion': \\ Worker/wrapper @{cite [cite_macro=citep] "GillHutton:2009" and "Gammie:2011"} specialised to @{const \sscanl\} \ + fixes wrap :: "'b \ 'a" + fixes unwrap :: "'a \ 'b" + fixes z :: "'a" + fixes f :: "'a \ 'c \ 'a" + fixes f' :: "'b \ 'c \ 'b" + assumes ww: "wrap oo unwrap = ID" + assumes wb: "\z x. x \ \ \ unwrap\(f\(wrap\z)\x) = f'\(unwrap\(wrap\z))\x" + shows "sscanl\f\z\xs = smap\wrap\(sscanl\f'\(unwrap\z)\xs)" +using assms +by (induct xs arbitrary: z) (simp add: cfun_eq_iff retraction_cfcomp_strict | metis)+ + +lemma sscanl_ww_fusion: \\ Worker/wrapper @{cite [cite_macro=citep] "GillHutton:2009" and "Gammie:2011"} specialised to @{const \sscanl\} \ + fixes wrap :: "'b \ 'a" + fixes unwrap :: "'a \ 'b" + fixes z :: "'a" + fixes f :: "'a \ 'c \ 'a" + fixes f' :: "'b \ 'c \ 'b" + assumes ww: "wrap oo unwrap = ID" + assumes wb: "\z x. x \ \ \ unwrap\(f\(wrap\z)\x) = f'\(unwrap\(wrap\z))\x" + shows "sscanl\f\z = smap\wrap oo sscanl\f'\(unwrap\z)" +using assms by (clarsimp simp: cfun_eq_iff sscanl_ww_fusion') + +fixrec sinits :: "[:'a:] \ [:[:'a:]:]" where + "sinits\[::] = [::] :# [::]" +| "\x \ \; xs \ \\ \ sinits\(x :# xs) = [::] :# smap\(scons\x)\(sinits\xs)" + +lemma sinits_strict[simp]: "sinits\\ = \" +by fixrec_simp + +lemma sinits_bottom_iff[simp]: "(sinits\xs = \) \ (xs = \)" +by (induct xs) simp_all + +lemma sinits_not_snil[iff]: "sinits\xs \ [::]" +by (cases xs) simp_all + +lemma sinits_empty_bottom[simp]: "(sset (sinits\xs) = {}) \ (xs = \)" +by (cases xs) simp_all + +lemma sinits_scons[simp]: "sinits\(x :# xs) = [::] :# smap\(x :#)\(sinits\xs)" +by (cases "x = \", force) (induct xs; force) + +lemma sinits_length[simp]: "slength\(sinits\xs) = slength\xs + 1" +by (induct xs) simp_all + +lemma sinits_snoc[simp]: "sinits\(xs :@ [:x:]) = sinits\xs :@ [:xs :@ [:x:]:]" +by (induct xs) simp_all + +lemma sinits_foldr': \\ @{cite [cite_macro=citet] \p30\ "Bird:1987"} \ + shows "sinits\xs = sfoldr\(\ x xs. [:[::]:] :@ smap\(x :#)\xs)\[:[::]:]\xs" +by (induct xs) simp_all + +lemma sinits_sscanl': + shows "smap\(sfoldl\f\z)\(sinits\xs) = sscanl\f\z\xs" +by (induct xs arbitrary: z) (simp_all cong: smap_cong add: oo_def eta_cfun) + +lemma sinits_sscanl: \\ @{cite [cite_macro=citet] \Lemma~5\ "Bird:1987"}, @{cite [cite_macro=citet] \p118 ``the scan lemma''\ "Bird:PearlsofFAD:2010"} \ + shows "smap\(sfoldl\f\z) oo sinits = sscanl\f\z" +by (simp add: sinits_sscanl' cfun_eq_iff) + +lemma sinits_all[simp]: "(xs \ sset (sinits\xs)) \ (xs \ \)" +by (induct xs) simp_all + +fixrec stails :: "[:'a:] \ [:[:'a:]:]" where + "stails\[::] = [::] :# [::]" +| "\x \ \; xs \ \\ \ stails\(x :# xs) = (x :# xs) :# stails\xs" + +lemma stails_strict[simp]: "stails\\ = \" +by fixrec_simp + +lemma stails_bottom_iff[simp]: "(stails\xs = \) \ (xs = \)" +by (induct xs) simp_all + +lemma stails_not_snil[iff]: "stails\xs \ [::]" +by (cases xs) simp_all + +lemma stails_scons[simp]: "stails\(x :# xs) = (x :# xs) :# stails\xs" +by (induct xs) (cases "x = \"; simp)+ + +lemma stails_slength[simp]: "slength\(stails\xs) = slength\xs + 1" +by (induct xs) simp_all + +lemma stails_snoc[simp]: + shows "stails\(xs :@ [:x:]) = smap\(\ ys. ys :@ [:x:])\(stails\xs) :@ [:[::]:]" +by (induct xs) simp_all + +lemma stails_sfoldl': + shows "stails\xs = sfoldl\(\ xs x. smap\(\ ys. ys :@ [:x:])\xs :@ [:[::]:])\[:[::]:]\xs" +by (induct xs rule: srev_induct) simp_all + +lemma stails_sfoldl: + shows "stails = sfoldl\(\ xs x. smap\(\ ys. ys :@ [:x:])\xs :@ [:[::]:])\[:[::]:]" +by (clarsimp simp: cfun_eq_iff stails_sfoldl') + +lemma stails_all[simp]: "(xs \ sset (stails\xs)) \ (xs \ \)" +by (cases xs) simp_all + +fixrec selem :: "'a::Eq_def \ [:'a:] \ tr" where + "selem\x\[::] = FF" +| "\y \ \; ys \ \\ \ selem\x\(y :# ys) = (eq\x\y orelse selem\x\ys)" + +lemma selem_strict[simp]: "selem\x\\ = \" +by fixrec_simp + +lemma selem_bottom_iff[simp]: "(selem\x\xs = \) \ (xs = \ \ (xs \ [::] \ x = \))" +by (induct xs) auto + +lemma selem_sappend[simp]: + assumes "ys \ \" + shows "selem\x\(xs :@ ys) = (selem\x\xs orelse selem\x\ys)" +using assms by (induct xs) simp_all + +lemma elem_TT[simp]: "(selem\x\xs = TT) \ (x \ sset xs)" +by (induct xs; auto) (metis sset_defined)+ + +lemma elem_FF[simp]: "(selem\x\xs = FF) \ (xs = [::] \ (x \ \ \ xs \ \ \ x \ sset xs))" +by (induct xs) auto + +lemma selem_snil_stails[iff]: + assumes "xs \ \" + shows "selem\[::]\(stails\xs) = TT" +using assms by (induct xs) simp_all + +fixrec sconcatMap :: "('a \ [:'b:]) \ [:'a:] \ [:'b:]" where +[simp del]: "sconcatMap\f = sconcat oo smap\f" + +lemma sconcatMap_strict[simp]: "sconcatMap\f\\ = \" +by fixrec_simp + +lemma sconcatMap_snil[simp]: "sconcatMap\f\[::] = [::]" +by fixrec_simp + +lemma sconcatMap_scons[simp]: "x \ \ \ sconcatMap\f\(x :# xs) = f\x :@ sconcatMap\f\xs" +by (cases "xs = \"; simp add: sconcatMap.unfold) + +lemma sconcatMap_bottom_iff[simp]: "(sconcatMap\f\xs = \) \ (xs = \ \ (\x\sset xs. f\x = \))" +by (induct xs) simp_all + +lemma sconcatMap_sappend[simp]: "sconcatMap\f\(xs :@ ys) = sconcatMap\f\xs :@ sconcatMap\f\ys" +by (induct xs) simp_all + +lemma sconcatMap_monad_laws: + "sconcatMap\(\ x. [:x:])\xs = xs" + "sconcatMap\g\(sconcatMap\f\xs) = sconcatMap\(\ x. sconcatMap\g\(f\x))\xs" +by (induct xs) simp_all + +fixrec supto :: "Integer \ Integer \ [:Integer:]" where + [simp del]: "supto\i\j = If le\i\j then i :# supto\(i+1)\j else [::]" + +lemma upto_strict[simp]: + "supto\\ = \" + "supto\m\\ = \" +by fixrec_simp+ + +lemma supto_is_snil_conv[simp]: + "(supto\(MkI\i)\(MkI\j) = [::]) \ (j < i)" + "([::] = supto\(MkI\i)\(MkI\j)) \ (j < i)" +by (subst supto.unfold; simp)+ + +lemma supto_simp[simp]: + "j < i \ supto\(MkI\i)\(MkI\j) = [::]" + "i \ j \ supto\(MkI\i)\(MkI\j) = MkI\i :# supto\(MkI\i+1)\(MkI\j)" + "supto\0\0 = [:0:]" +by (subst supto.simps, simp)+ + +lemma supto_defined[simp]: "supto\(MkI\i)\(MkI\j) \ \" (is "?P i j") +proof (cases "j - i") + fix d + assume "j - i = int d" + then show "?P i j" + proof (induct d arbitrary: i j) + case (Suc d i j) + then have "j - (i + 1) = int d" and le: "i \ j" by simp_all + from Suc(1)[OF this(1)] have IH: "?P (i+1) j" . + then show ?case using le by (simp add: one_Integer_def) + qed (simp add: one_Integer_def) +next + fix d + assume "j - i = - int d" + then have "j \ i" by auto + moreover + { assume "j = i" then have "?P i j" by (simp add: one_Integer_def) } + moreover + { assume "j < i" then have "?P i j" by (simp add: one_Integer_def) } + ultimately show ?thesis by arith +qed + +lemma supto_bottom_iff[simp]: + "(supto\i\j = \) \ (i = \ \ j = \)" +by (cases i; simp; cases j; simp) + +lemma supto_snoc[simp]: + "i \ j \ supto\(MkI\i)\(MkI\j) = supto\(MkI\i)\(MkI\j-1) :@ [:MkI\j:]" +proof(induct "nat(j - i)" arbitrary: i j) + case 0 then show ?case by (simp add: one_Integer_def) +next + case (Suc k i j) + then have "k = nat (j - (i + 1))" "i < j" by linarith+ + from this(2) Suc.hyps(1)[OF this(1)] Suc(2,3) show ?case by (simp add: one_Integer_def) +qed + +lemma slength_supto[simp]: "slength\(supto\(MkI\i)\(MkI\j)) = MkI\(if j < i then 0 else j - i + 1)" (is "?P i j") +proof (cases "j - i") + fix d + assume "j - i = int d" + then show "?P i j" + proof (induct d arbitrary: i j) + case (Suc d i j) + then have "j - (i + 1) = int d" and le: "i \ j" by simp_all + from Suc(1)[OF this(1)] have IH: "?P (i+1) j" . + then show ?case using le by (simp add: one_Integer_def) + qed (simp add: one_Integer_def) +next + fix d + assume "j - i = - int d" + then have "j \ i" by auto + moreover + { assume "j = i" then have "?P i j" by (simp add: one_Integer_def) } + moreover + { assume "j < i" then have "?P i j" by (simp add: one_Integer_def) } + ultimately show ?thesis by arith +qed + +lemma sset_supto[simp]: + "sset (supto\(MkI\i)\(MkI\j)) = {MkI\k |k. i \ k \ k \ j}" (is "sset (?u i j) = ?R i j") +proof (cases "j - i") + case (nonneg k) + then show ?thesis + proof (induct k arbitrary: i j) + case (Suc k) + then have *: "j - (i + 1) = int k" by simp + from Suc(1)[OF *] have IH: "sset (?u (i+1) j) = ?R (i+1) j" . + from * have "i \ j" by simp + then have "sset (?u i j) = sset (MkI\i :# ?u (i+1) j)" by (simp add: one_Integer_def) + also have "\ = insert (MkI\i) (?R (i+1) j)" by (simp add: IH) + also have "\ = ?R i j" using \i \ j\ by auto + finally show ?case . + qed (force simp: one_Integer_def) +qed simp + +lemma supto_split1: \\From \HOL.List\\ + assumes "i \ j" + assumes "j \ k" + shows "supto\(MkI\i)\(MkI\k) = supto\(MkI\i)\(MkI\(j - 1)) :@ supto\(MkI\j)\(MkI\k)" +using assms +proof (induct j rule: int_ge_induct) + case (step l) with supto_simp(2) supto_snoc show ?case by (clarsimp simp: one_Integer_def) +qed simp + +lemma supto_split2: \\From \HOL.List\\ + assumes "i \ j" + assumes "j \ k" + shows "supto\(MkI\i)\(MkI\k) = supto\(MkI\i)\(MkI\j) :@ supto\(MkI\(j + 1))\(MkI\k)" +proof(cases "j + 1 \ k") + case True with assms show ?thesis + by (subst supto_split1[where j="j + 1" and k=k]; clarsimp simp: one_Integer_def) +next + case False with assms show ?thesis by (clarsimp simp: one_Integer_def not_le) +qed + +lemma supto_split3: \\From \HOL.List\\ + assumes "i \ j" + assumes "j \ k" + shows "supto\(MkI\i)\(MkI\k) = supto\(MkI\i)\(MkI\(j - 1)) :@ MkI\j :# supto\(MkI\(j + 1))\(MkI\k)" +using assms supto_simp(2) supto_split1 by (metis one_Integer_def plus_MkI_MkI) + +lemma sinits_stake': + shows "sinits\xs = smap\(\ i. stake\i\xs)\(supto\0\(slength\xs))" +proof(induct xs rule: srev_induct) + case (ssnoc x xs) then show ?case + apply (clarsimp simp: zero_Integer_def one_Integer_def stake_all + simp del: supto_simp + elim!: slengthE) + apply (rule arg_cong, rule smap_cong[OF refl]) + apply clarsimp + done +qed simp_all + +lemma stails_sdrop': + shows "stails\xs = smap\(\ i. sdrop\i\xs)\(supto\0\(slength\xs))" +proof(induct xs rule: srev_induct) + case (ssnoc x xs) then show ?case + apply (clarsimp simp: zero_Integer_def one_Integer_def sdrop_all + simp del: supto_simp + elim!: slengthE) + apply (rule arg_cong, rule smap_cong[OF refl]) + apply clarsimp + apply (subst (3) sdrop_neg; fastforce simp: zero_Integer_def) + done +qed simp_all + +lemma sdrop_elem_stails[iff]: + assumes "xs \ \" + shows "sdrop\(MkI\i)\xs \ sset (stails\xs)" +using assms +by (clarsimp simp: stails_sdrop' zero_Integer_def one_Integer_def elim!: slengthE) + (metis add.left_neutral le_MkI_MkI le_cases not_less sdrop_all sdrop_neg zero_Integer_def zless_imp_add1_zle) + +fixrec slast :: "[:'a:] \ 'a" where + "slast\[::] = \" +| "\x \ \; xs \ \\ \ slast\(x :# xs) = (case xs of [::] \ x | y :# ys \ slast\xs)" + +lemma slast_strict[simp]: + "slast\\ = \" +by fixrec_simp + +lemma slast_singleton[simp]: "slast\[:x:] = x" +by (cases "x = \"; simp) + +lemma slast_sappend_ssnoc[simp]: + assumes "xs \ \" + shows "slast\(xs :@ [:x:]) = x" +using assms +proof(induct xs) + case (scons y ys) then show ?case by (cases "x = \"; simp; cases ys; simp) +qed simp_all + +fixrec sbutlast :: "[:'a:] \ [:'a:]" where + "sbutlast\[::] = [::]" +| "\x \ \; xs \ \\ \ sbutlast\(x :# xs) = (case xs of [::] \ [::] | y :# ys \ x :# sbutlast\xs)" + +lemma sbutlast_strict[simp]: + "sbutlast\\ = \" +by fixrec_simp + +lemma sbutlast_sappend_ssnoc[simp]: + assumes "x \ \" + shows "sbutlast\(xs :@ [:x:]) = xs" +using assms +proof(induct xs) + case (scons y ys) then show ?case by (cases ys; simp) +qed simp_all + +fixrec prefix :: "[:'a::Eq_def:] \ [:'a:] \ tr" where + "prefix\xs\\ = \" +| "ys \ \ \ prefix\[::]\ys = TT" +| "\x \ \; xs \ \\ \ prefix\(x :# xs)\[::] = FF" +| "\x \ \; xs \ \; y \ \; ys \ \\ \ prefix\(x :# xs)\(y :# ys) = (eq\x\y andalso prefix\xs\ys)" + +lemma prefix_strict[simp]: "prefix\\ = \" +by (clarsimp simp: cfun_eq_iff) fixrec_simp + +lemma prefix_bottom_iff[simp]: "(prefix\xs\ys = \) \ (xs = \ \ ys = \)" +proof(induct xs arbitrary: ys) + case (snil ys) then show ?case by (cases ys) simp_all +next + case (scons a xs) then show ?case by (cases ys) simp_all +qed simp + +lemma prefix_definedD: + assumes "prefix\xs\ys = TT" + shows "xs \ \ \ ys \ \" +using assms by (induct xs arbitrary: ys) auto + +lemma prefix_refl[simp]: + assumes "xs \ \" + shows "prefix\xs\xs = TT" +using assms by (induct xs) simp_all + +lemma prefix_refl_conv[simp]: "(prefix\xs\xs = TT) \ (xs \ \)" +by auto + +lemma prefix_of_snil[simp]: "prefix\xs\[::] = (case xs of [::] \ TT | x :# xs \ FF)" +by (cases xs) simp_all + +lemma prefix_singleton_TT: + shows "prefix\[:x:]\ys = TT \ (x \ \ \ (\zs. zs \ \ \ ys = x :# zs))" +by (cases "x = \"; clarsimp; cases ys; fastforce) + +lemma prefix_singleton_FF: + shows "prefix\[:x:]\ys = FF \ (x \ \ \ (ys = [::] \ (\z zs. z \ \ \ zs \ \ \ ys = z :# zs \ x \ z)))" +by (cases "x = \"; clarsimp; cases ys; fastforce) + +lemma prefix_FF_not_snilD: + assumes "prefix\xs\ys = FF" + shows "xs \ [::]" +using assms by (cases xs; cases ys; simp) + +lemma prefix_slength: + assumes "prefix\xs\ys = TT" + shows "le\(slength\xs)\(slength\ys) = TT" +using assms +proof(induct ys arbitrary: xs) + case (snil xs) then show ?case by (cases xs) simp_all +next + case (scons a ys) then show ?case by (cases xs) (simp_all add: le_plus_1) +qed simp + +lemma prefix_slength_strengthen: "prefix\xs\ys = (le\(slength\xs)\(slength\ys) andalso prefix\xs\ys)" +by (rule andalso_weaken_left) (auto dest: prefix_slength) + +lemma prefix_scons_snil[simp]: "prefix\(x :# xs)\[::] \ TT" +by (cases "x :# xs \ \") auto + +lemma scons_prefix_scons[simp]: + "(prefix\(x :# xs)\(y :# ys) = TT) \ (eq\x\y = TT \ prefix\xs\ys = TT)" +by (cases "x :# xs \ \ \ y :# ys \ \") auto + +lemma append_prefixD: + assumes "prefix\(xs :@ ys)\zs = TT" + shows "prefix\xs\zs = TT" +using assms +proof(induct xs arbitrary: zs) + case (snil zs) then show ?case using prefix.simps(2) by force +next + case (scons x xs zs) then show ?case + by (metis prefix.simps(1) prefix_scons_snil sappend_scons scons_prefix_scons slist.exhaust) +qed simp + +lemma same_prefix_prefix[simp]: + assumes "xs \ \" + shows "prefix\(xs :@ ys)\(xs :@ zs) = prefix\ys\zs" +using assms +proof(cases "ys = \" "zs = \" rule: bool.exhaust[case_product bool.exhaust]) + case False_False with assms show ?thesis by (induct xs) simp_all +qed simp_all + +lemma eq_prefix_TT: + assumes "eq\xs\ys = TT" + shows "prefix\xs\ys = TT" +using assms by (induct xs arbitrary: ys) (case_tac ys; simp)+ + +lemma prefix_eq_FF: + assumes "prefix\xs\ys = FF" + shows "eq\xs\ys = FF" +using assms by (induct xs arbitrary: ys) (case_tac ys; auto)+ + +lemma prefix_slength_eq: + shows "eq\xs\ys = (eq\(slength\xs)\(slength\ys) andalso prefix\xs\ys)" +proof(induct xs arbitrary: ys) + case (snil ys) then show ?case + by (cases ys; clarsimp simp: one_Integer_def elim!: slengthE) +next + case (scons x xs ys) then show ?case + by (cases ys; clarsimp simp: zero_Integer_def one_Integer_def elim!: slengthE) +qed simp + +lemma stake_slength_plus_1: + shows "stake\(slength\xs + 1)\(y :# ys) = y :# stake\(slength\xs)\ys" +by (cases "xs = \" "y = \" "ys = \" rule: bool.exhaust[case_product bool.exhaust bool.exhaust]; clarsimp) + (auto simp: If2_def[symmetric] zero_Integer_def one_Integer_def split: If2_splits elim!: slengthE) + +lemma sdrop_slength_plus_1: + assumes "y \ \" + shows "sdrop\(slength\xs + 1)\(y :# ys) = sdrop\(slength\xs)\ys" +using assms +by (subst sdrop.simps; + cases "xs = \"; clarsimp; cases "ys = \"; + clarsimp simp: If2_def[symmetric] zero_Integer_def one_Integer_def split: If2_splits elim!: slengthE) + +lemma eq_take_length_prefix: "prefix\xs\ys = eq\xs\(stake\(slength\xs)\ys)" +proof (induct xs arbitrary: ys) + case (snil ys) show ?case by (cases ys; clarsimp) +next + case (scons x xs ys) + note IH = this + show ?case + proof (cases "slength\xs = \") + case True then show ?thesis by simp + next + case False + show ?thesis + proof (cases ys) + case bottom + then show ?thesis using False + using le_slength_plus[of xs 1] by simp + next + case snil then show ?thesis using False and IH(1,2) by simp + next + case (scons z zs) + then show ?thesis + using False and IH(1,2) IH(3)[of zs] + by (simp add: stake_slength_plus_1 monofun_cfun_arg) + qed + qed +qed simp + +lemma prefix_sdrop_slength: + assumes "prefix\xs\ys = TT" + shows "xs :@ sdrop\(slength\xs)\ys = ys" +using assms by (induct xs arbitrary: ys) (case_tac ys; simp add: sdrop_slength_plus_1)+ + +lemma prefix_sdrop_prefix_eq: + assumes "prefix\xs\ys = TT" + shows "eq\(sdrop\(slength\xs)\ys)\[::] = eq\ys\xs" +using assms by (induct xs arbitrary: ys) (case_tac ys; simp add: sdrop_slength_plus_1)+ +(*<*) + +end +(*>*) diff --git a/thys/BirdKMP/document/programs/KMP.cml b/thys/BirdKMP/document/programs/KMP.cml new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/programs/KMP.cml @@ -0,0 +1,77 @@ +(* Bird's version of Knuth-Morris-Pratt string matching. + Chapter 17, "Pearls of Functional Algorithm Design", 2010. + - with the `K' (next) optimisation + - using backpatching + - in CakeML 1203 (~ 2020-04-07) + *) + +structure KMP = +struct + +datatype 'a thunk = Val 'a | Thunk (unit -> 'a); + +type 'a lazy = 'a thunk ref; + +fun lazy f = + Ref (Thunk f); + +fun force su = + case !su of + Val v => v + | Thunk f => let val v = f () in su := Val v; v end; + +datatype 'a tree + = Null + | Node ('a list) ('a tree lazy) ('a tree); + +type 'a ltree = 'a tree lazy; + +exception Fail string; + +fun kmatches eq ws = + let + fun ok t = case force t of Node [] l r => True | _ => False + fun next x t = + lazy (fn () => let val t = force t in case t of + Null => Null + | Node [] _ _ => t + | Node (v :: vs) l _ => if eq x v then force l else t end) + (* Backpatching! *) + val root = lazy (fn () => raise Fail "blackhole") + fun op' t x = + lazy (fn () => case force t of + Null => force root + | Node vvs l r => + (case vvs of + [] => force (op' l x) + | v :: vs => if eq x v then r else force (op' l x))) + and grep l vvs = + ( case vvs of + [] => Node [] l Null + | v :: vs => Node vvs (next v l) (grep (op' l v) vs) ) + val () = root := Thunk (fn () => grep (lazy (fn () => Null)) ws) + fun step nt x = (fst nt + 1, op' (snd nt) x) + fun rheight t = + case t of Null => 0 | Node _ _ r => 1 + rheight r + fun driver nt xxs = + case xxs of + [] => if ok (snd nt) then [fst nt] else [] + | x :: xs => let val nt' = step nt x + in if ok (snd nt) then fst nt :: driver nt' xs else driver nt' xs end + in + driver (0, root) + end; + +end; + +KMP.kmatches (op =) [] [] ; +KMP.kmatches (op =) [] [1,2,3] ; +KMP.kmatches (op =) [1, 2, 1] [] ; +KMP.kmatches (op =) [1, 2] [1, 2, 3] ; +KMP.kmatches (op =) [1, 2, 3, 1, 2] [1, 2, 1, 2, 3, 1, 2, 3, 1, 2] ; + +List.app (fn x => print (Int.toString x ^ "\n")) + (KMP.kmatches (op =) [1, 2, 3, 1, 2] [1, 2, 1, 2, 3, 1, 2, 3, 1, 2]) ; + +val text = List.concat (List.tabulate 1000000 (fn _ => [1, 2, 1, 2, 3, 1, 2, 3, 1, 2])); +val _ = (fn x => print (Int.toString (List.length x) ^ "\n")) (KMP.kmatches (op =) [1, 2, 3, 1, 2] text); diff --git a/thys/BirdKMP/document/programs/KMP.hs b/thys/BirdKMP/document/programs/KMP.hs new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/programs/KMP.hs @@ -0,0 +1,60 @@ +module KMP where + +-- For testing +import Data.List ( isInfixOf ) +import qualified Test.QuickCheck as QC + +-- Bird's Morris-Pratt string matcher, without the `K' optimisation +-- Chapter 17, "Pearls of Functional Algorithm Design", 2010. + +data Tree a = Null + | Node [a] (Tree a) {- ! -} (Tree a) -- remains correct with strict right subtrees + +matches :: Eq a => [a] -> [a] -> [Integer] +matches ws = map fst . filter (ok . snd) . scanl step (0, root) + where + ok (Node vs _l _r) = null vs + step (n, t) x = (n + 1, op t x) + + op Null _x = root + op (Node [] l _r) x = op l x + op (Node (v : _vs) l r) x = if x == v then r else op l x + + root = grep Null ws + + grep l [] = Node [] l Null + grep l vvs@(v : vs) = Node vvs l (grep (op l v) vs) + +-- matches [1,2,3,1,2] [1,2,1,2,3,1,2,3,1,2] + +-- Our KMP (= MP with the `K` optimisation) + +kmatches :: Eq a => [a] -> [a] -> [Integer] +kmatches ws = map fst . filter (ok . snd) . scanl step (0, root) + where + ok (Node vs _l _r) = null vs + step (n, t) x = (n + 1, op t x) + + op Null _x = root + op (Node [] l _r) x = op l x + op (Node (v : _vs) l r) x = if x == v then r else op l x + + root = grep Null ws + + next _x Null = Null + next _x t@(Node [] _l _r) = t + next x t@(Node (v : _vs) l _r) = if x == v then l else t + + grep l [] = Node [] l Null + grep l vvs@(v : vs) = Node vvs (next v l) (grep (op l v) vs) + +prop_matches :: [Bool] -> [Bool] -> Bool +prop_matches as bs = (as `isInfixOf` bs) == (as `matches` bs /= []) + +prop_kmatches :: [Bool] -> [Bool] -> Bool +prop_kmatches as bs = (as `matches` bs) == (as `kmatches` bs) + +tests :: IO () +tests = + do QC.quickCheck prop_matches + QC.quickCheck prop_kmatches diff --git a/thys/BirdKMP/document/programs/KMP.ml b/thys/BirdKMP/document/programs/KMP.ml new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/programs/KMP.ml @@ -0,0 +1,53 @@ +(* Bird's Morris-Pratt string matcher, with the `K' optimisation in ocaml + Chapter 17, "Pearls of Functional Algorithm Design", 2010. *) + +(* +Encoding the requisite laziness is fiddly: + - as Wadler observes this style is `odd` + - forced to use `Lazy.t` to share `root` + - intuitively need to manually manage how demand is transferred + through the computation. +*) + +type 'a tree + = Null + | Node of 'a list * 'a ltree * 'a tree +and 'a ltree = 'a tree Lazy.t + +let kmatches (type a) (eq: a -> a -> bool) (ws: a list) : a list -> int list = + let ok (t: a ltree) : bool = match Lazy.force t with Node (vs, l, r) -> vs = [] + in let next (x: a) (t: a ltree) : a ltree = + lazy (let t = Lazy.force t in match t with + Null -> Null + | Node ([], _l, _r) -> t + | Node (v :: vs, l, _r) -> if eq x v then Lazy.force l else t) + in let rec op (t: a ltree) (x: a) : a ltree = + lazy (match Lazy.force t with + Null -> Lazy.force root + | Node (vvs, l, r) -> + (match vvs with + [] -> Lazy.force (op l x) + | v :: vs -> if eq x v then r else Lazy.force (op l x))) + and grep (l: a ltree) (vvs: a list) : a tree = + match vvs with + [] -> Node ([], l, Null) + | v :: vs -> Node (vvs, next v l, grep (op l v) vs) + and root : a ltree = lazy (grep (lazy Null) ws) + in let step (nt: int * a ltree) (x: a) : int * a ltree = + fst nt + 1, op (snd nt) x + in let rec rheight (t: a tree) = + match t with Null -> 0 | Node (_, _, r) -> 1 + rheight r + in let rec driver (nt: int * a ltree) (xxs: a list) : int list = + match xxs with + [] -> if ok (snd nt) then [fst nt] else [] + | x :: xs -> let nt' : int * a ltree = step nt x + in if ok (snd nt) then fst nt :: driver nt' xs else driver nt' xs + in driver (0, root) + +;; + +List.iter (Printf.printf "%d ") (kmatches (=) [] []) ; +List.iter (Printf.printf "%d ") (kmatches (=) [] [1;2;3]) ; +List.iter (Printf.printf "%d ") (kmatches (=) [1;2;1] []) ; +List.iter (Printf.printf "%d ") (kmatches (=) [1;2] [1;2;3]) ; +List.iter (Printf.printf "%d ") (kmatches (=) [1;2;3;1;2] [1;2;1;2;3;1;2;3;1;2]) ; diff --git a/thys/BirdKMP/document/programs/KMP.pl b/thys/BirdKMP/document/programs/KMP.pl new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/programs/KMP.pl @@ -0,0 +1,44 @@ +% -*- mode: prolog -*- +% Bird's Morris-Pratt string matcher +% Chapter 17, "Pearls of Functional Algorithm Design", 2010. +% - adapted to use rational trees. +% - with the `K' (next) optimisation +% Tested with SWI Prolog, which has good support for rational trees. + +% root/2 (+, -) det +root(Ws, T) :- grep(T, null, Ws, T). + +% op/4 (?, +, +, -) det <-- Root may or may not be fully ground +op(Root, null, _X, Root). +op(Root, node([], L, _R), X, T) :- op(Root, L, X, T). +op(Root, node([V|_Vs], L, R), X, T) :- + (X = V -> T = R ; op(Root, L, X, T)). + +% next/3 (+, +, -) det +next(_X, null, null). +next(_X, node([], L, R), node([], L, R)). +next( X, node([V|Vs], L, R), T) :- ( X = V -> T = L ; T = node([V|Vs], L, R) ). + +% grep/4 (+, +, +, -) det +grep(_Root, L, [], node([], L, null)). +grep( Root, L, [V|Vs], node([V|Vs], L1, R)) :- + next(V, L, L1), op(Root, L, V, T), grep(Root, T, Vs, R). + +% ok/1 (+) det +ok(node([], _L, _R)). + +%% Driver + +% matches_aux/5 (+, +, +, +, -) det +matches_aux(_Root, N, T, [], Ns) :- ( ok(T) -> Ns = [N] ; Ns = [] ). +matches_aux( Root, N, T, [X|Xs], Ns) :- + N1 is N + 1, op(Root, T, X, T1), + ( ok(T) -> ( Ns = [N|Ns1], matches_aux(Root, N1, T1, Xs, Ns1) ) + ; matches_aux(Root, N1, T1, Xs, Ns) ). + +% matches/3 (+, +, -) det +matches(Ws, Txt, Ns) :- root(Ws, Root), matches_aux(Root, 0, Root, Txt, Ns). + +% :- root([1,2,1], Root). +% :- root([1,2,1,1,2], Root). +% :- matches([1,2,3,1,2], [1,2,1,2,3,1,2,3,1,2], Ns). diff --git a/thys/BirdKMP/document/programs/KMP.sml b/thys/BirdKMP/document/programs/KMP.sml new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/programs/KMP.sml @@ -0,0 +1,73 @@ +(* Bird's Morris-Pratt string matcher + Chapter 17, "Pearls of Functional Algorithm Design", 2010. + - with the `K' (next) optimisation + - using backpatching + *) + +structure KMP :> sig val kmatches : ('a * 'a -> bool) -> 'a list -> 'a list -> int list end = +struct + +datatype 'a thunk = Val of 'a | Thunk of unit -> 'a + +type 'a lazy = 'a thunk ref + +fun lazy (f: unit -> 'a) : 'a lazy = + ref (Thunk f) + +fun force (su : 'a lazy) : 'a = + case !su of + Val v => v + | Thunk f => let val v = f () in su := Val v; v end + +datatype 'a tree + = Null + | Node of 'a list * 'a tree lazy * 'a tree + +type 'a ltree = 'a tree lazy + +fun kmatches (eq: 'a * 'a -> bool) (ws: 'a list) : 'a list -> int list = + let + fun ok (t: 'a ltree) : bool = case force t of Node ([], l, r) => true | _ => false + fun next (x: 'a) (t: 'a ltree) : 'a ltree = + lazy (fn () => let val t = force t in case t of + Null => Null + | Node ([], _, _) => t + | Node (v :: vs, l, _) => if eq (x, v) then force l else t end) + (* Backpatching! *) + val root : 'a ltree = lazy (fn () => raise Fail "blackhole") + fun op' (t: 'a ltree) (x: 'a) : 'a ltree = + lazy (fn () => case force t of + Null => force root + | Node (vvs, l, r) => + (case vvs of + [] => force (op' l x) + | v :: vs => if eq (x, v) then r else force (op' l x))) + and grep (l: 'a ltree) (vvs: 'a list): 'a tree = + ( (* print "grep: produce node\n"; *) case vvs of + [] => Node ([], l, Null) + | v :: vs => Node (vvs, next v l, grep (op' l v) vs) ) + val () = root := Thunk (fn () => grep (lazy (fn () => Null)) ws) + fun step ((n, t): int * 'a ltree) (x: 'a) : int * 'a ltree = (n + 1, op' t x) + fun rheight (t: 'a tree) = + case t of Null => 0 | Node (_, _, r) => 1 + rheight r + fun driver ((n, t): int * 'a ltree) (xxs: 'a list) : int list = + case xxs of + [] => if ok t then [n] else [] + | x :: xs => let val nt' = step (n, t) x + in if ok t then n :: driver nt' xs else driver nt' xs end + in + driver (0, root) + end + +end; + +KMP.kmatches (op =) [] [] ; +KMP.kmatches (op =) [] [1,2,3] ; +KMP.kmatches (op =) [1, 2, 1] [] ; +KMP.kmatches (op =) [1, 2] [1, 2, 3] ; +KMP.kmatches (op =) [1, 2, 3, 1, 2] [1, 2, 1, 2, 3, 1, 2, 3, 1, 2] ; + +List.app (fn x => print (Int.toString x ^ "\n")) (KMP.kmatches (op =) [1, 2, 3, 1, 2] [1, 2, 1, 2, 3, 1, 2, 3, 1, 2]) ; + +val text = List.concat (List.tabulate (1000000, fn _ => [1, 2, 1, 2, 3, 1, 2, 3, 1, 2])); +val _ = (fn x => print (Int.toString (List.length x) ^ "\n")) (KMP.kmatches (op =) [1, 2, 3, 1, 2] text); diff --git a/thys/BirdKMP/document/root.bib b/thys/BirdKMP/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/root.bib @@ -0,0 +1,485 @@ +@STRING{LNCS="LNCS"} +@STRING{scp="Science of Computer Programming"} + +@article{BirdGibbonsJones:1989, + author = {Bird, R. S. and + Gibbons, J. and + Jones, G.}, + title = {Formal Derivation of a Pattern Matching Algorithm}, + journal = {Science of Computer Programming}, + volume = 12, + number = 2, + pages = {93--104}, + year = 1989, + doi = {10.1016/0167-6423(89)90036-1}, +} + +@book{Bird:PearlsofFAD:2010, + title = "Pearls of Functional Algorithm Design", + author = "R. S. Bird", + year = 2010, + isbn = 9780521513388, + publisher = "CUP", +} + +@incollection{Bird:1987, + title = "An Introduction to the Theory of Lists", + author = "R. S. Bird", + year = 1987, + booktitle = "Logic of Programming and Calculi of Discrete Design", + editor = "M. Broy", + note = "NATO ASI Series~F Volume~36. Also available as Technical Monograph PRG-56, from the Programming Research Group, Oxford University", + pages = "3--42", + publisher = "Springer-Verlag", +} + +@inproceedings{Bird:2005, + author = {R. S. Bird}, + title = {Polymorphic string matching}, + booktitle = {Haskell'2005}, + pages = {110--115}, + publisher = {{ACM}}, + year = 2005, + doi = {10.1145/1088348.1088359}, +} + +@article{TakeichiAkama:1990, + author = {Takeichi, M. and Akama, Y.}, + title = {Deriving a Functional {Knuth-Morris-Pratt} Algorithm by Transformation}, + journal = {Journal of Information Processing}, + issue_date = 1990, + volume = 13, + number = 4, + month = apr, + year = 1991, + pages = {522--528}, + numpages = 7, + publisher = {Information Processing Society of Japan}, + address = {Tokyo, Japan, Japan}, +} + +@article{Bird:2012, + author = {R. S. Bird}, + title = {On building cyclic and shared structures in {Haskell}}, + journal = {Formal Aspects of Computing}, + volume = 24, + number = {4-6}, + pages = {609--621}, + year = 2012, + doi = {10.1007/s00165-012-0243-6}, +} + +@inproceedings{Pettorossi:1987, + author = {A. Pettorossi}, + title = {Program Development Using Lambda Abstraction}, + booktitle = {FSTTCS'1987}, + series = LNCS, + volume = {287}, + pages = {420--434}, + year = 1987, + doi = {10.1007/3-540-18625-5_65}, +} + +@article{Bird:1977, + author = {R. S. Bird}, + title = {Improving Programs by the Introduction of Recursion}, + journal = {Communications of the {ACM}}, + volume = 20, + number = 11, + pages = {856--863}, + year = 1977, + doi = {10.1145/359863.359889}, +} + +@inproceedings{DanielssonHJG:2006, + author = {Danielsson, N. A. and + Hughes, J. and + Jansson, J. and + Gibbons, J.}, + title = {Fast and loose reasoning is morally correct}, + booktitle = {POPL 2006}, + publisher = {{ACM}}, + pages = {206--217}, + year = 2006, + doi = {10.1145/1111037.1111056}, +} + +@article{Pettorossi:1996, + author = {Pettorossi, A. and + Proietti, M.}, + title = {Rules and Strategies for Transforming Functional and Logic Programs}, + journal = {{ACM} Computing Surveys}, + volume = {28}, + number = {2}, + pages = {360--414}, + year = {1996}, + doi = {10.1145/234528.234529}, +} + +@article{AgerDanvyRohde:2006, + author = {M. S. Ager and + O. Danvy and + H. K. Rohde}, + title = {Fast partial evaluation of pattern matching in strings}, + journal = toplas, + volume = 28, + number = 4, + pages = {696--714}, + year = 2006, + doi = {10.1145/1146812}, +} + +@article{Scott:1976, + author = {D. S. Scott}, + title = {Data Types as Lattices}, + journal = {{SIAM} Journal of Computing}, + volume = 5, + number = 3, + pages = {522--587}, + year = 1976, + doi = {10.1137/0205037}, +} + +@book{Stoy:1977, + author = {J. E. Stoy}, + title = "Denotational Semantics: The {S}cott-{S}trachey Approach to Programming Language Theory", + year = {1977}, + publisher = {MIT Press}, +} + +@article{MannaNesVuillemin:1973, + author = {Manna, Z. and + Ness, S. and + Vuillemin, J.}, + title = {Inductive Methods for Proving Properties of Programs}, + journal = cacm, + volume = 16, + number = 8, + pages = {491--502}, + year = 1973, + doi = {10.1145/355609.362336}, +} + +@inproceedings{barbed-wire:1991, + abstract = {We develop a calculus for lazy functional programming based on recursion operators associated with data type definitions. For these operators we derive various algebraic laws that are useful in deriving and manipulating programs. We shall show that all example functions in Bird and Wadler's "Introduction to Functional Programming" can expressed using these operators.}, + author = {E. Meijer and M. Fokkinga and R. Paterson}, + booktitle = "FPCA'1991", + pages = {124--144}, + posted-at = {2008-08-18 18:44:21}, + priority = 2, + publisher = {Springer-Verlag}, + title = {Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire}, + year = 1991 +} + +@article{Gammie:2011, + author = {P. Gammie}, + title = {Short Note: Strict unwraps make worker/wrapper fusion totally correct}, + journal = {Journal of Functional Programming}, + year = 2011, + volume = 21, + pages = {209--213} +} + +@article{GillHutton:2009, + author = {A. Gill and G. Hutton}, + title = {The worker/wrapper transformation}, + journal = "Journal of Functional Programming", + publisher = {CUP}, + volume = 19, + number = 2, + pages = {227--251}, + month = {March}, + year = 2009 +} + +@book{Hutton:2016, + author = "G. Hutton", + title = "Programming in {Haskell}", + publisher = "CUP", + month = sep, + edition = "Second", + year = 2016 +} + +@inproceedings{Matthews:1999, + author = {J. Matthews}, + title = {Recursive Function Definition over Coinductive Types}, + booktitle = {TPHOLs'99}, + pages = {73--90}, + year = 1999, + doi = {10.1007/3-540-48256-3\_6}, +} + +@book{CrochemoreRytter:2002, + author = {M. Crochemore and W. Rytter}, + title = {Jewels of Stringology}, + publisher = {World Scientific}, + year = 2002, + isbn = {981-02-4782-6} +} + +@inproceedings{BlanchetteEtAl:2017, + author = {Blanchette, J. C. and + A. Bouzy and + A. Lochbihler and + A. Popescu and + D. Traytel}, + title = {Friends with Benefits - Implementing Corecursion in Foundational Proof + Assistants}, + booktitle = {ESOP'2017}, + publisher = {Springer}, + series = LNCS, + volume = 10201, + pages = {111--140}, + year = 2017, + doi = {10.1007/978-3-662-54434-1\_5}, +} + +% Worked with Irving on Stable Marriage +@book{Gusfield:1997, + author = {D. Gusfield}, + title = {Algorithms on Strings, Trees, and Sequences - Computer Science and + Computational Biology}, + publisher = {CUP}, + year = 1997, + isbn = {0-521-58519-8}, +} + +@article{HinzeJeuring:2001, + author = {R. Hinze and + J. Jeuring}, + title = {Weaving a web}, + journal = {Journal of Functional Programming}, + volume = 11, + number = 6, + pages = {681--689}, + year = 2001, + doi = {10.1017/S0956796801004129}, +} + +@article{JeanninEtAl:2017, + author = {J.{-}B. Jeannin and + D. Kozen and + A. Silva}, + title = {CoCaml: Functional Programming with Regular Coinductive Types}, + journal = {Fundamenta Informaticae}, + volume = 150, + number = {3-4}, + pages = {347--377}, + year = 2017, + doi = {10.3233/FI-2017-1473}, +} + +@article{Courcelle:1983, + author = {B. Courcelle}, + title = {Fundamental Properties of Infinite Trees}, + journal = TCS, + volume = 25, + pages = {95--169}, + year = 1983, + doi = {10.1016/0304-3975(83)90059-2}, +} + +@InCollection{Colmerauer:1982, + author = "A. Colmerauer", + title = "{Prolog} and infinite trees", + booktitle = "Logic Programming", + publisher = "Academic Press", + year = "1982", + editor = "K. L. Clark and S. -\AA. Tarnlund", + pages = "107--114", +} + +@article{GiannesiniCohen:1984, + author = {F. Giannesini and + J. Cohen}, + title = {Parser Generation and Grammar Manipulation Using {Prolog}'s Infinite + Trees}, + journal = {Journal of Logic Programming}, + volume = 1, + number = 3, + pages = {253--265}, + year = 1984, + doi = {10.1016/0743-1066(84)90013-X}, +} + +@inproceedings{DanvyThiemannZerny:2013, + author = {O. Danvy and + P. Thiemann and + I. Zerny}, + title = {Circularity and Lambda Abstraction: From {Bird} to {Pettorossi} and back}, + publisher = {{ACM}}, + booktitle = {IFL'2013}, + pages = 85, + year = 2013, + doi = {10.1145/2620678.2620687}, +} + +@inproceedings{Danielsson:2010, + author = {N. A. Danielsson}, + title = {Total parser combinators}, + publisher = {{ACM}}, + booktitle = {ICFP'2010}, + pages = {285--296}, + year = 2010, + doi = {10.1145/1863543.1863585}, +} + +@article{HOLCF:1999, + author = {O. M\"uller and T. Nipkow and von Oheimb, D. and O. Slotosch}, + title = {{HOLCF = HOL + LCF}}, + journal="Journal of Functional Programming",volume=9,pages={191--223}, + year=1999 +} + +@article{BurstallDarlington:1977, + author = {R. M. Burstall and J. Darlington}, + title = {A Transformation System for Developing Recursive Programs}, + journal = jacm, + volume = 24, + number = 1, + year = 1977, + pages = {44--67}, + doi = {10.1145/321992.321996}, + publisher = {ACM}, + address = {New York, NY, USA}, + } + +@article{HOLCF-Prelude-AFP:2017, + author = {J. Breitner and + B. Huffman and + N. Mitchell and + C. Sternagel}, + title = {{HOLCF-Prelude}}, + journal = {Archive of Formal Proofs}, + year = 2017, + url = {https://www.isa-afp.org/entries/HOLCF-Prelude.shtml}, +} + +@article{KnuthMorrisPratt:1977, + author = {D. E. Knuth and + Morris Jr., J. H. and + V. R. Pratt}, + title = {Fast Pattern Matching in Strings}, + journal = {{SIAM} Journal on Computing}, + volume = 6, + number = 2, + pages = {323--350}, + year = 1977, + doi = {10.1137/0206024}, +} + +@inproceedings{LochbihlerMaximova:2015, + author = {A. Lochbihler and + A. Maximova}, + title = {Stream Fusion for {Isabelle}'s Code Generator - Rough Diamond}, + booktitle = {ITP'2015}, + series = lncs, + volume = 9236, + publisher = {Springer}, + pages = {270--277}, + year = 2015, + doi = {10.1007/978-3-319-22102-1\_18}, +} + +@article{Huffman:2009, + author = {B. Huffman}, + title = {Stream Fusion}, + journal = {Archive of Formal Proofs}, + month = apr, + year = 2009, + url = "http://isa-afp.org/entries/Stream-Fusion.html", +} + +@inproceedings{TurbakWells:2001, + author = {F. A. Turbak and + J. B. Wells}, + title = {Cycle Therapy: {A} Prescription for Fold and Unfold on Regular Trees}, + booktitle = {PPDP'2001}, + publisher = {{ACM}}, + pages = {137--149}, + year = 2001, + doi = {10.1145/773184.773200}, +} + +@article{Sijtsma:1989, + author = {Ben A. Sijtsma}, + title = {On the Productivity of Recursive List Definitions}, + journal = toplas, + volume = 11, + number = 4, + pages = {633--649}, + year = 1989, + doi = {10.1145/69558.69563}, +} + +@article{vanderWoude:1989, + author = {van der Woude, J.}, + title = {Playing with Patterns, Searching for Strings}, + journal = scp, + volume = 12, + number = 3, + pages = {177--190}, + year = 1989, + doi = {10.1016/0167-6423(89)90001-4}, +} + +@phdthesis{Tullsen:PhDThesis, + author = {M. Tullsen}, + title = {{PATH}, a Program Transformation System for {H}askell}, + year = {2002}, + isbn = {0-493-60483-9}, + order_no = {AAI3046238}, + school = {Yale University}, + address = {New Haven, CT, USA}, + url = "http://www.cs.yale.edu/publications/techreports/tr1229.pdf" +} + +@misc{Pottier:2012, + author = "F. Pottier", + title = "Reconstructing the {Knuth-Morris-Pratt} algorithm", + year = 2012, + url = "http://gallium.inria.fr/blog/kmp/" +} + +@book{Paulson:1987, + author = {L. C. Paulson}, + title = {Logic and computation - interactive proof with {Cambridge LCF}}, + series = {Cambridge Tracts in Theoretical Computer Science}, + volume = 2, + publisher = {CUP}, + year = 1987, + isbn = {978-0-521-34632-0}, +} + +@inproceedings{Huffman:2009a, + author = {B. Huffman}, + title = {A Purely Definitional Universal Domain}, + booktitle = "{TPHOL}s", + series = lncs, + volume = 5674, + year = 2009, + pages = {260-275}, + doi = "10.1007/978-3-642-03359-9_19", +} + +@inproceedings{Altenkirch:2001, + author = {T. Altenkirch}, + title = {Representations of First Order Function Types as Terminal Coalgebras}, + booktitle = {{TLCA} 2001}, + series = lncs, + volume = 2044, + pages = {8--21}, + publisher = {Springer}, + year = 2001, + doi = {10.1007/3-540-45413-6_5}, +} + +@book{SterlingShapiro:1994, + author = {L. Sterling and E. Shapiro}, + title = {The Art of Prolog - Advanced Programming Techniques}, + publisher = {{MIT} Press}, + year = 1994, + edition = "2nd" +} diff --git a/thys/BirdKMP/document/root.tex b/thys/BirdKMP/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/BirdKMP/document/root.tex @@ -0,0 +1,250 @@ +\documentclass[11pt,a4paper]{article} +\usepackage[a4paper,margin=1cm,footskip=.5cm]{geometry} +\usepackage{amsfonts} +\usepackage{amsmath} +\usepackage{isabelle,isabellesym} + +\usepackage{graphicx} +\usepackage{wrapfig} + +\usepackage[utf8]{inputenc} + +% Bibliography +\usepackage[authoryear,sort]{natbib} +\bibpunct();A{}, + +% Allow pdflatex to do some fancier spacing. +\usepackage{microtype} + +\usepackage{fancyvrb} + +\usepackage{tikz} +\usetikzlibrary{arrows,automata,cd,positioning} + +% 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} + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +\title{Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching} +\author{Peter Gammie} +\maketitle + +\begin{abstract} + \noindent 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. +\end{abstract} + + +\tableofcontents + + +\section{Introduction\label{sec:introduction}} + +We formalize a derivation of the string-matching algorithm of +\citet{KnuthMorrisPratt:1977} (KMP) due to +\citet[Chapter~17]{Bird:PearlsofFAD:2010}. The central novelty of this +approach is its use of a circular data structure to simultaneously +compute and represent the failure function; see +Figure~\ref{fig:haskell-kmp} for the final program. This is +challenging to model in a logic of total functions, as we discuss +below, which leads us to employ the venerable machinery of domain +theory. + +\begin{figure} + \VerbatimInput[fontsize=\small]{programs/KMP.hs} + \caption{Bird's KMP as a Haskell program.} + \label{fig:haskell-kmp} +\end{figure} + +Our development completes Bird's derivation of the Morris-Pratt (MP) +algorithm with proofs that each derivation step preserves +productivity, yielding total correctness; in other words, we show that +this circular program is extensionally equal to its specification. We +also add what we call the `K' optimisation to yield the full KMP +algorithm (\S\ref{sec:KMP:data_refinement}). Our analysis inspired a +Prolog implementation (\S\ref{sec:implementations}) that some may find +more perspicuous. + +Here we focus on the formalities of this style of program refinement +and defer further background on string matching to two excellent +monographs: \citet[\S2.3]{Gusfield:1997} and +\citet[\S2.1]{CrochemoreRytter:2002}. Both provide traditional +presentations of the problem, the KMP algorithm and correctness proofs +and complexity results. + +We discuss related work in \S\ref{sec:related-work}. + + +\subsection{Formal setting\label{sec:formal_setting}} + +Bird does not make his formal context explicit. The program requires +non-strict datatypes and sharing to obtain the expected complexity, +which implies that he is working in a lazy (call-by-need) +language. For reasons we observe during our development in +\S\ref{sec:KMP}, some of Bird's definitions are difficult to make +directly in Isabelle/HOL (a logic of total functions over types +denoting sets) using the existing mechanisms. + +We therefore adopt domain theory as mechanised by \texttt{HOLCF} +\citep{HOLCF:1999}. This logic provides a relatively straightforward +if awkward way to reason about non-strict (call-by-name) programs at +the cost of being too abstract to express sharing. + +Bird's derivation implicitly appeals to the fold/unfold framework of +\citet{BurstallDarlington:1977}, which guarantees the preservation of +partial correctness: informally, if the implementation terminates then +it yields a value that coincides with the specification, or +$\mbox{implementation} \sqsubseteq \mbox{specification}$ in +domain-theoretic terms. These rules come with side conditions that +would ensure that productivity is preserved -- that the implementation +and specification are moreover extensionally equal -- but Bird does +not establish them. We note that it is easy to lose productivity +through subtle uses of cyclic data structures (see +\S\ref{sec:KMP:increase_sharing} in particular), and that this +derivation does not use well-known structured recursion patterns like +\emph{map} or \emph{foldr} that mitigate these issues. + +We attempt to avoid the confusions that can arise when transforming +programs with named expressions (definitions or declarations) by +making each step in the derivation completely self-contained: +specifically, all definitions that change or depend on a definition +that changes are redefined at each step. Briefly this avoids the +conflation of equations with definitions; for instance, $f = f$ holds +for all functions but makes for a poor definition. The issues become +more subtle in the presence of recursion modelled as least fixed +points, where satisfying a fixed-point equation $F f = f$ does not +always imply the desired equality $f = \mbox{lfp}\ +F$. \citet{Tullsen:PhDThesis} provides a fuller discussion. + +As our main interest is the introduction of the circular data +structure (\S\ref{sec:KMP:data_refinement}), we choose to work with +datatypes that simplify other aspects of this story. Specifically we +use strict lists (\S\ref{sec:theory_of_lists}) as they allow us to +adapt many definitions and lemmas about HOL's lists and localise (the +many!) definedness conditions. We also impose strong conditions on +equality (\S\ref{sec:equality}) for similar reasons, and, less +critically, assume products behave pleasantly +(\S\ref{sec:KMP:specification}). Again \citet{Tullsen:PhDThesis} +discusses how these may violate Haskell expectations. + +We suggest the reader skip the next two sections and proceed to the +derivation which begins in \S\ref{sec:KMP}. + +% generated text of all theories +\input{session} + + +\section{Related work\label{sec:related-work}} + +Derivations of KMP matching are legion and we do not attempt to +catalogue them here. + +Bird and colleagues have presented versions of this story at least +four times. All treat MP, not KMP (see +\S\ref{sec:KMP:data_refinement}), and use a style of equational +reasoning with fold/unfold transformations +\citep{BurstallDarlington:1977} that only establishes partial +correctness (see \S\ref{sec:formal_setting}). Briefly: + +\begin{itemize} + +\item The second example of \citet{Bird:1977} is an imperative program + that is similar to MP. + +\item \citet{BirdGibbonsJones:1989} devised the core of the derivation + mechanized here, notably omitting a formal justification for the + final data refinement step that introduces the circular data + structure. + +\item \citet{Bird:2005} refines \citet{BirdGibbonsJones:1989} and + derives Boyer-Moore matching \citep[\S2.2]{Gusfield:1997} in a + similar style. + +\item \citet[Chapter~17]{Bird:PearlsofFAD:2010} further refines + \citet{Bird:2005} and is the basis of the work discussed here. + \citet[\S3.1]{Bird:2012} contains some further relevant remarks. + +\end{itemize} + +\citet{AgerDanvyRohde:2006} show how KMP matchers (specialised to a +given pattern) can be derived by the partial evaluation of an initial +program in linear time. We observe that neither their approach, of +incorporating the essence of KMP in their starting point, nor Bird's +of introducing it by data refinement +(\S\ref{sec:KMP:data_refinement}), provides a satisfying explanation +of how KMP could be discovered; \citet{Pottier:2012} attempts to do +this. In contrast to Bird, these and most other presentations make +heavy use of arrays and array indexing which occludes the central +insights. + + +\section{Implementations\label{sec:implementations}} + +With varying amounts of effort we can translate our final program of +\S\ref{sec:KMP:final_version} into a variety of languages. The most +direct version, in Haskell, was shown in +Figure~\ref{fig:haskell-kmp}. An ocaml version is similar due to that +language's support for laziness. In contrast Standard ML requires an +encoding; we use backpatching as shown in Figure~\ref{fig:sml-kmp}. In +both cases the tree datatype can be made strict in the right branch as +it is defined by primitive recursion on the pattern. + +More interestingly, our derivation suggests that Bird's KMP program +can be computed using \emph{rational} trees (also known as +\emph{regular} trees \citep{Courcelle:1983}), which are traditionally +supported by Prolog implementations. Our version is shown in +Figure~\ref{fig:prolog-kmp}. This demonstrates that the program could +instead be thought of as a computation over difference +structures. \citet{Colmerauer:1982,GiannesiniCohen:1984} provide more +examples of this style of programming. We leave a proof of correctness +to future work. + +\begin{figure} + \VerbatimInput[fontsize=\small]{programs/KMP.pl} + \caption{The final KMP program transliterated into Prolog.} + \label{fig:prolog-kmp} +\end{figure} + +\begin{figure} + \VerbatimInput[fontsize=\small,lastline=62]{programs/KMP.sml} % FIXME brittle + \caption{The final KMP program transliterated into Standard ML.} + \label{fig:sml-kmp} +\end{figure} + +\section{Concluding remarks} + +Our derivation leans heavily on domain theory's ability to reason +about partially-defined objects that are challenging to handle at +present in a language of total functions. Conversely it is too +abstract to capture the operational behaviour of the program as it +does not model laziness. It would also be interesting to put the data +refinement of \S\ref{sec:KMP:data_refinement} on a firmer foundation +by deriving the memoizing datatype from the direct program of +\S\ref{sec:KMP:specification}. Haskell fans may care to address the +semantic discrepancies mentioned in \S\ref{sec:formal_setting}. + + +\bibliographystyle{plainnat} +\bibliography{root} +\addcontentsline{toc}{section}{References} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Inductive_Inference/CONS_LIM.thy b/thys/Inductive_Inference/CONS_LIM.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/CONS_LIM.thy @@ -0,0 +1,544 @@ +section \CONS is a proper subset of LIM\label{s:cons_lim}\ + +theory CONS_LIM + imports Inductive_Inference_Basics +begin + +text \That there are classes in @{term "LIM - CONS"} was noted by +Barzdin~\cite{b-iiafp-74,b-iiafp-77} and Blum and Blum~\cite{bb-tmtii-75}. It +was proven by Wiehagen~\cite{w-lerfss-76} (see also Wiehagen and +Zeugmann~\cite{wz-idmowle-94}). The proof uses this class:\ + +definition U_LIMCONS :: "partial1 set" ("U\<^bsub>LIM-CONS\<^esub>") where + "U\<^bsub>LIM-CONS\<^esub> \ {vs @ [j] \ p| vs j p. j \ 2 \ p \ \\<^sub>0\<^sub>1 \ \ j = vs @ [j] \ p}" + +text \Every function in @{term "U\<^bsub>LIM-CONS\<^esub>"} carries a Gödel number +greater or equal two of itself, after which only zeros and ones occur. +Thus, a strategy that always outputs the rightmost value greater or equal two +in the given prefix will converge to this Gödel number. + +The next function searches an encoded list for the rightmost element +greater or equal two.\ + +definition rmge2 :: partial1 where + "rmge2 e \ + if \i e_nth e i \ 2))" + +lemma rmge2: + assumes "xs = list_decode e" + shows "rmge2 e = + (if \i xs ! i \ 2)))" +proof - + have "(i < e_length e \ e_nth e i \ 2) = (i < length xs \ xs ! i \ 2)" for i + using assms by simp + then have "(GREATEST i. i < e_length e \ e_nth e i \ 2) = + (GREATEST i. i < length xs \ xs ! i \ 2)" + by simp + moreover have "(\ii xs ! i \ 2) < length xs" (is "Greatest ?P < _") + if "\ (\i n) = + (if \i the (f i) \ 2))))" +proof - + let ?xs = "prefix f n" + have "f \ n = list_encode ?xs" by (simp add: init_def) + moreover have "(\ii the (f i) \ 2) = + (GREATEST i. i < length ?xs \ ?xs ! i \ 2)" + using length_prefix[of f n] prefix_nth[of _ n f] by metis + moreover have "(GREATEST i. i < Suc n \ the (f i) \ 2) < Suc n" + if "\ (\ii. i the (f i) \ 2" n] by fastforce + ultimately show ?thesis using rmge2 by auto +qed + +corollary rmge2_init_total: + assumes "total1 f" + shows "rmge2 (f \ n) = + (if \i the (f i) \ 2))" + using assms total1_def rmge2_init by auto + +lemma rmge2_in_R1: "rmge2 \ \" +proof - + define g where + "g = Cn 3 r_ifle [r_constn 2 2, Cn 3 r_nth [Id 3 2, Id 3 0], Cn 3 r_nth [Id 3 2, Id 3 0], Id 3 1]" + then have "recfn 3 g" by simp + then have g: "eval g [j, r, e] \= (if 2 \ e_nth e j then e_nth e j else r)" for j r e + using g_def by simp + + let ?h = "Pr 1 Z g" + have "recfn 2 ?h" + by (simp add: \recfn 3 g\) + have h: "eval ?h [j, e] = + (if \i e_nth e i \ 2)))" for j e + proof (induction j) + case 0 + then show ?case using \recfn 2 ?h\ by auto + next + case (Suc j) + then have "eval ?h [Suc j, e] = eval g [j, the (eval ?h [j, e]), e]" + using \recfn 2 ?h\ by auto + then have *: "eval ?h [Suc j, e] \= + (if 2 \ e_nth e j then e_nth e j + else if \i e_nth e i \ 2)))" + using g Suc by auto + show ?case + proof (cases "\i e_nth e j") + case True + then have "eval ?h [Suc j, e] \= e_nth e j" + using * by simp + moreover have "(GREATEST i. i < Suc j \ e_nth e i \ 2) = j" + using ex True Greatest_equality[of "\i. i < Suc j \ e_nth e i \ 2"] + by simp + ultimately show ?thesis using ex by auto + next + case False + then have "\i 2" + using ex leI less_Suc_eq by blast + with * have "eval ?h [Suc j, e] \= e_nth e (GREATEST i. i < j \ e_nth e i \ 2)" + using False by (smt leD) + moreover have "(GREATEST i. i < Suc j \ e_nth e i \ 2) = + (GREATEST i. i < j \ e_nth e i \ 2)" + using False ex by (metis less_SucI less_Suc_eq less_antisym numeral_2_eq_2) + ultimately show ?thesis using ex by metis + qed + qed + qed + + let ?hh = "Cn 1 ?h [Cn 1 r_length [Id 1 0], Id 1 0]" + have "recfn 1 ?hh" + using `recfn 2 ?h` by simp + with h have hh: "eval ?hh [e] \= + (if \i e_nth e i \ 2))" for e + by auto + then have "eval ?hh [e] = rmge2 e" for e + unfolding rmge2_def by auto + moreover have "total ?hh" + using hh totalI1 `recfn 1 ?hh` by simp + ultimately show ?thesis using `recfn 1 ?hh` by blast +qed + +text \The first part of the main result is that @{term "U\<^bsub>LIM-CONS\<^esub> \ LIM"}.\ + +lemma U_LIMCONS_in_Lim: "U\<^bsub>LIM-CONS\<^esub> \ LIM" +proof - + have "U\<^bsub>LIM-CONS\<^esub> \ \" + unfolding U_LIMCONS_def using prepend_in_R1 RPred1_subseteq_R1 by blast + have "learn_lim \ U\<^bsub>LIM-CONS\<^esub> rmge2" + proof (rule learn_limI) + show "environment \ U\<^bsub>LIM-CONS\<^esub> rmge2" + using \U_LIMCONS \ \\ phi_in_P2 rmge2_def rmge2_in_R1 by simp + show "\i. \ i = f \ (\\<^sup>\n. rmge2 (f \ n) \= i)" if "f \ U\<^bsub>LIM-CONS\<^esub>" for f + proof - + from that obtain vs j p where + j: "j \ 2" + and p: "p \ \\<^sub>0\<^sub>1" + and s: "\ j = vs @ [j] \ p" + and f: "f = vs @ [j] \ p" + unfolding U_LIMCONS_def by auto + then have "\ j = f" by simp + from that have "total1 f" + using `U\<^bsub>LIM-CONS\<^esub> \ \` R1_imp_total1 total1_def by auto + define n\<^sub>0 where "n\<^sub>0 = length vs" + have f_gr_n0: "f n \= 0 \ f n \= 1" if "n > n\<^sub>0" for n + proof - + have "f n = p (n - n\<^sub>0 - 1)" + using that n\<^sub>0_def f by simp + with RPred1_def p show ?thesis by auto + qed + have "rmge2 (f \ n) \= j" if "n \ n\<^sub>0" for n + proof - + have n0_greatest: "(GREATEST i. i < Suc n \ the (f i) \ 2) = n\<^sub>0" + proof (rule Greatest_equality) + show "n\<^sub>0 < Suc n \ the (f n\<^sub>0) \ 2" + using n\<^sub>0_def f that j by simp + show "\y. y < Suc n \ the (f y) \ 2 \ y \ n\<^sub>0" + proof - + fix y assume "y < Suc n \ 2 \ the (f y)" + moreover have "p \ \ \ (\n. p n \= 0 \ p n \= 1)" + using RPred1_def p by blast + ultimately show "y \ n\<^sub>0" + using f_gr_n0 + by (metis Suc_1 Suc_n_not_le_n Zero_neq_Suc le_less_linear le_zero_eq option.sel) + qed + qed + have "f n\<^sub>0 \= j" + using n\<^sub>0_def f by simp + then have "\ (\i n) = f (GREATEST i. i < Suc n \ the (f i) \ 2)" + using rmge2_init_total `total1 f` by auto + with n0_greatest `f n\<^sub>0 \= j` show ?thesis by simp + qed + with `\ j = f` show ?thesis by auto + qed + qed + then show ?thesis using Lim_def by auto +qed + +text \The class @{term "U_LIMCONS"} is \emph{prefix-complete}, which +means that every non-empty list is the prefix of some function in @{term +"U_LIMCONS"}. To show this we use an auxiliary lemma: For every $f \in +\mathcal{R}$ and $k \in \mathbb{N}$ the value of $f$ at $k$ can be replaced +by a Gödel number of the function resulting from the replacement.\ + +lemma goedel_at: + fixes m :: nat and k :: nat + assumes "f \ \" + shows "\n\m. \ n = (\x. if x = k then Some n else f x)" +proof - + define psi :: "partial1 \ nat \ partial2" where + "psi = (\f k i x. (if x = k then Some i else f x))" + have "psi f k \ \\<^sup>2" + proof - + obtain r where r: "recfn 1 r" "total r" "eval r [x] = f x" for x + using assms by auto + define r_psi where + "r_psi = Cn 2 r_ifeq [Id 2 1, r_dummy 1 (r_const k), Id 2 0, Cn 2 r [Id 2 1]]" + show ?thesis + proof (rule R2I[of r_psi]) + from r_psi_def show "recfn 2 r_psi" + using r(1) by simp + have "eval r_psi [i, x] = (if x = k then Some i else f x)" for i x + proof - + have "eval (Cn 2 r [Id 2 1]) [i, x] = f x" + using r by simp + then have "eval r_psi [i, x] = eval r_ifeq [x, k, i, the (f x)]" + unfolding r_psi_def using \recfn 2 r_psi\ r R1_imp_total1[OF assms] + by simp + then show ?thesis using assms by simp + qed + then show "\x y. eval r_psi [x, y] = psi f k x y" + unfolding psi_def by simp + then show "total r_psi" + using totalI2[of r_psi] \recfn 2 r_psi\ assms psi_def by fastforce + qed + qed + then obtain n where "n \ m" "\ n = psi f k n" + using assms kleene_fixed_point[of "psi f k" m] by auto + then show ?thesis unfolding psi_def by auto +qed + +lemma U_LIMCONS_prefix_complete: + assumes "length vs > 0" + shows "\f\U\<^bsub>LIM-CONS\<^esub>. prefix f (length vs - 1) = vs" +proof - + let ?p = "\_. Some 0" + let ?f = "vs @ [0] \ ?p" + have "?f \ \" + using prepend_in_R1 RPred1_subseteq_R1 const0_in_RPred1 by blast + with goedel_at[of ?f 2 "length vs"] obtain j where + j: "j \ 2" "\ j = (\x. if x = length vs then Some j else ?f x)" (is "_ = ?g") + by auto + moreover have g: "?g x = (vs @ [j] \ ?p) x" for x + by (simp add: nth_append) + ultimately have "?g \ U\<^bsub>LIM-CONS\<^esub>" + unfolding U_LIMCONS_def using const0_in_RPred1 by fastforce + moreover have "prefix ?g (length vs - 1) = vs" + using g assms prefixI prepend_associative by auto + ultimately show ?thesis by auto +qed + +text \Roughly speaking, a strategy learning a prefix-complete class +must be total because it must be defined for every prefix in +the class. Technically, however, the empty list is not a prefix, and thus a +strategy may diverge on input 0. We can work around this by +showing that if there is a strategy learning a prefix-complete class then +there is also a total strategy learning this class. We need the result only +for consistent learning.\ + +lemma U_prefix_complete_imp_total_strategy: + assumes "\vs. length vs > 0 \ \f\U. prefix f (length vs - 1) = vs" + and "learn_cons \ U s" + shows "\t. total1 t \ learn_cons \ U t" +proof - + define t where "t = (\e. if e = 0 then Some 0 else s e)" + have "s e \" if "e > 0" for e + proof - + from that have "list_decode e \ []" (is "?vs \ _") + using list_encode_0 list_encode_decode by (metis less_imp_neq) + then have "length ?vs > 0" by simp + with assms(1) obtain f where f: "f \ U" "prefix f (length ?vs - 1) = ?vs" + by auto + with learn_cons_def learn_limE have "s (f \ (length ?vs - 1)) \" + using assms(2) by auto + then show "s e \" + using f(2) init_def by auto + qed + then have "total1 t" + using t_def by auto + have "t \ \

" + proof - + from assms(2) have "s \ \

" + using learn_consE by simp + then obtain rs where rs: "recfn 1 rs" "eval rs [x] = s x" for x + by auto + define rt where "rt = Cn 1 (r_lifz Z rs) [Id 1 0, Id 1 0]" + then have "recfn 1 rt" + using rs by auto + moreover have "eval rt [x] = t x" for x + using rs rt_def t_def by simp + ultimately show ?thesis by blast + qed + have "s (f \ n) = t (f \ n)" if "f \ U" for f n + unfolding t_def by (simp add: init_neq_zero) + then have "learn_cons \ U t" + using `t \ \

` assms(2) learn_consE[of \ U s] learn_consI[of \ U t] by simp + with `total1 t` show ?thesis by auto +qed + +text \The proof of @{prop "U\<^bsub>LIM-CONS\<^esub> \ CONS"} is by contradiction. +Assume there is a consistent learning strategy $S$. By the previous +lemma $S$ can be assumed to be total. Moreover it outputs a consistent +hypothesis for every prefix. Thus for every $e \in \mathbb{N}^+$, $S(e) \neq +S(e0)$ or $S(e) \neq S(e1)$ because $S(e)$ cannot be consistent with both +$e0$ and $e1$. We use this property of $S$ to construct a function in @{term +"U\<^bsub>LIM-CONS\<^esub>"} for which $S$ fails as a learning strategy. To +this end we define a numbering $\psi \in \mathcal{R}^2$ with $\psi_i(0) = i$ +and +\[ +\psi_i(x + 1) = \left\{\begin{array}{ll} + 0 & \mbox{if } S(\psi_i^x0) \neq S(\psi_i^x),\\ + 1 & \mbox{otherwise}. +\end{array}\right. +\] +This numbering is recursive because $S$ is total. The ``otherwise'' case is +equivalent to $S(\psi_i^x1) \neq S(\psi_i^x)$ because $S(\psi_i^x)$ cannot be +consistent with both $\psi_i^x0$ and $\psi_i^x1$. Therefore every prefix +$\psi_i^x$ is extended in such a way that $S$ changes its hypothesis. Hence +$S$ does not learn $\psi_i$ in the limit. Kleene's fixed-point theorem +ensures that for some $j \geq 2$, $\varphi_j = \psi_j$. This $\psi_j$ is the +sought function in @{term "U\<^bsub>LIM-CONS\<^esub>"}. + +The following locale formalizes the construction of $\psi$ for a total +strategy $S$.\ + +locale cons_lim = + fixes s :: partial1 + assumes s_in_R1: "s \ \" +begin + +text \A @{typ recf} computing the strategy:\ + +definition r_s :: recf where + "r_s \ SOME r_s. recfn 1 r_s \ total r_s \ s = (\x. eval r_s [x])" + +lemma r_s_recfn [simp]: "recfn 1 r_s" + and r_s_total [simp]: "\x. eval r_s [x] \" + and eval_r_s: "s = (\x. eval r_s [x])" + using r_s_def R1_SOME[OF s_in_R1, of r_s] by simp_all + +text \The next function represents the prefixes of $\psi_i$.\ + +fun prefixes :: "nat \ nat \ nat list" where + "prefixes i 0 = [i]" +| "prefixes i (Suc x) = (prefixes i x) @ + [if s (e_snoc (list_encode (prefixes i x)) 0) = s (list_encode (prefixes i x)) + then 1 else 0]" + +definition "r_prefixes_aux \ + Cn 3 r_ifeq + [Cn 3 r_s [Cn 3 r_snoc [Id 3 1, r_constn 2 0]], + Cn 3 r_s [Id 3 1], + Cn 3 r_snoc [Id 3 1, r_constn 2 1], + Cn 3 r_snoc [Id 3 1, r_constn 2 0]]" + +lemma r_prefixes_aux_recfn: "recfn 3 r_prefixes_aux" + unfolding r_prefixes_aux_def by simp + +lemma r_prefixes_aux: + "eval r_prefixes_aux [j, v, i] \= + e_snoc v (if eval r_s [e_snoc v 0] = eval r_s [v] then 1 else 0)" + unfolding r_prefixes_aux_def by auto + +definition "r_prefixes \ r_swap (Pr 1 r_singleton_encode r_prefixes_aux)" + +lemma r_prefixes_recfn: "recfn 2 r_prefixes" + unfolding r_prefixes_def r_prefixes_aux_def by simp + +lemma r_prefixes: "eval r_prefixes [i, n] \= list_encode (prefixes i n)" +proof - + let ?h = "Pr 1 r_singleton_encode r_prefixes_aux" + have "eval ?h [n, i] \= list_encode (prefixes i n)" + proof (induction n) + case 0 + then show ?case + using r_prefixes_def r_prefixes_aux_recfn r_singleton_encode by simp + next + case (Suc n) + then show ?case + using r_prefixes_aux_recfn r_prefixes_aux eval_r_s + by auto metis+ + qed + moreover have "eval ?h [n, i] = eval r_prefixes [i, n]" for i n + unfolding r_prefixes_def by (simp add: r_prefixes_aux_recfn) + ultimately show ?thesis by simp +qed + +lemma prefixes_neq_nil: "length (prefixes i x) > 0" + by (induction x) auto + +text \The actual numbering can then be defined via @{term prefixes}.\ + +definition psi :: "partial2" ("\") where + "\ i x \ Some (last (prefixes i x))" + +lemma psi_in_R2: "\ \ \\<^sup>2" +proof + define r_psi where "r_psi \ Cn 2 r_last [r_prefixes]" + have "recfn 2 r_psi" + unfolding r_psi_def by (simp add: r_prefixes_recfn) + then have "eval r_psi [i, n] \= last (prefixes i n)" for n i + unfolding r_psi_def using r_prefixes r_prefixes_recfn prefixes_neq_nil by simp + then have "(\i x. Some (last (prefixes i x))) \ \

\<^sup>2" + using `recfn 2 r_psi` P2I[of "r_psi"] by simp + with psi_def show "\ \ \

\<^sup>2" by presburger + moreover show "total2 psi" + unfolding psi_def by auto +qed + +lemma psi_0_or_1: + assumes "n > 0" + shows "\ i n \= 0 \ \ i n \= 1" +proof - + from assms obtain m where "n = Suc m" + using gr0_implies_Suc by blast + then have "last (prefixes i (Suc m)) = 0 \ last (prefixes i (Suc m)) = 1" + by simp + then show ?thesis using \n = Suc m\ psi_def by simp +qed + +text \The function @{term "prefixes"} does indeed provide the prefixes +for @{term "\"}.\ + +lemma psi_init: "(\ i) \ x = list_encode (prefixes i x)" +proof - + have "prefix (\ i) x = prefixes i x" + unfolding psi_def + by (induction x) (simp_all add: prefix_0 prefix_Suc) + with init_def show ?thesis by simp +qed + +text \One of the functions $\psi_i$ is in @{term "U\<^bsub>LIM-CONS\<^esub>"}.\ + +lemma ex_psi_in_U: "\j. \ j \ U\<^bsub>LIM-CONS\<^esub>" +proof - + obtain j where j: "j \ 2" "\ j = \ j" + using kleene_fixed_point[of \] psi_in_R2 R2_imp_P2 by metis + then have "\ j \ \

" by (simp add: phi_in_P2) + define p where "p = (\x. \ j (x + 1))" + have "p \ \\<^sub>0\<^sub>1" + proof - + from p_def `\ j \ \

` skip_P1 have "p \ \

" by blast + from psi_in_R2 have "total1 (\ j)" by simp + with p_def have "total1 p" + by (simp add: total1_def) + with psi_0_or_1 have "p n \= 0 \ p n \= 1" for n + using psi_def p_def by simp + then show ?thesis + by (simp add: RPred1_def P1_total_imp_R1 \p \ \

\ \total1 p\) + qed + moreover have "\ j = [j] \ p" + proof + fix x + show "\ j x = ([j] \ p) x" + proof (cases "x = 0") + case True + then show ?thesis using psi_def psi_def prepend_at_less by simp + next + case False + then show ?thesis using p_def by simp + qed + qed + ultimately have "\ j \ U\<^bsub>LIM-CONS\<^esub>" + using j U_LIMCONS_def by (metis (mono_tags, lifting) append_Nil mem_Collect_eq) + then show ?thesis by auto +qed + +text \The strategy fails to learn @{term U_LIMCONS} because it changes +its hypothesis all the time on functions $\psi_j \in V_0$.\ + +lemma U_LIMCONS_not_learn_cons: "\ learn_cons \ U\<^bsub>LIM-CONS\<^esub> s" +proof + assume learn: "learn_cons \ U\<^bsub>LIM-CONS\<^esub> s" + have "s (list_encode (vs @ [0])) \ s (list_encode (vs @ [1]))" for vs + proof - + obtain f\<^sub>0 where f0: "f\<^sub>0 \ U\<^bsub>LIM-CONS\<^esub>" "prefix f\<^sub>0 (length vs) = vs @ [0]" + using U_LIMCONS_prefix_complete[of "vs @ [0]"] by auto + obtain f\<^sub>1 where f1: "f\<^sub>1 \ U\<^bsub>LIM-CONS\<^esub>" "prefix f\<^sub>1 (length vs) = vs @ [1]" + using U_LIMCONS_prefix_complete[of "vs @ [1]"] by auto + have "f\<^sub>0 (length vs) \ f\<^sub>1 (length vs)" + using f0 f1 by (metis lessI nth_append_length prefix_nth zero_neq_one) + moreover have "\ (the (s (f\<^sub>0 \ length vs))) (length vs) = f\<^sub>0 (length vs)" + using learn_consE(3)[of \ U_LIMCONS s, OF learn, of f\<^sub>0 "length vs", OF f0(1)] + by simp + moreover have "\ (the (s (f\<^sub>1 \ length vs))) (length vs) = f\<^sub>1 (length vs)" + using learn_consE(3)[of \ U_LIMCONS s, OF learn, of f\<^sub>1 "length vs", OF f1(1)] + by simp + ultimately have "the (s (f\<^sub>0 \ length vs)) \ the (s (f\<^sub>1 \ length vs))" + by auto + then have "s (f\<^sub>0 \ length vs) \ s (f\<^sub>1 \ length vs)" + by auto + with f0(2) f1(2) show ?thesis by (simp add: init_def) + qed + then have "s (list_encode (vs @ [0])) \ s (list_encode vs) \ + s (list_encode (vs @ [1])) \ s (list_encode vs)" + for vs + by metis + then have "s (list_encode (prefixes i (Suc x))) \ s (list_encode (prefixes i x))" for i x + by simp + then have "\ learn_lim \ {\ i} s" for i + using psi_def psi_init always_hyp_change_not_Lim by simp + then have "\ learn_lim \ U_LIMCONS s" + using ex_psi_in_U learn_lim_closed_subseteq by blast + then show False + using learn learn_cons_def by simp +qed + +end + +text \With the locale we can now show the second part of the main +result:\ + +lemma U_LIMCONS_not_in_CONS: "U\<^bsub>LIM-CONS\<^esub> \ CONS" +proof + assume "U\<^bsub>LIM-CONS\<^esub> \ CONS" + then have "U\<^bsub>LIM-CONS\<^esub> \ CONS_wrt \" + by (simp add: CONS_wrt_phi_eq_CONS) + then obtain almost_s where "learn_cons \ U\<^bsub>LIM-CONS\<^esub> almost_s" + using CONS_wrt_def by auto + then obtain s where s: "total1 s" "learn_cons \ U\<^bsub>LIM-CONS\<^esub> s" + using U_LIMCONS_prefix_complete U_prefix_complete_imp_total_strategy by blast + then have "s \ \" + using learn_consE(1) P1_total_imp_R1 by blast + with cons_lim_def interpret cons_lim s by simp + show False + using s(2) U_LIMCONS_not_learn_cons by simp +qed + +text \The main result of this section:\ + +theorem CONS_subset_Lim: "CONS \ LIM" + using U_LIMCONS_in_Lim U_LIMCONS_not_in_CONS CONS_subseteq_Lim by auto + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/CP_FIN_NUM.thy b/thys/Inductive_Inference/CP_FIN_NUM.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/CP_FIN_NUM.thy @@ -0,0 +1,1032 @@ +section \FIN is a proper subset of CP\label{s:fin_cp}\ + +theory CP_FIN_NUM + imports Inductive_Inference_Basics +begin + +text \Let $S$ be a FIN strategy for a non-empty class $U$. Let $T$ be a +strategy that hypothesizes an arbitrary function from $U$ while $S$ outputs +``don't know'' and the hypothesis of $S$ otherwise. Then $T$ is a CP strategy +for $U$.\ + +lemma nonempty_FIN_wrt_impl_CP: + assumes "U \ {}" and "U \ FIN_wrt \" + shows "U \ CP_wrt \" +proof - + obtain s where "learn_fin \ U s" + using assms(2) FIN_wrt_def by auto + then have env: "environment \ U s" and + fin: "\f. f \ U \ + \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + using learn_finE by auto + from assms(1) obtain f\<^sub>0 where "f\<^sub>0 \ U" + by auto + with fin obtain i\<^sub>0 where "\ i\<^sub>0 = f\<^sub>0" + by blast + define t where "t x \ + (if s x \ then None else if s x \= 0 then Some i\<^sub>0 else Some (the (s x) - 1))" + for x + have "t \ \

" + proof - + from env obtain rs where rs: "recfn 1 rs" "\x. eval rs [x] = s x" + by auto + define rt where "rt = Cn 1 r_ifz [rs, r_const i\<^sub>0, Cn 1 r_dec [rs]]" + then have "recfn 1 rt" + using rs(1) by simp + then have "eval rt [x] \= (if s x \= 0 then i\<^sub>0 else (the (s x)) - 1)" if "s x \" for x + using rs rt_def that by auto + moreover have "eval rt [x] \" if "eval rs [x] \" for x + using rs rt_def that by simp + ultimately have "eval rt [x] = t x" for x + using rs(2) t_def by simp + with \recfn 1 rt\ show ?thesis by auto + qed + have "learn_cp \ U t" + proof (rule learn_cpI) + show "environment \ U t" + using env t_def \t \ \

\ by simp + show "\i. \ i = f \ (\\<^sup>\n. t (f \ n) \= i)" if "f \ U" for f + proof - + from that fin obtain i n\<^sub>0 where + i: "\ i = f" "\n0. s (f \ n) \= 0" "\n\n\<^sub>0. s (f \ n) \= Suc i" + by blast + moreover have "\n\n\<^sub>0. t (f \ n) \= i" + using that t_def i(3) by simp + ultimately show ?thesis by auto + qed + show "\ (the (t (f \ n))) \ U" if "f \ U" for f n + using \\ i\<^sub>0 = f\<^sub>0\ \f\<^sub>0 \ U\ t_def fin env that + by (metis (no_types, lifting) diff_Suc_1 not_less option.sel) + qed + then show ?thesis using CP_wrt_def env by auto +qed + +lemma FIN_wrt_impl_CP: + assumes "U \ FIN_wrt \" + shows "U \ CP_wrt \" +proof (cases "U = {}") + case True + then have "\ \ \

\<^sup>2 \ U \ CP_wrt \" + using CP_wrt_def learn_cpI[of \ "{}" "\x. Some 0"] const_in_Prim1 by auto + moreover have "\ \ \

\<^sup>2" + using assms FIN_wrt_def learn_finE by auto + ultimately show "U \ CP_wrt \" by simp +next + case False + with nonempty_FIN_wrt_impl_CP assms show ?thesis + by simp +qed + +corollary FIN_subseteq_CP: "FIN \ CP" +proof + fix U + assume "U \ FIN" + then have "\\. U \ FIN_wrt \" + using FIN_def FIN_wrt_def by auto + then have "\\. U \ CP_wrt \" + using FIN_wrt_impl_CP by auto + then show "U \ CP" + by (simp add: CP_def CP_wrt_def) +qed + +text \In order to show the \emph{proper} inclusion, we show @{term +"U\<^sub>0 \ CP - FIN"}. A CP strategy for @{term "U\<^sub>0"} simply +hypothesizes the function in @{term U0} with the longest prefix of $f^n$ not +ending in zero. For that we define a function computing the index of the +rightmost non-zero value in a list, returning the length of the list if there +is no such value.\ + +definition findr :: partial1 where + "findr e \ + if \i 0 + then Some (GREATEST i. i < e_length e \ e_nth e i \ 0) + else Some (e_length e)" + +lemma findr_total: "findr e \" + unfolding findr_def by simp + +lemma findr_ex: + assumes "\i 0" + shows "the (findr e) < e_length e" + and "e_nth e (the (findr e)) \ 0" + and "\i. the (findr e) < i \ i < e_length e \ e_nth e i = 0" +proof - + let ?P = "\i. i < e_length e \ e_nth e i \ 0" + from assms have "\i. ?P i" by simp + then have "?P (Greatest ?P)" + using GreatestI_ex_nat[of ?P "e_length e"] by fastforce + moreover have *: "findr e = Some (Greatest ?P)" + using assms findr_def by simp + ultimately show "the (findr e) < e_length e" and "e_nth e (the (findr e)) \ 0" + by fastforce+ + show "\i. the (findr e) < i \ i < e_length e \ e_nth e i = 0" + using * Greatest_le_nat[of ?P _ "e_length e"] by fastforce +qed + +definition "r_findr \ + let g = + Cn 3 r_ifz + [Cn 3 r_nth [Id 3 2, Id 3 0], + Cn 3 r_ifeq [Id 3 0, Id 3 1, Cn 3 S [Id 3 0], Id 3 1], + Id 3 0] + in Cn 1 (Pr 1 Z g) [Cn 1 r_length [Id 1 0], Id 1 0]" + +lemma r_findr_prim [simp]: "prim_recfn 1 r_findr" + unfolding r_findr_def by simp + +lemma r_findr [simp]: "eval r_findr [e] = findr e" +proof - + define g where "g = + Cn 3 r_ifz + [Cn 3 r_nth [Id 3 2, Id 3 0], + Cn 3 r_ifeq [Id 3 0, Id 3 1, Cn 3 S [Id 3 0], Id 3 1], + Id 3 0]" + then have "recfn 3 g" + by simp + with g_def have g: "eval g [j, r, e] \= + (if e_nth e j \ 0 then j else if j = r then Suc j else r)" for j r e + by simp + let ?h = "Pr 1 Z g" + have "recfn 2 ?h" + by (simp add: \recfn 3 g\) + let ?P = "\e j i. i < j \ e_nth e i \ 0" + let ?G = "\e j. Greatest (?P e j)" + have h: "eval ?h [j, e] = + (if \irecfn 2 ?h\ by auto + next + case (Suc j) + then have "eval ?h [Suc j, e] = eval g [j, the (eval ?h [j, e]), e]" + using \recfn 2 ?h\ by auto + then have "eval ?h [Suc j, e] = + eval g [j, if \i= + (if e_nth e j \ 0 then j + else if j = (if \iiii 0" + by auto + show ?thesis + proof (cases "e_nth e j = 0") + case True + then have ex': "\i 0" + using ex less_Suc_eq by fastforce + then have "(if \i= ?G e j" + using * True by simp + moreover have "?G e j = ?G e (Suc j)" + using True by (metis less_SucI less_Suc_eq) + ultimately show ?thesis using ex by metis + next + case False + then have "eval ?h [Suc j, e] \= j" + using * by simp + moreover have "?G e (Suc j) = j" + using ex False Greatest_equality[of "?P e (Suc j)"] by simp + ultimately show ?thesis using ex by simp + qed + qed + qed + let ?hh = "Cn 1 ?h [Cn 1 r_length [Id 1 0], Id 1 0]" + have "recfn 1 ?hh" + using `recfn 2 ?h` by simp + with h have hh: "eval ?hh [e] \= + (if \i0 \ CP" +proof - + define s where + "s \ \x. if findr x \= e_length x then Some 0 else Some (e_take (Suc (the (findr x))) x)" + have "s \ \

" + proof - + define r where + "r \ Cn 1 r_ifeq [r_findr, r_length, Z, Cn 1 r_take [Cn 1 S [r_findr], Id 1 0]]" + then have "\x. eval r [x] = s x" + using s_def findr_total by fastforce + moreover have "recfn 1 r" + using r_def by simp + ultimately show ?thesis by auto + qed + moreover have "learn_cp prenum U\<^sub>0 s" + proof (rule learn_cpI) + show "environment prenum U\<^sub>0 s" + using \s \ \

\ s_def prenum_in_R2 U0_in_NUM by auto + show "\i. prenum i = f \ (\\<^sup>\n. s (f \ n) \= i)" if "f \ U\<^sub>0" for f + proof (cases "f = (\_. Some 0)") + case True + then have "s (f \ n) \= 0" for n + using findr_def s_def by simp + then have "\n\0. s (f \ n) \= 0" by simp + moreover have "prenum 0 = f" + using True by auto + ultimately show ?thesis by auto + next + case False + then obtain ws where ws: "length ws > 0" "last ws \ 0" "f = ws \ 0\<^sup>\" + using U0_def \f \ U\<^sub>0\ almost0_canonical by blast + let ?m = "length ws - 1" + let ?i = "list_encode ws" + have "prenum ?i = f" + using ws by auto + moreover have "s (f \ n) \= ?i" if "n \ ?m" for n + proof - + have "e_nth (f \ n) ?m \ 0" + using ws that by (simp add: last_conv_nth) + then have "\k n) k \ 0" + using le_imp_less_Suc that by blast + moreover have + "(GREATEST k. k < e_length (f \ n) \ e_nth (f \ n) k \ 0) = ?m" + proof (rule Greatest_equality) + show "?m < e_length (f \ n) \ e_nth (f \ n) ?m \ 0" + using \e_nth (f \ n) ?m \ 0\ that by auto + show "\y. y < e_length (f \ n) \ e_nth (f \ n) y \ 0 \ y \ ?m" + using ws less_Suc_eq_le by fastforce + qed + ultimately have "findr (f \ n) \= ?m" + using that findr_def by simp + moreover have "?m < e_length (f \ n)" + using that by simp + ultimately have "s (f \ n) \= e_take (Suc ?m) (f \ n)" + using s_def by simp + moreover have "e_take (Suc ?m) (f \ n) = list_encode ws" + proof - + have "take (Suc ?m) (prefix f n) = prefix f ?m" + using take_prefix[of f ?m n] ws that by (simp add: almost0_in_R1) + then have "take (Suc ?m) (prefix f n) = ws" + using ws prefixI by auto + then show ?thesis by simp + qed + ultimately show ?thesis by simp + qed + ultimately show ?thesis by auto + qed + show "\f n. f \ U\<^sub>0 \ prenum (the (s (f \ n))) \ U\<^sub>0" + using U0_def by fastforce + qed + ultimately show ?thesis using CP_def by blast +qed + +text \As a bit of an interlude, we can now show that CP is not +closed under the subset relation. This works by removing functions from +@{term "U\<^sub>0"} in a ``noncomputable'' way such that a strategy cannot ensure +that every intermediate hypothesis is in that new class.\ + +lemma CP_not_closed_subseteq: "\V U. V \ U \ U \ CP \ V \ CP" +proof - + \ \The numbering $g\in\mathcal{R}^2$ enumerates all + functions $i0^\infty \in U_0$.\ + define g where "g \ \i. [i] \ 0\<^sup>\" + have g_inj: "i = j" if "g i = g j" for i j + proof - + have "g i 0 \= i" and "g j 0 \= j" + by (simp_all add: g_def) + with that show "i = j" + by (metis option.inject) + qed + + \ \Define a class $V$. If the strategy $\varphi_i$ learns + $g_i$, it outputs a hypothesis for $g_i$ on some shortest prefix $g_i^m$. + Then the function $g_i^m10^\infty$ is included in the class $V$; otherwise + $g_i$ is included.\ + define V where "V \ + {if learn_lim \ {g i} (\ i) + then (prefix (g i) (LEAST n. \ (the (\ i ((g i) \ n))) = g i)) @ [1] \ 0\<^sup>\ + else g i | + i. i \ UNIV}" + have "V \ CP_wrt \" + proof + \ \Assuming $V \in CP_\varphi$, there is a CP strategy + $\varphi_i$ for $V$.\ + assume "V \ CP_wrt \" + then obtain s where s: "s \ \

" "learn_cp \ V s" + using CP_wrt_def learn_cpE(1) by auto + then obtain i where i: "\ i = s" + using phi_universal by auto + + show False + proof (cases "learn_lim \ {g i} (\ i)") + case learn: True + \ \If $\varphi_i$ learns $g_i$, it hypothesizes $g_i$ on + some shortest prefix $g_i^m$. Thus it hypothesizes $g_i$ on some prefix + of $g_i^m10^\infty \in V$, too. But $g_i$ is not a class-preserving + hypothesis because $g_i \notin V$.\ + let ?P = "\n. \ (the (\ i ((g i) \ n))) = g i" + let ?m = "Least ?P" + have "\n. ?P n" + using i s by (meson learn infinite_hyp_wrong_not_Lim insertI1 lessI) + then have "?P ?m" + using LeastI_ex[of ?P] by simp + define h where "h = (prefix (g i) ?m) @ [1] \ 0\<^sup>\" + then have "h \ V" + using V_def learn by auto + have "(g i) \ ?m = h \ ?m" + proof - + have "prefix (g i) ?m = prefix h ?m" + unfolding h_def by (simp add: prefix_prepend_less) + then show ?thesis by auto + qed + then have "\ (the (\ i (h \ ?m))) = g i" + using `?P ?m` by simp + moreover have "g i \ V" + proof + assume "g i \ V" + then obtain j where j: "g i = + (if learn_lim \ {g j} (\ j) + then (prefix (g j) (LEAST n. \ (the (\ j ((g j) \ n))) = g j)) @ [1] \ 0\<^sup>\ + else g j)" + using V_def by auto + show False + proof (cases "learn_lim \ {g j} (\ j)") + case True + then have "g i = + (prefix (g j) (LEAST n. \ (the (\ j ((g j) \ n))) = g j)) @ [1] \ 0\<^sup>\" + (is "g i = ?vs @ [1] \ 0\<^sup>\") + using j by simp + moreover have len: "length ?vs > 0" by simp + ultimately have "g i (length ?vs) \= 1" + by (simp add: prepend_associative) + moreover have "g i (length ?vs) \= 0" + using g_def len by simp + ultimately show ?thesis by simp + next + case False + then show ?thesis + using j g_inj learn by auto + qed + qed + ultimately have "\ (the (\ i (h \ ?m))) \ V" by simp + then have "\ learn_cp \ V (\ i)" + using `h \ V` learn_cpE(3) by auto + then show ?thesis by (simp add: i s(2)) + next + \ \If $\varphi_i$ does not learn $g_i$, then $g_i\in V$. + Hence $\varphi_i$ does not learn $V$.\ + case False + then have "g i \ V" + using V_def by auto + with False have "\ learn_lim \ V (\ i)" + using learn_lim_closed_subseteq by auto + then show ?thesis + using s(2) i by (simp add: learn_cp_def) + qed + qed + then have "V \ CP" + using CP_wrt_phi by simp + moreover have "V \ U\<^sub>0" + using V_def g_def U0_def by auto + ultimately show ?thesis using U0_in_CP by auto +qed + +text \Continuing with the main result of this section, we show that +@{term "U\<^sub>0"} cannot be learned finitely. Any FIN strategy would have +to output a hypothesis for the constant zero function on some prefix. But +@{term "U\<^sub>0"} contains infinitely many other functions starting with +the same prefix, which the strategy then would not learn finitely.\ + +lemma U0_not_in_FIN: "U\<^sub>0 \ FIN" +proof + assume "U\<^sub>0 \ FIN" + then obtain \ s where "learn_fin \ U\<^sub>0 s" + using FIN_def by blast + with learn_finE have cp: "\f. f \ U\<^sub>0 \ + \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + by simp_all + + define z where "z = [] \ 0\<^sup>\" + then have "z \ U\<^sub>0" + using U0_def by auto + with cp obtain i n\<^sub>0 where i: "\ i = z" and n0: "\n\n\<^sub>0. s (z \ n) \= Suc i" + by blast + + define w where "w = replicate (Suc n\<^sub>0) 0 @ [1] \ 0\<^sup>\" + then have "prefix w n\<^sub>0 = replicate (Suc n\<^sub>0) 0" + by (simp add: prefix_prepend_less) + moreover have "prefix z n\<^sub>0 = replicate (Suc n\<^sub>0) 0" + using prefixI[of "replicate (Suc n\<^sub>0) 0" z] less_Suc_eq_0_disj unfolding z_def + by fastforce + ultimately have "z \ n\<^sub>0 = w \ n\<^sub>0" + by (simp add: init_prefixE) + with n0 have *: "s (w \ n\<^sub>0) \= Suc i" by auto + + have "w \ U\<^sub>0" using w_def U0_def by auto + with cp obtain i' n\<^sub>0' where i': "\ i' = w" + and n0': "\n0'. s (w \ n) \= 0" "\n\n\<^sub>0'. s (w \ n) \= Suc i'" + by blast + + have "i \ i'" + proof + assume "i = i'" + then have "w = z" + using i i' by simp + have "w (Suc n\<^sub>0) \= 1" + using w_def prepend[of "replicate (Suc n\<^sub>0) 0 @ [1]" "0\<^sup>\" "Suc n\<^sub>0"] + by (metis length_append_singleton length_replicate lessI nth_append_length) + moreover have "z (Suc n\<^sub>0) \= 0" + using z_def by simp + ultimately show False + using \w = z\ by simp + qed + then have "s (w \ n\<^sub>0) \\ Suc i" + using n0' by (cases "n\<^sub>0 < n\<^sub>0'") simp_all + with * show False by simp +qed + +theorem FIN_subset_CP: "FIN \ CP" + using U0_in_CP U0_not_in_FIN FIN_subseteq_CP by auto + + +section \NUM and FIN are incomparable\label{s:num_fin}\ + +text \The class $V_0$ of all total recursive functions $f$ where $f(0)$ +is a Gödel number of $f$ can be learned finitely by always hypothesizing +$f(0)$. The class is not in NUM and therefore serves to separate NUM and +FIN.\ + +definition V0 :: "partial1 set" ("V\<^sub>0") where + "V\<^sub>0 = {f. f \ \ \ \ (the (f 0)) = f}" + +lemma V0_altdef: "V\<^sub>0 = {[i] \ f| i f. f \ \ \ \ i = [i] \ f}" + (is "V\<^sub>0 = ?W") +proof + show "V\<^sub>0 \ ?W" + proof + fix f + assume "f \ V\<^sub>0" + then have "f \ \" + unfolding V0_def by simp + then obtain i where i: "f 0 \= i" by fastforce + define g where "g = (\x. f (x + 1))" + then have "g \ \" + using skip_R1[OF `f \ \`] by blast + moreover have "[i] \ g = f" + using g_def i by auto + moreover have "\ i = f" + using `f \ V\<^sub>0` V0_def i by force + ultimately show "f \ ?W" by auto + qed + show "?W \ V\<^sub>0" + proof + fix g + assume "g \ ?W" + then have "\ (the (g 0)) = g" by auto + moreover have "g \ \" + using prepend_in_R1 `g \ ?W` by auto + ultimately show "g \ V\<^sub>0" + by (simp add: V0_def) + qed +qed + +lemma V0_in_FIN: "V\<^sub>0 \ FIN" +proof - + define s where "s = (\x. Some (Suc (e_hd x)))" + have "s \ \

" + proof - + define r where "r = Cn 1 S [r_hd]" + then have "recfn 1 r" by simp + moreover have "eval r [x] \= Suc (e_hd x)" for x + unfolding r_def by simp + ultimately show ?thesis + using s_def by blast + qed + have s: "s (f \ n) \= Suc (the (f 0))" for f n + unfolding s_def by simp + have "learn_fin \ V\<^sub>0 s" + proof (rule learn_finI) + show "environment \ V\<^sub>0 s" + using s_def \s \ \

\ phi_in_P2 V0_def by auto + show "\i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + if "f \ V\<^sub>0" for f + using that V0_def s by auto + qed + then show ?thesis using FIN_def by auto +qed + +text \To every @{term "f \ \"} a number can be prepended that is +a Gödel number of the resulting function. Such a function is then in $V_0$. + +If $V_0$ was in NUM, it would be embedded in a total numbering. Shifting this +numbering to the left, essentially discarding the values at point $0$, would +yield a total numbering for @{term "\"}, which contradicts @{thm[source] +R1_not_in_NUM}. This proves @{prop "V\<^sub>0 \ NUM"}.\ + +lemma prepend_goedel: + assumes "f \ \" + shows "\i. \ i = [i] \ f" +proof - + obtain r where r: "recfn 1 r" "total r" "\x. eval r [x] = f x" + using assms by auto + define r_psi where "r_psi = Cn 2 r_ifz [Id 2 1, Id 2 0, Cn 2 r [Cn 2 r_dec [Id 2 1]]]" + then have "recfn 2 r_psi" + using r(1) by simp + have "eval r_psi [i, x] = (if x = 0 then Some i else f (x - 1))" for i x + proof - + have "eval (Cn 2 r [Cn 2 r_dec [Id 2 1]]) [i, x] = f (x - 1)" + using r by simp + then have "eval r_psi [i, x] = eval r_ifz [x, i, the (f (x - 1))]" + unfolding r_psi_def using \recfn 2 r_psi\ r R1_imp_total1[OF assms] by auto + then show ?thesis + using assms by simp + qed + with \recfn 2 r_psi\ have "(\i x. if x = 0 then Some i else f (x - 1)) \ \

\<^sup>2" + by auto + with kleene_fixed_point obtain i where + "\ i = (\x. if x = 0 then Some i else f (x - 1))" + by blast + then have "\ i = [i] \ f" by auto + then show ?thesis by auto +qed + +lemma V0_in_FIN_minus_NUM: "V\<^sub>0 \ FIN - NUM" +proof - + have "V\<^sub>0 \ NUM" + proof + assume "V\<^sub>0 \ NUM" + then obtain \ where \: "\ \ \\<^sup>2" "\f. f \ V\<^sub>0 \ \i. \ i = f" + by auto + define \' where "\' i x = \ i (Suc x)" for i x + have "\' \ \\<^sup>2" + proof + from \(1) obtain r_psi where + r_psi: "recfn 2 r_psi" "total r_psi" "\i x. eval r_psi [i, x] = \ i x" + by blast + define r_psi' where "r_psi' = Cn 2 r_psi [Id 2 0, Cn 2 S [Id 2 1]]" + then have "recfn 2 r_psi'" and "\i x. eval r_psi' [i, x] = \' i x" + unfolding r_psi'_def \'_def using r_psi by simp_all + then show "\' \ \

\<^sup>2" by blast + show "total2 \'" + using \'_def \(1) by (simp add: total2I) + qed + have "\i. \' i = f" if "f \ \" for f + proof - + from that obtain j where j: "\ j = [j] \ f" + using prepend_goedel by auto + then have "\ j \ V\<^sub>0" + using that V0_altdef by auto + with \ obtain i where "\ i = \ j" by auto + then have "\' i = f" + using \'_def j by (auto simp add: prepend_at_ge) + then show ?thesis by auto + qed + with \\' \ \\<^sup>2\ have "\ \ NUM" by auto + with R1_not_in_NUM show False by simp + qed + then show ?thesis + using V0_in_FIN by auto +qed + +corollary FIN_not_subseteq_NUM: "\ FIN \ NUM" + using V0_in_FIN_minus_NUM by auto + + +section \NUM and CP are incomparable\label{s:num_cp}\ + +text \There are FIN classes outside of NUM, and CP encompasses FIN. +Hence there are CP classes outside of NUM, too.\ + +theorem CP_not_subseteq_NUM: "\ CP \ NUM" + using FIN_subseteq_CP FIN_not_subseteq_NUM by blast + +text \Conversely there is a subclass of @{term "U\<^sub>0"} that +is in NUM but cannot be learned in a class-preserving way. The following +proof is due to Jantke and Beick~\cite{jb-cpnii-81}. The idea is to +diagonalize against all strategies, that is, all partial recursive +functions.\ + +theorem NUM_not_subseteq_CP: "\ NUM \ CP" +proof- + \ \Define a family of functions $f_k$.\ + define f where "f \ \k. [k] \ 0\<^sup>\" + then have "f k \ \" for k + using almost0_in_R1 by auto + + \ \If the strategy $\varphi_k$ learns $f_k$ it hypothesizes + $f_k$ for some shortest prefix $f_k^{a_k}$. Define functions $f'_k = + k0^{a_k}10^\infty$.\ + define a where + "a \ \k. LEAST x. (\ (the ((\ k) ((f k) \ x)))) = f k" + define f' where "f' \ \k. (k # (replicate (a k) 0) @ [1]) \ 0\<^sup>\" + then have "f' k \ \" for k + using almost0_in_R1 by auto + + \ \Although $f_k$ and $f'_k$ differ, they share the prefix of length $a_k + 1$.\ + have init_eq: "(f' k) \ (a k) = (f k) \ (a k)" for k + proof (rule init_eqI) + fix x assume "x \ a k" + then show "f' k x = f k x" + by (cases "x = 0") (simp_all add: nth_append f'_def f_def) + qed + have "f k \ f' k" for k + proof - + have "f k (Suc (a k)) \= 0" using f_def by auto + moreover have "f' k (Suc (a k)) \= 1" + using f'_def prepend[of "(k # (replicate (a k) 0) @ [1])" "0\<^sup>\" "Suc (a k)"] + by (metis length_Cons length_append_singleton length_replicate lessI nth_Cons_Suc + nth_append_length) + ultimately show ?thesis by auto + qed + + \ \The separating class $U$ contains $f'_k$ if $\varphi_k$ + learns $f_k$; otherwise it contains $f_k$.\ + define U where + "U \ {if learn_lim \ {f k} (\ k) then f' k else f k |k. k \ UNIV}" + have "U \ CP" + proof + assume "U \ CP" + have "\k. learn_cp \ U (\ k)" + proof - + have "\\ s. learn_cp \ U s" + using CP_def `U \ CP` by auto + then obtain s where s: "learn_cp \ U s" + using learn_cp_wrt_goedel[OF goedel_numbering_phi] by blast + then obtain k where "\ k = s" + using phi_universal learn_cp_def learn_lim_def by auto + then show ?thesis using s by auto + qed + then obtain k where k: "learn_cp \ U (\ k)" by auto + then have learn: "learn_lim \ U (\ k)" + using learn_cp_def by simp + \ \If $f_k$ was in $U$, $\varphi_k$ would learn it. But then, + by definition of $U$, $f_k$ would not be in $U$. Hence $f_k \notin U$.\ + have "f k \ U" + proof + assume "f k \ U" + then obtain m where m: "f k = (if learn_lim \ {f m} (\ m) then f' m else f m)" + using U_def by auto + have "f k 0 \= m" + using f_def f'_def m by simp + moreover have "f k 0 \= k" by (simp add: f_def) + ultimately have "m = k" by simp + with m have "f k = (if learn_lim \ {f k} (\ k) then f' k else f k)" + by auto + moreover have "learn_lim \ {f k} (\ k)" + using \f k \ U\ learn_lim_closed_subseteq[OF learn] by simp + ultimately have "f k = f' k" + by simp + then show False + using \f k \ f' k\ by simp + qed + then have "f' k \ U" using U_def by fastforce + then have in_U: "\n. \ (the ((\ k) ((f' k) \ n))) \ U" + using learn_cpE(3)[OF k] by simp + + \ \Since $f'_k \in U$, the strategy $\varphi_k$ learns $f_k$. + Then $a_k$ is well-defined, $f'^{a_k} = f^{a_k}$, and $\varphi_k$ + hypothesizes $f_k$ on $f'^{a_k}$, which is not a class-preserving + hypothesis.\ + have "learn_lim \ {f k} (\ k)" using U_def \f k \ U\ by fastforce + then have "\i n\<^sub>0. \ i = f k \ (\n\n\<^sub>0. \ k ((f k) \ n) \= i)" + using learn_limE(2) by simp + then obtain i n\<^sub>0 where "\ i = f k \ (\n\n\<^sub>0. \ k ((f k) \ n) \= i)" + by auto + then have "\ (the (\ k ((f k) \ (a k)))) = f k" + using a_def LeastI[of "\x. (\ (the ((\ k) ((f k) \ x)))) = f k" n\<^sub>0] + by simp + then have "\ (the ((\ k) ((f' k) \ (a k)))) = f k" + using init_eq by simp + then show False + using \f k \ U\ in_U by metis + qed + moreover have "U \ NUM" + using NUM_closed_subseteq[OF U0_in_NUM, of U] f_def f'_def U0_def U_def + by fastforce + ultimately show ?thesis by auto +qed + + +section \NUM is a proper subset of TOTAL\label{s:num_total}\ + +text \A NUM class $U$ is embedded in a total numbering @{term \}. +The strategy $S$ with $S(f^n) = \min \{i \mid \forall k \le n: \psi_i(k) = +f(k)\}$ for $f \in U$ converges to the least index of $f$ in @{term \}, +and thus learns $f$ in the limit. Moreover it will be a TOTAL strategy +because @{term \} contains only total functions. This shows @{prop "NUM +\ TOTAL"}.\ + +text \First we define, for every hypothesis space $\psi$, a +function that tries to determine for a given list $e$ and index $i$ whether +$e$ is a prefix of $\psi_i$. In other words it tries to decide whether $i$ is +a consistent hypothesis for $e$. ``Tries'' refers to the fact that the +function will diverge if $\psi_i(x)\uparrow$ for any $x \le |e|$. We start +with a version that checks the list only up to a given length.\ + +definition r_consist_upto :: "recf \ recf" where + "r_consist_upto r_psi \ + let g = Cn 4 r_ifeq + [Cn 4 r_psi [Id 4 2, Id 4 0], Cn 4 r_nth [Id 4 3, Id 4 0], Id 4 1, r_constn 3 1] + in Pr 2 (r_constn 1 0) g" + +lemma r_consist_upto_recfn: "recfn 2 r_psi \ recfn 3 (r_consist_upto r_psi)" + using r_consist_upto_def by simp + +lemma r_consist_upto: + assumes "recfn 2 r_psi" + shows "\k \ + eval (r_consist_upto r_psi) [j, i, e] = + (if \k= e_nth e k then Some 0 else Some 1)" + and "\ (\k) \ eval (r_consist_upto r_psi) [j, i, e] \" +proof - + define g where "g = + Cn 4 r_ifeq + [Cn 4 r_psi [Id 4 2, Id 4 0], Cn 4 r_nth [Id 4 3, Id 4 0], Id 4 1, r_constn 3 1]" + then have "recfn 4 g" + using assms by simp + moreover have "eval (Cn 4 r_nth [Id 4 3, Id 4 0]) [j, r, i, e] \= e_nth e j" for j r i e + by simp + moreover have "eval (r_constn 3 1) [j, r, i, e] \= 1" for j r i e + by simp + moreover have "eval (Cn 4 r_psi [Id 4 2, Id 4 0]) [j, r, i, e] = eval r_psi [i, j]" for j r i e + using assms(1) by simp + ultimately have g: "eval g [j, r, i, e] = + (if eval r_psi [i, j] \ then None + else if eval r_psi [i, j] \= e_nth e j then Some r else Some 1)" + for j r i e + using `recfn 4 g` g_def assms by auto + have goal1: "\k \ + eval (r_consist_upto r_psi) [j, i, e] = + (if \k= e_nth e k then Some 0 else Some 1)" + for j i e + proof (induction j) + case 0 + then show ?case + using r_consist_upto_def r_consist_upto_recfn assms eval_Pr_0 by simp + next + case (Suc j) + then have "eval (r_consist_upto r_psi) [Suc j, i, e] = + eval g [j, the (eval (r_consist_upto r_psi) [j, i, e]), i, e]" + using assms eval_Pr_converg_Suc g_def r_consist_upto_def r_consist_upto_recfn + by simp + also have "... = eval g [j, if \k= e_nth e k then 0 else 1, i, e]" + using Suc by auto + also have "... \= (if eval r_psi [i, j] \= e_nth e j + then if \k= e_nth e k then 0 else 1 else 1)" + using g by (simp add: Suc.prems) + also have "... \= (if \k= e_nth e k then 0 else 1)" + by (simp add: less_Suc_eq) + finally show ?case by simp + qed + then show "\k \ + eval (r_consist_upto r_psi) [j, i, e] = + (if \k= e_nth e k then Some 0 else Some 1)" + by simp + show "\ (\k) \ eval (r_consist_upto r_psi) [j, i, e] \" + proof - + assume "\ (\k)" + then have "\k" by simp + let ?P = "\k. k < j \ eval r_psi [i, k] \" + define kmin where "kmin = Least ?P" + then have "?P kmin" + using LeastI_ex[of ?P] \\k\ by auto + from kmin_def have "\k. k < kmin \ \ ?P k" + using kmin_def not_less_Least[of _ ?P] by blast + then have "\k < kmin. eval r_psi [i, k] \" + using `?P kmin` by simp + then have "eval (r_consist_upto r_psi) [kmin, i, e] = + (if \k= e_nth e k then Some 0 else Some 1)" + using goal1 by simp + moreover have "eval r_psi [i, kmin] \" + using `?P kmin` by simp + ultimately have "eval (r_consist_upto r_psi) [Suc kmin, i, e] \" + using r_consist_upto_def g assms by simp + moreover have "j \ kmin" + using `?P kmin` by simp + ultimately show "eval (r_consist_upto r_psi) [j, i, e] \" + using r_consist_upto_def r_consist_upto_recfn `?P kmin` eval_Pr_converg_le assms + by (metis (full_types) Suc_leI length_Cons list.size(3) numeral_2_eq_2 numeral_3_eq_3) + qed +qed + +text \The next function provides the consistency decision functions we +need.\ + +definition consistent :: "partial2 \ partial2" where + "consistent \ i e \ + if \k i k \ + then if \k i k \= e_nth e k + then Some 0 else Some 1 + else None" + +text \Given $i$ and $e$, @{term "consistent \"} decides whether $e$ +is a prefix of $\psi_i$, provided $\psi_i$ is defined for the length of +$e$.\ + +definition r_consistent :: "recf \ recf" where + "r_consistent r_psi \ + Cn 2 (r_consist_upto r_psi) [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]" + +lemma r_consistent_recfn [simp]: "recfn 2 r_psi \ recfn 2 (r_consistent r_psi)" + using r_consistent_def r_consist_upto_recfn by simp + +lemma r_consistent_converg: + assumes "recfn 2 r_psi" and "\k" + shows "eval (r_consistent r_psi) [i, e] \= + (if \k= e_nth e k then 0 else 1)" +proof - + have "eval (r_consistent r_psi) [i, e] = eval (r_consist_upto r_psi) [e_length e, i, e]" + using r_consistent_def r_consist_upto_recfn assms(1) by simp + then show ?thesis using assms r_consist_upto(1) by simp +qed + +lemma r_consistent_diverg: + assumes "recfn 2 r_psi" and "\k" + shows "eval (r_consistent r_psi) [i, e] \" + unfolding r_consistent_def + using r_consist_upto_recfn[OF assms(1)] r_consist_upto[OF assms(1)] assms(2) + by simp + +lemma r_consistent: + assumes "recfn 2 r_psi" and "\x y. eval r_psi [x, y] = \ x y" + shows "eval (r_consistent r_psi) [i, e] = consistent \ i e" +proof (cases "\k i k \") + case True + then have "\k" + using assms by simp + then show ?thesis + unfolding consistent_def using True by (simp add: assms r_consistent_converg) +next + case False + then have "consistent \ i e \" + unfolding consistent_def by auto + moreover have "eval (r_consistent r_psi) [i, e] \" + using r_consistent_diverg[OF assms(1)] assms False by simp + ultimately show ?thesis by simp +qed + +lemma consistent_in_P2: + assumes "\ \ \

\<^sup>2" + shows "consistent \ \ \

\<^sup>2" + using assms r_consistent P2E[OF assms(1)] P2I r_consistent_recfn by metis + +lemma consistent_for_R2: + assumes "\ \ \\<^sup>2" + shows "consistent \ i e = + (if \j i j \= e_nth e j then Some 0 else Some 1)" + using assms by (simp add: consistent_def) + +lemma consistent_init: + assumes "\ \ \\<^sup>2" and "f \ \" + shows "consistent \ i (f \ n) = (if \ i \ n = f \ n then Some 0 else Some 1)" + using consistent_def[of _ _ "init f n"] assms init_eq_iff_eq_upto by simp + +lemma consistent_in_R2: + assumes "\ \ \\<^sup>2" + shows "consistent \ \ \\<^sup>2" + using total2I consistent_in_P2 consistent_for_R2[OF assms] P2_total_imp_R2 R2_imp_P2 assms + by (metis option.simps(3)) + +text \For total hypothesis spaces the next function computes the +minimum hypothesis consistent with a given prefix. It diverges if no such +hypothesis exists.\ + +definition min_cons_hyp :: "partial2 \ partial1" where + "min_cons_hyp \ e \ + if \i. consistent \ i e \= 0 then Some (LEAST i. consistent \ i e \= 0) else None" + +lemma min_cons_hyp_in_P1: + assumes "\ \ \\<^sup>2" + shows "min_cons_hyp \ \ \

" +proof - + from assms consistent_in_R2 obtain rc where + rc: "recfn 2 rc" "total rc" "\i e. eval rc [i, e] = consistent \ i e" + using R2E[of "consistent \"] by metis + define r where "r = Mn 1 rc" + then have "recfn 1 r" + using rc(1) by simp + moreover from this have "eval r [e] = min_cons_hyp \ e" for e + using r_def eval_Mn'[of 1 rc "[e]"] rc min_cons_hyp_def assms + by (auto simp add: consistent_in_R2) + ultimately show ?thesis by auto +qed + +text \The function @{term "min_cons_hyp \"} is a strategy for +learning all NUM classes embedded in @{term \}. It is an example of an +``identification-by-enumeration'' strategy.\ + +lemma NUM_imp_learn_total: + assumes "\ \ \\<^sup>2" and "U \ NUM_wrt \" + shows "learn_total \ U (min_cons_hyp \)" +proof (rule learn_totalI) + have ex_psi_i_f: "\i. \ i = f" if "f \ U" for f + using assms that NUM_wrt_def by simp + moreover have consistent_eq_0: "consistent \ i ((\ i) \ n) \= 0" for i n + using assms by (simp add: consistent_init) + ultimately have "\f n. f \ U \ min_cons_hyp \ (f \ n) \" + using min_cons_hyp_def assms(1) by fastforce + then show env: "environment \ U (min_cons_hyp \)" + using assms NUM_wrt_def min_cons_hyp_in_P1 NUM_E(1) NUM_I by auto + + show "\f n. f \ U \ \ (the (min_cons_hyp \ (f \ n))) \ \" + using assms by (simp) + + show "\i. \ i = f \ (\\<^sup>\n. min_cons_hyp \ (f \ n) \= i)" if "f \ U" for f + proof - + from that env have "f \ \" by auto + + let ?P = "\i. \ i = f" + define imin where "imin \ Least ?P" + with ex_psi_i_f that have imin: "?P imin" "\j. ?P j \ j \ imin" + using LeastI_ex[of ?P] Least_le[of ?P] by simp_all + then have f_neq: "\ i \ f" if "i < imin" for i + using leD that by auto + + let ?Q = "\i n. \ i \ n \ f \ n" + define nu :: "nat \ nat" where "nu = (\i. SOME n. ?Q i n)" + have nu_neq: "\ i \ (nu i) \ f \ (nu i)" if "i < imin" for i + proof - + from assms have "\ i \ \" by simp + moreover from assms imin(1) have "f \ \" by auto + moreover have "f \ \ i" + using that f_neq by auto + ultimately have "\n. f \ n \ (\ i) \ n" + using neq_fun_neq_init by simp + then show "?Q i (nu i)" + unfolding nu_def using someI_ex[of "\n. ?Q i n"] by metis + qed + + have "\n\<^sub>0. \n\n\<^sub>0. min_cons_hyp \ (f \ n) \= imin" + proof (cases "imin = 0") + case True + then have "\n. min_cons_hyp \ (f \ n) \= imin" + using consistent_eq_0 assms(1) imin(1) min_cons_hyp_def by auto + then show ?thesis by simp + next + case False + define n\<^sub>0 where "n\<^sub>0 = Max (set (map nu [0.. n\<^sub>0" if "i < imin" for i + proof - + have "finite ?N" + using n\<^sub>0_def by simp + moreover have "?N \ {}" + using False n\<^sub>0_def by simp + moreover have "nu i \ ?N" + using that by simp + ultimately show ?thesis + using that Max_ge n\<^sub>0_def by blast + qed + then have "\ i \ n\<^sub>0 \ f \ n\<^sub>0" if "i < imin" for i + using nu_neq neq_init_forall_ge that by blast + then have *: "\ i \ n \ f \ n" if "i < imin" and "n \ n\<^sub>0" for i n + using nu_neq neq_init_forall_ge that by blast + + have "\ imin \ n = f \ n" for n + using imin(1) by simp + moreover have "(consistent \ i (f \ n) \= 0) = (\ i \ n = f \ n)" for i n + by (simp add: \f \ \\ assms(1) consistent_init) + ultimately have "min_cons_hyp \ (f \ n) \= (LEAST i. \ i \ n = f \ n)" for n + using min_cons_hyp_def[of \ "f \ n"] by auto + moreover have "(LEAST i. \ i \ n = f \ n) = imin" if "n \ n\<^sub>0" for n + proof (rule Least_equality) + show "\ imin \ n = f \ n" + using imin(1) by simp + show "\y. \ y \ n = f \ n \ imin \ y" + using imin * leI that by blast + qed + ultimately have "min_cons_hyp \ (f \ n) \= imin" if "n \ n\<^sub>0" for n + using that by blast + then show ?thesis by auto + qed + with imin(1) show ?thesis by auto + qed +qed + +corollary NUM_subseteq_TOTAL: "NUM \ TOTAL" +proof + fix U + assume "U \ NUM" + then have "\\\\\<^sup>2. \f\U. \i. \ i = f" by auto + then have "\\\\\<^sup>2. U \ NUM_wrt \" + using NUM_wrt_def by simp + then have "\\ s. learn_total \ U s" + using NUM_imp_learn_total by auto + then show "U \ TOTAL" + using TOTAL_def by auto +qed + +text \The class @{term V0} is in @{term "TOTAL - NUM"}. \ + +theorem NUM_subset_TOTAL: "NUM \ TOTAL" + using CP_subseteq_TOTAL FIN_not_subseteq_NUM FIN_subseteq_CP NUM_subseteq_TOTAL + by auto + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/Inductive_Inference_Basics.thy b/thys/Inductive_Inference/Inductive_Inference_Basics.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Inductive_Inference_Basics.thy @@ -0,0 +1,1222 @@ +chapter \Inductive inference of recursive functions\label{c:iirf}\ + +theory Inductive_Inference_Basics + imports Standard_Results +begin + +text \Inductive inference originates from work by +Solomonoff~\cite{s-ftiip1-64,s-ftiip2-64} and Gold~\cite{g-lil-67,g-lr-65} +and comes in many variations. The common theme is to infer additional +information about objects, such as formal languages or functions, from incomplete +data, such as finitely many words contained in the language or argument-value +pairs of the function. Oftentimes ``additional information'' means complete +information, such that the task becomes identification of the object. + +The basic setting in inductive inference of recursive functions is as follows. +Let us denote, for a total function $f$, by $f^n$ the code of the list +$[f(0), ..., f(n)]$. Let $U$ be a set (called \emph{class}) of total +recursive functions, and $\psi$ a binary partial recursive function +(called \emph{hypothesis space}). +A partial recursive function $S$ (called \emph{strategy}) +is said to \emph{learn $U$ in the limit with respect to $\psi$} if +for all $f \in U$, +\begin{itemize} + \item the value $S(f^n)$ is defined for all $n\in\mathbb{N}$, + \item the sequence $S(f^0), S(f^1), \ldots$ converges to an + $i\in\mathbb{N}$ with $\psi_i = f$. +\end{itemize} + +Both the output $S(f^n)$ of the strategy and its interpretation +as a function $\psi_{S(f^n)}$ are called \emph{hypothesis}. The set +of all classes learnable in the limit by $S$ with respect to $\psi$ is +denoted by $\mathrm{LIM}_\psi(S)$. Moreover we set $\mathrm{LIM}_\psi = +\bigcup_{S\in\mathcal{P}} \mathrm{LIM}_\psi(S)$ and $\mathrm{LIM} = +\bigcup_{\psi\in\mathcal{P}^2} \mathrm{LIM}_\psi$. We call the latter set the +\emph{inference type} $\mathrm{LIM}$. + +Many aspects of this setting can be varied. We shall consider: +\begin{itemize} + \item Intermediate hypotheses: $\psi_{S(f^n)}$ can be required to be total or + to be in the class $U$, or to coincide with $f$ on arguments up to $n$, or + a myriad of other conditions or combinations thereof. + \item Convergence of hypotheses: + \begin{itemize} + \item The strategy can be required to output not a sequence but a single + hypothesis, which must be correct. + \item The strategy can be required to converge to a \emph{function} rather + than an index. + \end{itemize} +\end{itemize} + +We formalize five kinds of results (\\\ and \\'\ stand for +inference types): +\begin{itemize} + \item Comparison of learning power: results of the form @{prop "\ + \ \'"}, in particular showing that the inclusion is proper + (Sections~\ref{s:fin_cp}, \ref{s:num_fin}, \ref{s:num_cp}, + \ref{s:num_total}, \ref{s:cons_lim}, \ref{s:lim_bc}, \ref{s:total_cons}, + \ref{s:r1_bc}). + \item Whether \\\ is closed under the subset relation: @{prop "U + \ \ \ V \ U \ V \ \"}. + \item Whether \\\ is closed under union: @{prop "U \ \ \ + V \ \ \ U \ V \ \"} (Section~\ref{s:union}). + \item Whether every class in \\\ can be learned with respect to a + Gödel numbering as hypothesis space (Section~\ref{s:inference_types}). + \item Whether every class in \\\ can be learned by a \emph{total} + recursive strategy (Section~\ref{s:lemma_r}). +\end{itemize} + +The bulk of this chapter is devoted to the first category of results. Most +results that we are going to formalize have been called ``classical'' by +Jantke and Beick~\cite{jb-cpnii-81}, who compare a large number of inference +types. Another comparison is by Case and Smith~\cite{cs-cicmii-83}. Angluin +and Smith~\cite{as-ii-87} give an overview of various forms of inductive +inference. + +All (interesting) proofs herein are based on my lecture notes of the +\emph{Induktive Inferenz} lectures by Rolf Wiehagen from 1999/2000 and +2000/2001 at the University of Kaiserslautern. I have given references to the +original proofs whenever I was able to find them. For the other proofs, as +well as for those that I had to contort beyond recognition, I provide proof +sketches.\ + + +section \Preliminaries\ + +text \Throughout the chapter, in particular in proof sketches, we use +the following notation. + +Let $b\in\mathbb{N}^*$ be a list of numbers. We write $|b|$ for its length +and $b_i$ for the $i$-th element ($i=0,\dots, |b| - 1$). Concatenation of +numbers and lists works in the obvious way; for instance, $jbk$ with +$j,k\in\mathbb{N}$, $b\in\mathbb{N}^*$ refers to the list $jb_0\dots +b_{|b|-1}k$. For $0 \leq i < |b|$, the term $b_{i:=v}$ denotes the list +$b_0\dots b_{i-1}vb_{i+1}\dots b_{|b|-1}$. The notation $b_{ + + +subsection \The prefixes of a function\ + +text \A \emph{prefix}, also called \emph{initial segment}, is a list of +initial values of a function.\ + +definition prefix :: "partial1 \ nat \ nat list" where + "prefix f n \ map (\x. the (f x)) [0..x. the (f x)"] by simp + +lemma prefixI: + assumes "length vs > 0" and "\x. x < length vs \ f x \= vs ! x" + shows "prefix f (length vs - 1) = vs" + using assms nth_equalityI[of "prefix f (length vs - 1)" vs] by simp + +lemma prefixI': + assumes "length vs = Suc n" and "\x. x < Suc n \ f x \= vs ! x" + shows "prefix f n = vs" + using assms nth_equalityI[of "prefix f (length vs - 1)" vs] by simp + +lemma prefixE: + assumes "prefix f (length vs - 1) = vs" + and "f \ \" + and "length vs > 0" + and "x < length vs" + shows "f x \= vs ! x" + using assms length_prefix prefix_nth[of x "length vs - 1" f] by simp + +lemma prefix_eqI: + assumes "\x. x \ n \ f x = g x" + shows "prefix f n = prefix g n" + using assms prefix_def by simp + +lemma prefix_0: "prefix f 0 = [the (f 0)]" + using prefix_def by simp + +lemma prefix_Suc: "prefix f (Suc n) = prefix f n @ [the (f (Suc n))]" + unfolding prefix_def by simp + +lemma take_prefix: + assumes "f \ \" and "k \ n" + shows "prefix f k = take (Suc k) (prefix f n)" +proof - + let ?vs = "take (Suc k) (prefix f n)" + have "length ?vs = Suc k" + using assms(2) by simp + then have "\x. x < length ?vs \ f x \= ?vs ! x" + using assms by auto + then show ?thesis + using prefixI[where ?vs="?vs"] `length ?vs = Suc k` by simp +qed + +text \Strategies receive prefixes in the form of encoded lists. The +term ``prefix'' refers to both encoded and unencoded lists. We use the +notation @{text "f \ n"} for the prefix $f^n$.\ + +definition init :: "partial1 \ nat \ nat" (infix "\" 110) where + "f \ n \ list_encode (prefix f n)" + +lemma init_neq_zero: "f \ n \ 0" + unfolding init_def prefix_def using list_encode_0 by fastforce + +lemma init_prefixE [elim]: "prefix f n = prefix g n \ f \ n = g \ n" + unfolding init_def by simp + +lemma init_eqI: + assumes "\x. x \ n \ f x = g x" + shows "f \ n = g \ n" + unfolding init_def using prefix_eqI[OF assms] by simp + +lemma initI: + assumes "e_length e > 0" and "\x. x < e_length e \ f x \= e_nth e x" + shows "f \ (e_length e - 1) = e" + unfolding init_def using assms prefixI by simp + +lemma initI': + assumes "e_length e = Suc n" and "\x. x < Suc n \ f x \= e_nth e x" + shows "f \ n = e" + unfolding init_def using assms prefixI' by simp + +lemma init_iff_list_eq_upto: + assumes "f \ \" and "e_length vs > 0" + shows "(\x= e_nth vs x) \ prefix f (e_length vs - 1) = list_decode vs" + using prefixI[OF assms(2)] prefixE[OF _ assms] by auto + +lemma length_init [simp]: "e_length (f \ n) = Suc n" + unfolding init_def by simp + +lemma init_Suc_snoc: "f \ (Suc n) = e_snoc (f \ n) (the (f (Suc n)))" + unfolding init_def by (simp add: prefix_Suc) + +lemma nth_init: "i < Suc n \ e_nth (f \ n) i = the (f i)" + unfolding init_def using prefix_nth by auto + +lemma hd_init [simp]: "e_hd (f \ n) = the (f 0)" + unfolding init_def using init_neq_zero by (simp add: e_hd_nth0) + +lemma list_decode_init [simp]: "list_decode (f \ n) = prefix f n" + unfolding init_def by simp + +lemma init_eq_iff_eq_upto: + assumes "g \ \" and "f \ \" + shows "(\j g \ n = f \ n" + using assms initI' init_iff_list_eq_upto length_init list_decode_init + by (metis diff_Suc_1 zero_less_Suc) + +definition is_init_of :: "nat \ partial1 \ bool" where + "is_init_of t f \ \i= e_nth t i" + +lemma not_initial_imp_not_eq: + assumes "\x. x < Suc n \ f x \" and "\ (is_init_of (f \ n) g)" + shows "f \ g" + using is_init_of_def assms by auto + +lemma all_init_eq_imp_fun_eq: + assumes "f \ \" and "g \ \" and "\n. f \ n = g \ n" + shows "f = g" +proof + fix n + from assms have "prefix f n = prefix g n" + by (metis init_def list_decode_encode) + then have "the (f n) = the (g n)" + unfolding init_def prefix_def by simp + then show "f n = g n" + using assms(1,2) by (meson R1_imp_total1 option.expand total1E) +qed + +corollary neq_fun_neq_init: + assumes "f \ \" and "g \ \" and "f \ g" + shows "\n. f \ n \ g \ n" + using assms all_init_eq_imp_fun_eq by auto + +lemma eq_init_forall_le: + assumes "f \ n = g \ n" and "m \ n" + shows "f \ m = g \ m" +proof - + from assms(1) have "prefix f n = prefix g n" + by (metis init_def list_decode_encode) + then have "the (f k) = the (g k)" if "k \ n" for k + using prefix_def that by auto + then have "the (f k) = the (g k)" if "k \ m" for k + using assms(2) that by simp + then have "prefix f m = prefix g m" + using prefix_def by simp + then show ?thesis by (simp add: init_def) +qed + +corollary neq_init_forall_ge: + assumes "f \ n \ g \ n" and "m \ n" + shows "f \ m \ g \ m" + using eq_init_forall_le assms by blast + +lemma e_take_init: + assumes "f \ \" and "k < Suc n" + shows "e_take (Suc k) (f \ n) = f \ k" + using assms take_prefix by (simp add: init_def less_Suc_eq_le) + +lemma init_butlast_init: + assumes "total1 f" and "f \ n = e" and "n > 0" + shows "f \ (n - 1) = e_butlast e" +proof - + let ?e = "e_butlast e" + have "e_length e = Suc n" + using assms(2) by auto + then have len: "e_length ?e = n" + by simp + have "f \ (e_length ?e - 1) = ?e" + proof (rule initI) + show "0 < e_length ?e" + using assms(3) len by simp + have "\x. x < e_length e \ f x \= e_nth e x" + using assms(1,2) total1_def \e_length e = Suc n\ by auto + then show "\x. x < e_length ?e \ f x \= e_nth ?e x" + by (simp add: butlast_conv_take) + qed + with len show ?thesis by simp +qed + +text \Some definitions make use of recursive predicates, that is, +$01$-valued functions.\ + +definition RPred1 :: "partial1 set" ("\\<^sub>0\<^sub>1") where + "\\<^sub>0\<^sub>1 \ {f. f \ \ \ (\x. f x \= 0 \ f x \= 1)}" + +lemma RPred1_subseteq_R1: "\\<^sub>0\<^sub>1 \ \" + unfolding RPred1_def by auto + +lemma const0_in_RPred1: "(\_. Some 0) \ \\<^sub>0\<^sub>1" + using RPred1_def const_in_Prim1 by fast + +lemma RPred1_altdef: "\\<^sub>0\<^sub>1 = {f. f \ \ \ (\x. the (f x) \ 1)}" + (is "\\<^sub>0\<^sub>1 = ?S") +proof + show "\\<^sub>0\<^sub>1 \ ?S" + proof + fix f + assume f: "f \ \\<^sub>0\<^sub>1" + with RPred1_def have "f \ \" by auto + from f have "\x. f x \= 0 \ f x \= 1" + by (simp add: RPred1_def) + then have "\x. the (f x) \ 1" + by (metis eq_refl less_Suc_eq_le zero_less_Suc option.sel) + with `f \ \` show "f \ ?S" by simp + qed + show "?S \ \\<^sub>0\<^sub>1" + proof + fix f + assume f: "f \ ?S" + then have "f \ \" by simp + then have total: "\x. f x \" by auto + from f have "\x. the (f x) = 0 \ the (f x) = 1" + by (simp add: le_eq_less_or_eq) + with total have "\x. f x \= 0 \ f x \= 1" + by (metis option.collapse) + then show "f \ \\<^sub>0\<^sub>1" + using `f \ \` RPred1_def by auto + qed +qed + +subsection \NUM\ + +text \A class of recursive functions is in NUM if it can be +embedded in a total numbering. Thus, for learning such classes there is +always a total hypothesis space available.\ + +definition NUM :: "partial1 set set" where + "NUM \ {U. \\\\\<^sup>2. \f\U. \i. \ i = f}" + +definition NUM_wrt :: "partial2 \ partial1 set set" where + "\ \ \\<^sup>2 \ NUM_wrt \ \ {U. \f\U. \i. \ i = f}" + +lemma NUM_I [intro]: + assumes "\ \ \\<^sup>2" and "\f. f \ U \ \i. \ i = f" + shows "U \ NUM" + using assms NUM_def by blast + +lemma NUM_E [dest]: + assumes "U \ NUM" + shows "U \ \" + and "\\\\\<^sup>2. \f\U. \i. \ i = f" + using NUM_def assms by (force, auto) + +lemma NUM_closed_subseteq: + assumes "U \ NUM" and "V \ U" + shows "V \ NUM" + using assms subset_eq[of V U] NUM_I by auto + +text \This is the classical diagonalization proof showing that there is +no total numbering containing all total recursive functions.\ + +lemma R1_not_in_NUM: "\ \ NUM" +proof + assume "\ \ NUM" + then obtain \ where num: "\ \ \\<^sup>2" "\f\\. \i. \ i = f" + by auto + then obtain psi where psi: "recfn 2 psi" "total psi" "eval psi [i, x] = \ i x" for i x + by auto + define d where "d = Cn 1 S [Cn 1 psi [Id 1 0, Id 1 0]]" + then have "recfn 1 d" + using psi(1) by simp + moreover have d: "eval d [x] \= Suc (the (\ x x))" for x + unfolding d_def using num psi by simp + ultimately have "(\x. eval d [x]) \ \" + using R1I by blast + then obtain i where "\ i = (\x. eval d [x])" + using num(2) by auto + then have "\ i i = eval d [i]" by simp + with d have "\ i i \= Suc (the (\ i i))" by simp + then show False + using option.sel[of "Suc (the (\ i i))"] by simp +qed + +text \A hypothesis space that contains a function for every prefix will +come in handy. The following is a total numbering with this property.\ + +definition "r_prenum \ + Cn 2 r_ifless [Id 2 1, Cn 2 r_length [Id 2 0], Cn 2 r_nth [Id 2 0, Id 2 1], r_constn 1 0]" + +lemma r_prenum_prim [simp]: "prim_recfn 2 r_prenum" + unfolding r_prenum_def by simp_all + +lemma r_prenum [simp]: + "eval r_prenum [e, x] \= (if x < e_length e then e_nth e x else 0)" + by (simp add: r_prenum_def) + +definition prenum :: partial2 where + "prenum e x \ Some (if x < e_length e then e_nth e x else 0)" + +lemma prenum_in_R2: "prenum \ \\<^sup>2" + using prenum_def Prim2I[OF r_prenum_prim, of prenum] by simp + +lemma prenum [simp]: "prenum e x \= (if x < e_length e then e_nth e x else 0)" + unfolding prenum_def .. + +lemma prenum_encode: + "prenum (list_encode vs) x \= (if x < length vs then vs ! x else 0)" + using prenum_def by (cases "x < length vs") simp_all + +text \Prepending a list of numbers to a function:\ + +definition prepend :: "nat list \ partial1 \ partial1" (infixr "\" 64) where + "vs \ f \ \x. if x < length vs then Some (vs ! x) else f (x - length vs)" + +lemma prepend [simp]: + "(vs \ f) x = (if x < length vs then Some (vs ! x) else f (x - length vs))" + unfolding prepend_def .. + +lemma prepend_total: "total1 f \ total1 (vs \ f)" + unfolding total1_def by simp + +lemma prepend_at_less: + assumes "n < length vs" + shows "(vs \ f) n \= vs ! n" + using assms by simp + +lemma prepend_at_ge: + assumes "n \ length vs" + shows "(vs \ f) n = f (n - length vs)" + using assms by simp + +lemma prefix_prepend_less: + assumes "n < length vs" + shows "prefix (vs \ f) n = take (Suc n) vs" + using assms length_prefix by (intro nth_equalityI) simp_all + +lemma prepend_eqI: + assumes "\x. x < length vs \ g x \= vs ! x" + and "\x. g (length vs + x) = f x" + shows "g = vs \ f" +proof + fix x + show "g x = (vs \ f) x" + proof (cases "x < length vs") + case True + then show ?thesis using assms by simp + next + case False + then show ?thesis + using assms prepend by (metis add_diff_inverse_nat) + qed +qed + +fun r_prepend :: "nat list \ recf \ recf" where + "r_prepend [] r = r" +| "r_prepend (v # vs) r = + Cn 1 (r_lifz (r_const v) (Cn 1 (r_prepend vs r) [r_dec])) [Id 1 0, Id 1 0]" + +lemma r_prepend_recfn: + assumes "recfn 1 r" + shows "recfn 1 (r_prepend vs r)" + using assms by (induction vs) simp_all + +lemma r_prepend: + assumes "recfn 1 r" + shows "eval (r_prepend vs r) [x] = + (if x < length vs then Some (vs ! x) else eval r [x - length vs])" +proof (induction vs arbitrary: x) + case Nil + then show ?case using assms by simp +next + case (Cons v vs) + show ?case + using assms Cons by (cases "x = 0") (auto simp add: r_prepend_recfn) +qed + +lemma r_prepend_total: + assumes "recfn 1 r" and "total r" + shows "eval (r_prepend vs r) [x] \= + (if x < length vs then vs ! x else the (eval r [x - length vs]))" +proof (induction vs arbitrary: x) + case Nil + then show ?case using assms by simp +next + case (Cons v vs) + show ?case + using assms Cons by (cases "x = 0") (auto simp add: r_prepend_recfn) +qed + +lemma prepend_in_P1: + assumes "f \ \

" + shows "vs \ f \ \

" +proof - + obtain r where r: "recfn 1 r" "\x. eval r [x] = f x" + using assms by auto + moreover have "recfn 1 (r_prepend vs r)" + using r r_prepend_recfn by simp + moreover have "eval (r_prepend vs r) [x] = (vs \ f) x" for x + using r r_prepend by simp + ultimately show ?thesis by blast +qed + +lemma prepend_in_R1: + assumes "f \ \" + shows "vs \ f \ \" +proof - + obtain r where r: "recfn 1 r" "total r" "\x. eval r [x] = f x" + using assms by auto + then have "total1 f" + using R1_imp_total1[OF assms] by simp + have "total (r_prepend vs r)" + using r r_prepend_total r_prepend_recfn totalI1[of "r_prepend vs r"] by simp + with r have "total (r_prepend vs r)" by simp + moreover have "recfn 1 (r_prepend vs r)" + using r r_prepend_recfn by simp + moreover have "eval (r_prepend vs r) [x] = (vs \ f) x" for x + using r r_prepend `total1 f` total1E by simp + ultimately show ?thesis by auto +qed + +lemma prepend_associative: "(us @ vs) \ f = us \ vs \ f" (is "?lhs = ?rhs") +proof + fix x + consider + "x < length us" + | "x \ length us \ x < length (us @ vs)" + | "x \ length (us @ vs)" + by linarith + then show "?lhs x = ?rhs x" + proof (cases) + case 1 + then show ?thesis + by (metis le_add1 length_append less_le_trans nth_append prepend_at_less) + next + case 2 + then show ?thesis + by (smt add_diff_inverse_nat add_less_cancel_left length_append nth_append prepend) + next + case 3 + then show ?thesis + using prepend_at_ge by auto + qed +qed + +abbreviation constant_divergent :: partial1 ("\\<^sup>\") where + "\\<^sup>\ \ \_. None" + +abbreviation constant_zero :: partial1 ("0\<^sup>\") where + "0\<^sup>\ \ \_. Some 0" + +lemma almost0_in_R1: "vs \ 0\<^sup>\ \ \" + using RPred1_subseteq_R1 const0_in_RPred1 prepend_in_R1 by auto + +text \The class $U_0$ of all total recursive functions that are almost +everywhere zero will be used several times to construct +(counter-)examples.\ + +definition U0 :: "partial1 set" ("U\<^sub>0") where + "U\<^sub>0 \ {vs \ 0\<^sup>\ |vs. vs \ UNIV}" + +text \The class @{term U0} contains exactly the functions in the +numbering @{term prenum}.\ + +lemma U0_altdef: "U\<^sub>0 = {prenum e| e. e \ UNIV}" (is "U\<^sub>0 = ?W") +proof + show "U\<^sub>0 \ ?W" + proof + fix f + assume "f \ U\<^sub>0" + with U0_def obtain vs where "f = vs \ 0\<^sup>\" + by auto + then have "f = prenum (list_encode vs)" + using prenum_encode by auto + then show "f \ ?W" by auto + qed + show "?W \ U\<^sub>0" + unfolding U0_def by fastforce +qed + +lemma U0_in_NUM: "U\<^sub>0 \ NUM" + using prenum_in_R2 U0_altdef by (intro NUM_I[of prenum]; force) + +text \Every almost-zero function can be represented by $v0^\infty$ for +a list $v$ not ending in zero.\ + +lemma almost0_canonical: + assumes "f = vs \ 0\<^sup>\" and "f \ 0\<^sup>\" + obtains ws where "length ws > 0" and "last ws \ 0" and "f = ws \ 0\<^sup>\" +proof - + let ?P = "\k. k < length vs \ vs ! k \ 0" + from assms have "vs \ []" + by auto + then have ex: "\k 0" + using assms by auto + define m where "m = Greatest ?P" + moreover have le: "\y. ?P y \ y \ length vs" + by simp + ultimately have "?P m" + using ex GreatestI_ex_nat[of ?P "length vs"] by simp + have not_gr: "\ ?P k" if "k > m" for k + using Greatest_le_nat[of ?P _ "length vs"] m_def ex le not_less that by blast + let ?ws = "take (Suc m) vs" + have "vs \ 0\<^sup>\ = ?ws \ 0\<^sup>\" + proof + fix x + show "(vs \ 0\<^sup>\) x = (?ws \ 0\<^sup>\) x" + proof (cases "x < Suc m") + case True + then show ?thesis using `?P m` by simp + next + case False + moreover from this have "(?ws \ 0\<^sup>\) x \= 0" + by simp + ultimately show ?thesis + using not_gr by (cases "x < length vs") simp_all + qed + qed + then have "f = ?ws \ 0\<^sup>\" + using assms(1) by simp + moreover have "length ?ws > 0" + by (simp add: \vs \ []\) + moreover have "last ?ws \ 0" + by (simp add: \?P m\ take_Suc_conv_app_nth) + ultimately show ?thesis using that by blast +qed + + +section \Types of inference\label{s:inference_types}\ + +text \This section introduces all inference types that we are going to +consider together with some of their simple properties. All these inference +types share the following condition, which essentially says that everything +must be computable:\ + +abbreviation environment :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "environment \ U s \ \ \ \

\<^sup>2 \ U \ \ \ s \ \

\ (\f\U. \n. s (f \ n) \)" + + +subsection \LIM: Learning in the limit\ + +text \A strategy $S$ learns a class $U$ in the limit with respect to a +hypothesis space @{term "\ \ \

\<^sup>2"} if for all $f\in U$, the +sequence $(S(f^n))_{n\in\mathbb{N}}$ converges to an $i$ with $\psi_i = f$. +Convergence for a sequence of natural numbers means that almost all elements +are the same. We express this with the following notation.\ + +abbreviation Almost_All :: "(nat \ bool) \ bool" (binder "\\<^sup>\" 10) where + "\\<^sup>\n. P n \ \n\<^sub>0. \n\n\<^sub>0. P n" + +definition learn_lim :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "learn_lim \ U s \ + environment \ U s \ + (\f\U. \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i))" + +lemma learn_limE: + assumes "learn_lim \ U s" + shows "environment \ U s" + and "\f. f \ U \ \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" + using assms learn_lim_def by auto + +lemma learn_limI: + assumes "environment \ U s" + and "\f. f \ U \ \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" + shows "learn_lim \ U s" + using assms learn_lim_def by auto + +definition LIM_wrt :: "partial2 \ partial1 set set" where + "LIM_wrt \ \ {U. \s. learn_lim \ U s}" + +definition Lim :: "partial1 set set" ("LIM") where + "LIM \ {U. \\ s. learn_lim \ U s}" + +text \LIM is closed under the the subset relation.\ + +lemma learn_lim_closed_subseteq: + assumes "learn_lim \ U s" and "V \ U" + shows "learn_lim \ V s" + using assms learn_lim_def by auto + +corollary LIM_closed_subseteq: + assumes "U \ LIM" and "V \ U" + shows "V \ LIM" + using assms learn_lim_closed_subseteq by (smt Lim_def mem_Collect_eq) + +text \Changing the hypothesis infinitely often precludes learning in +the limit.\ + +lemma infinite_hyp_changes_not_Lim: + assumes "f \ U" and "\n. \m\<^sub>1>n. \m\<^sub>2>n. s (f \ m\<^sub>1) \ s (f \ m\<^sub>2)" + shows "\ learn_lim \ U s" + using assms learn_lim_def by (metis less_imp_le) + +lemma always_hyp_change_not_Lim: + assumes "\x. s (f \ (Suc x)) \ s (f \ x)" + shows "\ learn_lim \ {f} s" + using assms learn_limE by (metis le_SucI order_refl singletonI) + +text \Guessing a wrong hypothesis infinitely often precludes learning +in the limit.\ + +lemma infinite_hyp_wrong_not_Lim: + assumes "f \ U" and "\n. \m>n. \ (the (s (f \ m))) \ f" + shows "\ learn_lim \ U s" + using assms learn_limE by (metis less_imp_le option.sel) + +text \Converging to the same hypothesis on two functions precludes +learning in the limit.\ + +lemma same_hyp_for_two_not_Lim: + assumes "f\<^sub>1 \ U" + and "f\<^sub>2 \ U" + and "f\<^sub>1 \ f\<^sub>2" + and "\n\n\<^sub>1. s (f\<^sub>1 \ n) = h" + and "\n\n\<^sub>2. s (f\<^sub>2 \ n) = h" + shows "\ learn_lim \ U s" + using assms learn_limE by (metis le_cases option.sel) + +text \Every class that can be learned in the limit can be learned in +the limit with respect to any Gödel numbering. We prove a generalization in +which hypotheses may have to satisfy an extra condition, so we can re-use it +for other inference types later.\ + +lemma learn_lim_extra_wrt_goedel: + fixes extra :: "(partial1 set) \ partial1 \ nat \ partial1 \ bool" + assumes "goedel_numbering \" + and "learn_lim \ U s" + and "\f n. f \ U \ extra U f n (\ (the (s (f \ n))))" + shows "\t. learn_lim \ U t \ (\f\U. \n. extra U f n (\ (the (t (f \ n)))))" +proof - + have env: "environment \ U s" + and lim: "learn_lim \ U s" + and extra: "\f\U. \n. extra U f n (\ (the (s (f \ n))))" + using assms learn_limE by auto + obtain c where c: "c \ \" "\i. \ i = \ (the (c i))" + using env goedel_numberingE[OF assms(1), of \] by auto + define t where "t \ + (\x. if s x \ \ c (the (s x)) \ then Some (the (c (the (s x)))) else None)" + have "t \ \

" + unfolding t_def using env c concat_P1_P1[of c s] by auto + have "t x = (if s x \ then Some (the (c (the (s x)))) else None)" for x + using t_def c(1) R1_imp_total1 by auto + then have t: "t (f \ n) \= the (c (the (s (f \ n))))" if "f \ U" for f n + using lim learn_limE that by simp + have "learn_lim \ U t" + proof (rule learn_limI) + show "environment \ U t" + using t by (simp add: \t \ \

\ env goedel_numbering_P2[OF assms(1)]) + show "\i. \ i = f \ (\\<^sup>\n. t (f \ n) \= i)" if "f \ U" for f + proof - + from lim learn_limE(2) obtain i n\<^sub>0 where + i: "\ i = f \ (\n\n\<^sub>0. s (f \ n) \= i)" + using \f \ U\ by blast + let ?j = "the (c i)" + have "\ ?j = f" + using c(2) i by simp + moreover have "t (f \ n) \= ?j" if "n \ n\<^sub>0" for n + by (simp add: \f \ U\ i t that) + ultimately show ?thesis by auto + qed + qed + moreover have "extra U f n (\ (the (t (f \ n))))" if "f \ U" for f n + proof - + from t have "the (t (f \ n)) = the (c (the (s (f \ n))))" + by (simp add: that) + then have "\ (the (t (f \ n))) = \ (the (s (f \ n)))" + using c(2) by simp + with extra show ?thesis using that by simp + qed + ultimately show ?thesis by auto +qed + +lemma learn_lim_wrt_goedel: + assumes "goedel_numbering \" and "learn_lim \ U s" + shows "\t. learn_lim \ U t" + using assms learn_lim_extra_wrt_goedel[where ?extra="\U f n h. True"] + by simp + +lemma LIM_wrt_phi_eq_Lim: "LIM_wrt \ = LIM" + using LIM_wrt_def Lim_def learn_lim_wrt_goedel[OF goedel_numbering_phi] + by blast + + +subsection \BC: Behaviorally correct learning in the limit\ + +text \Behaviorally correct learning in the limit relaxes LIM by +requiring that the strategy almost always output an index for the target +function, but not necessarily the same index. In other words convergence of +$(S(f^n))_{n\in\mathbb{N}}$ is replaced by convergence of +$(\psi_{S(f^n)})_{n\in\mathbb{N}}$.\ + +definition learn_bc :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "learn_bc \ U s \ + environment \ U s \ + (\f\U. \\<^sup>\n. \ (the (s (f \ n))) = f)" + +lemma learn_bcE: + assumes "learn_bc \ U s" + shows "environment \ U s" + and "\f. f \ U \ \\<^sup>\n. \ (the (s (f \ n))) = f" + using assms learn_bc_def by auto + +lemma learn_bcI: + assumes "environment \ U s" + and "\f. f \ U \ \\<^sup>\n. \ (the (s (f \ n))) = f" + shows "learn_bc \ U s" + using assms learn_bc_def by auto + +definition BC_wrt :: "partial2 \ partial1 set set" where + "BC_wrt \ \ {U. \s. learn_bc \ U s}" + +definition BC :: "partial1 set set" where + "BC \ {U. \\ s. learn_bc \ U s}" + +text \BC is a superset of LIM and closed under the subset relation.\ + +lemma learn_lim_imp_BC: "learn_lim \ U s \ learn_bc \ U s" + using learn_limE learn_bcI[of \ U s] by fastforce + +lemma Lim_subseteq_BC: "LIM \ BC" + using learn_lim_imp_BC Lim_def BC_def by blast + +lemma learn_bc_closed_subseteq: + assumes "learn_bc \ U s" and "V \ U" + shows "learn_bc \ V s" + using assms learn_bc_def by auto + +corollary BC_closed_subseteq: + assumes "U \ BC" and "V \ U" + shows "V \ BC" + using assms by (smt BC_def learn_bc_closed_subseteq mem_Collect_eq) + +text \Just like with LIM, guessing a wrong hypothesis infinitely often +precludes BC-style learning.\ + +lemma infinite_hyp_wrong_not_BC: + assumes "f \ U" and "\n. \m>n. \ (the (s (f \ m))) \ f" + shows "\ learn_bc \ U s" +proof + assume "learn_bc \ U s" + then obtain n\<^sub>0 where "\n\n\<^sub>0. \ (the (s (f \ n))) = f" + using learn_bcE assms(1) by metis + with assms(2) show False using less_imp_le by blast +qed + +text \The proof that Gödel numberings suffice as hypothesis spaces for +BC is similar to the one for @{thm[source] learn_lim_extra_wrt_goedel}. We do +not need the @{term extra} part for BC, but we get it for free.\ + +lemma learn_bc_extra_wrt_goedel: + fixes extra :: "(partial1 set) \ partial1 \ nat \ partial1 \ bool" + assumes "goedel_numbering \" + and "learn_bc \ U s" + and "\f n. f \ U \ extra U f n (\ (the (s (f \ n))))" + shows "\t. learn_bc \ U t \ (\f\U. \n. extra U f n (\ (the (t (f \ n)))))" +proof - + have env: "environment \ U s" + and lim: "learn_bc \ U s" + and extra: "\f\U. \n. extra U f n (\ (the (s (f \ n))))" + using assms learn_bc_def by auto + obtain c where c: "c \ \" "\i. \ i = \ (the (c i))" + using env goedel_numberingE[OF assms(1), of \] by auto + define t where + "t = (\x. if s x \ \ c (the (s x)) \ then Some (the (c (the (s x)))) else None)" + have "t \ \

" + unfolding t_def using env c concat_P1_P1[of c s] by auto + have "t x = (if s x \ then Some (the (c (the (s x)))) else None)" for x + using t_def c(1) R1_imp_total1 by auto + then have t: "t (f \ n) \= the (c (the (s (f \ n))))" if "f \ U" for f n + using lim learn_bcE(1) that by simp + have "learn_bc \ U t" + proof (rule learn_bcI) + show "environment \ U t" + using t by (simp add: \t \ \

\ env goedel_numbering_P2[OF assms(1)]) + show "\\<^sup>\n. \ (the (t (f \ n))) = f" if "f \ U" for f + proof - + obtain n\<^sub>0 where "\n\n\<^sub>0. \ (the (s (f \ n))) = f" + using lim learn_bcE(2) \f \ U\ by blast + then show ?thesis using that t c(2) by auto + qed + qed + moreover have "extra U f n (\ (the (t (f \ n))))" if "f \ U" for f n + proof - + from t have "the (t (f \ n)) = the (c (the (s (f \ n))))" + by (simp add: that) + then have "\ (the (t (f \ n))) = \ (the (s (f \ n)))" + using c(2) by simp + with extra show ?thesis using that by simp + qed + ultimately show ?thesis by auto +qed + +corollary learn_bc_wrt_goedel: + assumes "goedel_numbering \" and "learn_bc \ U s" + shows "\t. learn_bc \ U t" + using assms learn_bc_extra_wrt_goedel[where ?extra="\_ _ _ _. True"] by simp + +corollary BC_wrt_phi_eq_BC: "BC_wrt \ = BC" + using learn_bc_wrt_goedel goedel_numbering_phi BC_def BC_wrt_def by blast + + +subsection \CONS: Learning in the limit with consistent hypotheses\ + +text \A hypothesis is \emph{consistent} if it matches all values in the +prefix given to the strategy. Consistent learning in the limit requires the +strategy to output only consistent hypotheses for prefixes from the class.\ + +definition learn_cons :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "learn_cons \ U s \ + learn_lim \ U s \ + (\f\U. \n. \k\n. \ (the (s (f \ n))) k = f k)" + +definition CONS_wrt :: "partial2 \ partial1 set set" where + "CONS_wrt \ \ {U. \s. learn_cons \ U s}" + +definition CONS :: "partial1 set set" where + "CONS \ {U. \\ s. learn_cons \ U s}" + +lemma CONS_subseteq_Lim: "CONS \ LIM" + using CONS_def Lim_def learn_cons_def by blast + +lemma learn_consI: + assumes "environment \ U s" + and "\f. f \ U \ \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" + and "\f n. f \ U \ \k\n. \ (the (s (f \ n))) k = f k" + shows "learn_cons \ U s" + using assms learn_lim_def learn_cons_def by simp + +text \If a consistent strategy converges, it automatically converges to +a correct hypothesis. Thus we can remove @{term "\ i = f"} from the second +assumption in the previous lemma.\ + +lemma learn_consI2: + assumes "environment \ U s" + and "\f. f \ U \ \i. \\<^sup>\n. s (f \ n) \= i" + and "\f n. f \ U \ \k\n. \ (the (s (f \ n))) k = f k" + shows "learn_cons \ U s" +proof (rule learn_consI) + show "environment \ U s" + and cons: "\f n. f \ U \ \k\n. \ (the (s (f \ n))) k = f k" + using assms by simp_all + show "\i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" if "f \ U" for f + proof - + from that assms(2) obtain i n\<^sub>0 where i_n0: "\n\n\<^sub>0. s (f \ n) \= i" + by blast + have "\ i x = f x" for x + proof (cases "x \ n\<^sub>0") + case True + then show ?thesis + using i_n0 cons that by fastforce + next + case False + moreover have "\k\x. \ (the (s (f \ x))) k = f k" + using cons that by simp + ultimately show ?thesis using i_n0 by simp + qed + with i_n0 show ?thesis by auto + qed +qed + +lemma learn_consE: + assumes "learn_cons \ U s" + shows "environment \ U s" + and "\f. f \ U \ \i n\<^sub>0. \ i = f \ (\n\n\<^sub>0. s (f \ n) \= i)" + and "\f n. f \ U \ \k\n. \ (the (s (f \ n))) k = f k" + using assms learn_cons_def learn_lim_def by auto + +lemma learn_cons_wrt_goedel: + assumes "goedel_numbering \" and "learn_cons \ U s" + shows "\t. learn_cons \ U t" + using learn_cons_def assms + learn_lim_extra_wrt_goedel[where ?extra="\U f n h. \k\n. h k = f k"] + by auto + +lemma CONS_wrt_phi_eq_CONS: "CONS_wrt \ = CONS" + using CONS_wrt_def CONS_def learn_cons_wrt_goedel goedel_numbering_phi + by blast + +lemma learn_cons_closed_subseteq: + assumes "learn_cons \ U s" and "V \ U" + shows "learn_cons \ V s" + using assms learn_cons_def learn_lim_closed_subseteq by auto + +lemma CONS_closed_subseteq: + assumes "U \ CONS" and "V \ U" + shows "V \ CONS" + using assms learn_cons_closed_subseteq by (smt CONS_def mem_Collect_eq) + +text \A consistent strategy cannot output the same hypothesis for two +different prefixes from the class to be learned.\ + +lemma same_hyp_different_init_not_cons: + assumes "f \ U" + and "g \ U" + and "f \ n \ g \ n" + and "s (f \ n) = s (g \ n)" + shows "\ learn_cons \ U s" + unfolding learn_cons_def by (auto, metis assms init_eqI) + + +subsection \TOTAL: Learning in the limit with total hypotheses\ + +text \Total learning in the limit requires the strategy to hypothesize +only total functions for prefixes from the class.\ + +definition learn_total :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "learn_total \ U s \ + learn_lim \ U s \ + (\f\U. \n. \ (the (s (f \ n))) \ \)" + +definition TOTAL_wrt :: "partial2 \ partial1 set set" where + "TOTAL_wrt \ \ {U. \s. learn_total \ U s}" + +definition TOTAL :: "partial1 set set" where + "TOTAL \ {U. \\ s. learn_total \ U s}" + +lemma TOTAL_subseteq_LIM: "TOTAL \ LIM" + unfolding TOTAL_def Lim_def using learn_total_def by auto + +lemma learn_totalI: + assumes "environment \ U s" + and "\f. f \ U \ \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" + and "\f n. f \ U \ \ (the (s (f \ n))) \ \" + shows "learn_total \ U s" + using assms learn_lim_def learn_total_def by auto + +lemma learn_totalE: + assumes "learn_total \ U s" + shows "environment \ U s" + and "\f. f \ U \ \i n\<^sub>0. \ i = f \ (\n\n\<^sub>0. s (f \ n) \= i)" + and "\f n. f \ U \ \ (the (s (f \ n))) \ \" + using assms learn_lim_def learn_total_def by auto + +lemma learn_total_wrt_goedel: + assumes "goedel_numbering \" and "learn_total \ U s" + shows "\t. learn_total \ U t" + using learn_total_def assms learn_lim_extra_wrt_goedel[where ?extra="\U f n h. h \ \"] + by auto + +lemma TOTAL_wrt_phi_eq_TOTAL: "TOTAL_wrt \ = TOTAL" + using TOTAL_wrt_def TOTAL_def learn_total_wrt_goedel goedel_numbering_phi + by blast + +lemma learn_total_closed_subseteq: + assumes "learn_total \ U s" and "V \ U" + shows "learn_total \ V s" + using assms learn_total_def learn_lim_closed_subseteq by auto + +lemma TOTAL_closed_subseteq: + assumes "U \ TOTAL" and "V \ U" + shows "V \ TOTAL" + using assms learn_total_closed_subseteq by (smt TOTAL_def mem_Collect_eq) + + +subsection \CP: Learning in the limit with class-preserving hypotheses\ + +text \Class-preserving learning in the limit requires all hypotheses +for prefixes from the class to be functions from the class.\ + +definition learn_cp :: "partial2 \ (partial1 set) \ partial1 \ bool" where + "learn_cp \ U s \ + learn_lim \ U s \ + (\f\U. \n. \ (the (s (f \ n))) \ U)" + +definition CP_wrt :: "partial2 \ partial1 set set" where + "CP_wrt \ \ {U. \s. learn_cp \ U s}" + +definition CP :: "partial1 set set" where + "CP \ {U. \\ s. learn_cp \ U s}" + +lemma learn_cp_wrt_goedel: + assumes "goedel_numbering \" and "learn_cp \ U s" + shows "\t. learn_cp \ U t" + using learn_cp_def assms learn_lim_extra_wrt_goedel[where ?extra="\U f n h. h \ U"] + by auto + +corollary CP_wrt_phi: "CP = CP_wrt \" + using learn_cp_wrt_goedel[OF goedel_numbering_phi] + by (smt CP_def CP_wrt_def Collect_cong) + +lemma learn_cpI: + assumes "environment \ U s" + and "\f. f \ U \ \i. \ i = f \ (\\<^sup>\n. s (f \ n) \= i)" + and "\f n. f \ U \ \ (the (s (f \ n))) \ U" + shows "learn_cp \ U s" + using assms learn_cp_def learn_lim_def by auto + +lemma learn_cpE: + assumes "learn_cp \ U s" + shows "environment \ U s" + and "\f. f \ U \ \i n\<^sub>0. \ i = f \ (\n\n\<^sub>0. s (f \ n) \= i)" + and "\f n. f \ U \ \ (the (s (f \ n))) \ U" + using assms learn_lim_def learn_cp_def by auto + +text \Since classes contain only total functions, a CP strategy is also +a TOTAL strategy.\ + +lemma learn_cp_imp_total: "learn_cp \ U s \ learn_total \ U s" + using learn_cp_def learn_total_def learn_lim_def by auto + +lemma CP_subseteq_TOTAL: "CP \ TOTAL" + using learn_cp_imp_total CP_def TOTAL_def by blast + + +subsection \FIN: Finite learning\ + +text \In general it is undecidable whether a LIM strategy has reached +its final hypothesis. By contrast, in finite learning (also called ``one-shot +learning'') the strategy signals when it is ready to output a hypothesis. Up +until then it outputs a ``don't know yet'' value. This value is represented +by zero and the actual hypothesis $i$ by $i + 1$.\ + +definition learn_fin :: "partial2 \ partial1 set \ partial1 \ bool" where + "learn_fin \ U s \ + environment \ U s \ + (\f \ U. \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i))" + +definition FIN_wrt :: "partial2 \ partial1 set set" where + "FIN_wrt \ \ {U. \s. learn_fin \ U s}" + +definition FIN :: "partial1 set set" where + "FIN \ {U. \\ s. learn_fin \ U s}" + +lemma learn_finI: + assumes "environment \ U s" + and "\f. f \ U \ + \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + shows "learn_fin \ U s" + using assms learn_fin_def by auto + +lemma learn_finE: + assumes "learn_fin \ U s" + shows "environment \ U s" + and "\f. f \ U \ + \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + using assms learn_fin_def by auto + +lemma learn_fin_closed_subseteq: + assumes "learn_fin \ U s" and "V \ U" + shows "learn_fin \ V s" + using assms learn_fin_def by auto + +lemma learn_fin_wrt_goedel: + assumes "goedel_numbering \" and "learn_fin \ U s" + shows "\t. learn_fin \ U t" +proof - + have env: "environment \ U s" + and fin: "\f. f \ U \ + \i n\<^sub>0. \ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + using assms(2) learn_finE by auto + obtain c where c: "c \ \" "\i. \ i = \ (the (c i))" + using env goedel_numberingE[OF assms(1), of \] by auto + define t where "t \ + \x. if s x \ then None + else if s x = Some 0 then Some 0 + else Some (Suc (the (c (the (s x) - 1))))" + have "t \ \

" + proof - + from c obtain rc where rc: + "recfn 1 rc" + "total rc" + "\x. c x = eval rc [x]" + by auto + from env obtain rs where rs: "recfn 1 rs" "\x. s x = eval rs [x]" + by auto + then have "eval rs [f \ n] \" if "f \ U" for f n + using env that by simp + define rt where "rt = Cn 1 r_ifz [rs, Z, Cn 1 S [Cn 1 rc [Cn 1 r_dec [rs]]]]" + then have "recfn 1 rt" + using rc(1) rs(1) by simp + have "eval rt [x] \" if "eval rs [x] \" for x + using rc(1) rs(1) rt_def that by auto + moreover have "eval rt [x] \= 0" if "eval rs [x] \= 0" for x + using rt_def that rc(1,2) rs(1) by simp + moreover have "eval rt [x] \= Suc (the (c (the (s x) - 1)))" if "eval rs [x] \\ 0" for x + using rt_def that rc rs by auto + ultimately have "eval rt [x] = t x" for x + by (simp add: rs(2) t_def) + with `recfn 1 rt` show ?thesis by auto + qed + have t: "t (f \ n) \= + (if s (f \ n) = Some 0 then 0 else Suc (the (c (the (s (f \ n)) - 1))))" + if "f \ U" for f n + using that env by (simp add: t_def) + have "learn_fin \ U t" + proof (rule learn_finI) + show "environment \ U t" + using t by (simp add: \t \ \

\ env goedel_numbering_P2[OF assms(1)]) + show "\i n\<^sub>0. \ i = f \ (\n0. t (f \ n) \= 0) \ (\n\n\<^sub>0. t (f \ n) \= Suc i)" + if "f \ U" for f + proof - + from fin obtain i n\<^sub>0 where + i: "\ i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + using \f \ U\ by blast + let ?j = "the (c i)" + have "\ ?j = f" + using c(2) i by simp + moreover have "\n0. t (f \ n) \= 0" + using t[OF that] i by simp + moreover have "t (f \ n) \= Suc ?j" if "n \ n\<^sub>0" for n + using that i t[OF `f \ U`] by simp + ultimately show ?thesis by auto + qed + qed + then show ?thesis by auto +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/LIM_BC.thy b/thys/Inductive_Inference/LIM_BC.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/LIM_BC.thy @@ -0,0 +1,1329 @@ +section \LIM is a proper subset of BC\label{s:lim_bc}\ + +theory LIM_BC + imports Lemma_R +begin + +text \The proper inclusion of LIM in BC has been proved by +Barzdin~\cite{b-ttlsf-74} (see also Case and Smith~\cite{cs-cicmii-83}). The +proof constructs a class $V \in \mathrm{BC} - \mathrm{LIM}$ by +diagonalization against all LIM strategies. Exploiting Lemma~R for LIM, we +can assume that all such strategies are total functions. From the effective +version of this lemma we derive a numbering @{term "\ \ +\\<^sup>2"} such that for all $U \in \mathrm{LIM}$ there is an $i$ with +$U\in \mathrm{LIM}_\varphi(\sigma_i)$. The idea behind $V$ +is for every $i$ to construct a class $V_i$ of cardinality one or two such +that $V_i \notin \mathrm{LIM}_\varphi(\sigma_i)$. It then follows that the +union $V := \bigcup_i V_i$ cannot be learned by any $\sigma_i$ and thus $V +\notin \mathrm{LIM}$. At the same time, the construction ensures that the +functions in $V$ are ``predictable enough'' to be learnable in the BC sense. + +At the core is a process that maintains a state $(b, k)$ of a list $b$ of +numbers and an index $k < |b|$ into this list. We imagine $b$ to be the +prefix of the function being constructed, except for position $k$ where +we imagine $b$ to have a ``gap''; that is, $b_k$ is not defined yet. +Technically, we will always have $b_k = 0$, so $b$ also represents the prefix +after the ``gap is filled'' with 0, whereas $b_{k:=1}$ represents the prefix +where the gap is filled with 1. For every $i \in \mathbb{N}$, the process +starts in state $(i0, 1)$ and computes the next state from a given state +$(b,k)$ as follows: +\begin{enumerate} +\item if $ \sigma_i(b_{ + + +subsection \Enumerating enough total strategies\ + +text \For the construction of $\sigma$ we need the function @{term +r_limr} from the effective version of Lemma~R for LIM.\ + +definition "r_sigma \ Cn 2 r_phi [Cn 2 r_limr [Id 2 0], Id 2 1]" + +lemma r_sigma_recfn: "recfn 2 r_sigma" + unfolding r_sigma_def using r_limr_recfn by simp + +lemma r_sigma: "eval r_sigma [i, x] = \ (the (eval r_limr [i])) x" + unfolding r_sigma_def phi_def using r_sigma_recfn r_limr_total r_limr_recfn + by simp + +lemma r_sigma_total: "total r_sigma" + using r_sigma r_limr r_sigma_recfn totalI2[of r_sigma] by simp + +abbreviation sigma :: partial2 ("\") where + "\ i x \ eval r_sigma [i, x]" + +lemma sigma: "\ i = \ (the (eval r_limr [i]))" + using r_sigma by simp + +text \The numbering @{term \} does indeed enumerate enough total +strategies for every LIM learning problem.\ + +lemma learn_lim_sigma: + assumes "learn_lim \ U (\ i)" + shows "learn_lim \ U (\ i)" + using assms sigma r_limr by simp + + +subsection \The diagonalization process\ + +text \The following function represents the process described above. It +computes the next state from a given state $(b, k)$.\ + +definition "r_next \ + Cn 1 r_ifeq + [Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], r_pdec1], + Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_take [r_pdec2, r_pdec1]], + Cn 1 r_ifeq + [Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_update [r_pdec1, r_pdec2, r_const 1]], + Cn 1 r_sigma [Cn 1 r_hd [r_pdec1], Cn 1 r_take [r_pdec2, r_pdec1]], + Cn 1 r_prod_encode [Cn 1 r_snoc [r_pdec1, Z], r_pdec2], + Cn 1 r_prod_encode + [Cn 1 r_snoc + [Cn 1 r_update [r_pdec1, r_pdec2, r_const 1], Z], Cn 1 r_length [r_pdec1]]], + Cn 1 r_prod_encode [Cn 1 r_snoc [r_pdec1, Z], Cn 1 r_length [r_pdec1]]]" + +lemma r_next_recfn: "recfn 1 r_next" + unfolding r_next_def using r_sigma_recfn by simp + +text \The three conditions distinguished in @{term r_next} correspond +to Steps 1, 2, and 3 of the process: hypothesis change when the gap is +filled with 0; hypothesis change when the gap is filled with 1; or +no hypothesis change either way.\ + +abbreviation "change_on_0 b k \ \ (e_hd b) b \ \ (e_hd b) (e_take k b)" + +abbreviation "change_on_1 b k \ + \ (e_hd b) b = \ (e_hd b) (e_take k b) \ + \ (e_hd b) (e_update b k 1) \ \ (e_hd b) (e_take k b)" + +abbreviation "change_on_neither b k \ + \ (e_hd b) b = \ (e_hd b) (e_take k b) \ + \ (e_hd b) (e_update b k 1) = \ (e_hd b) (e_take k b)" + +lemma change_conditions: + obtains + (on_0) "change_on_0 b k" + | (on_1) "change_on_1 b k" + | (neither) "change_on_neither b k" + by auto + +lemma r_next: + assumes "arg = prod_encode (b, k)" + shows "change_on_0 b k \ eval r_next [arg] \= prod_encode (e_snoc b 0, e_length b)" + and "change_on_1 b k \ + eval r_next [arg] \= prod_encode (e_snoc (e_update b k 1) 0, e_length b)" + and "change_on_neither b k \ eval r_next [arg] \= prod_encode (e_snoc b 0, k)" +proof - + let ?bhd = "Cn 1 r_hd [r_pdec1]" + let ?bup = "Cn 1 r_update [r_pdec1, r_pdec2, r_const 1]" + let ?bk = "Cn 1 r_take [r_pdec2, r_pdec1]" + let ?bap = "Cn 1 r_snoc [r_pdec1, Z]" + let ?len = "Cn 1 r_length [r_pdec1]" + let ?thenthen = "Cn 1 r_prod_encode [?bap, r_pdec2]" + let ?thenelse = "Cn 1 r_prod_encode [Cn 1 r_snoc [?bup, Z], ?len]" + let ?else = "Cn 1 r_prod_encode [?bap, ?len]" + have bhd: "eval ?bhd [arg] \= e_hd b" + using assms by simp + have bup: "eval ?bup [arg] \= e_update b k 1" + using assms by simp + have bk: "eval ?bk [arg] \= e_take k b" + using assms by simp + have bap: "eval ?bap [arg] \= e_snoc b 0" + using assms by simp + have len: "eval ?len [arg] \= e_length b" + using assms by simp + have else_: "eval ?else [arg] \= prod_encode (e_snoc b 0, e_length b)" + using bap len by simp + have thenthen: "eval ?thenthen [arg] \= prod_encode (e_snoc b 0, k)" + using bap assms by simp + have thenelse: "eval ?thenelse [arg] \= prod_encode (e_snoc (e_update b k 1) 0, e_length b)" + using bup len by simp + have then_: + "eval + (Cn 1 r_ifeq [Cn 1 r_sigma [?bhd, ?bup], Cn 1 r_sigma [?bhd, ?bk], ?thenthen, ?thenelse]) + [arg] \= + (if the (\ (e_hd b) (e_update b k 1)) = the (\ (e_hd b) (e_take k b)) + then prod_encode (e_snoc b 0, k) + else prod_encode (e_snoc (e_update b k 1) 0, e_length b))" + (is "eval ?then [arg] \= ?then_eval") + using bhd bup bk thenthen thenelse r_sigma r_sigma_recfn r_limr R1_imp_total1 by simp + have *: "eval r_next [arg] \= + (if the (\ (e_hd b) b) = the (\ (e_hd b) (e_take k b)) + then ?then_eval + else prod_encode (e_snoc b 0, e_length b))" + unfolding r_next_def + using bhd bk then_ else_ r_sigma r_sigma_recfn r_limr R1_imp_total1 assms + by simp + have r_sigma_neq: "eval r_sigma [x\<^sub>1, y\<^sub>1] \ eval r_sigma [x\<^sub>2, y\<^sub>2] \ + the (eval r_sigma [x\<^sub>1, y\<^sub>1]) \ the (eval r_sigma [x\<^sub>2, y\<^sub>2])" + for x\<^sub>1 y\<^sub>1 x\<^sub>2 y\<^sub>2 + using r_sigma r_limr totalE[OF r_sigma_total r_sigma_recfn] r_sigma_recfn r_sigma_total + by (metis One_nat_def Suc_1 length_Cons list.size(3) option.expand) + { + assume "change_on_0 b k" + then show "eval r_next [arg] \= prod_encode (e_snoc b 0, e_length b)" + using * r_sigma_neq by simp + next + assume "change_on_1 b k" + then show "eval r_next [arg] \= prod_encode (e_snoc (e_update b k 1) 0, e_length b)" + using * r_sigma_neq by simp + next + assume "change_on_neither b k" + then show "eval r_next [arg] \= prod_encode (e_snoc b 0, k)" + using * r_sigma_neq by simp + } +qed + +lemma r_next_total: "total r_next" +proof (rule totalI1) + show "recfn 1 r_next" + using r_next_recfn by simp + show "eval r_next [x] \" for x + proof - + obtain b k where "x = prod_encode (b, k)" + using prod_encode_pdec'[of x] by metis + then show ?thesis using r_next by fast + qed +qed + +text \The next function computes the state of the process after +any number of iterations.\ + +definition "r_state \ + Pr 1 + (Cn 1 r_prod_encode [Cn 1 r_snoc [Cn 1 r_singleton_encode [Id 1 0], Z], r_const 1]) + (Cn 3 r_next [Id 3 1])" + +lemma r_state_recfn: "recfn 2 r_state" + unfolding r_state_def using r_next_recfn by simp + +lemma r_state_at_0: "eval r_state [0, i] \= prod_encode (list_encode [i, 0], 1)" +proof - + let ?f = "Cn 1 r_prod_encode [Cn 1 r_snoc [Cn 1 r_singleton_encode [Id 1 0], Z], r_const 1]" + have "eval r_state [0, i] = eval ?f [i]" + unfolding r_state_def using r_next_recfn by simp + also have "... \= prod_encode (list_encode [i, 0], 1)" + by (simp add: list_decode_singleton) + finally show ?thesis . +qed + +lemma r_state_total: "total r_state" + unfolding r_state_def + using r_next_recfn totalE[OF r_next_total r_next_recfn] totalI3[of "Cn 3 r_next [Id 3 1]"] + by (intro Pr_total) auto + +text \We call the components of a state $(b, k)$ the \emph{block} $b$ +and the \emph{gap} $k$.\ + +definition block :: "nat \ nat \ nat" where + "block i t \ pdec1 (the (eval r_state [t, i]))" + +definition gap :: "nat \ nat \ nat" where + "gap i t \ pdec2 (the (eval r_state [t, i]))" + +lemma state_at_0: + "block i 0 = list_encode [i, 0]" + "gap i 0 = 1" + unfolding block_def gap_def r_state_at_0 by simp_all + +text \Some lemmas describing the behavior of blocks and gaps in +one iteration of the process:\ + +lemma state_Suc: + assumes "b = block i t" and "k = gap i t" + shows "block i (Suc t) = pdec1 (the (eval r_next [prod_encode (b, k)]))" + and "gap i (Suc t) = pdec2 (the (eval r_next [prod_encode (b, k)]))" +proof - + have "eval r_state [Suc t, i] = + eval (Cn 3 r_next [Id 3 1]) [t, the (eval r_state [t, i]), i]" + using r_state_recfn r_next_recfn totalE[OF r_state_total r_state_recfn, of "[t, i]"] + by (simp add: r_state_def) + also have "... = eval r_next [the (eval r_state [t, i])]" + using r_next_recfn by simp + also have "... = eval r_next [prod_encode (b, k)]" + using assms block_def gap_def by simp + finally have "eval r_state [Suc t, i] = eval r_next [prod_encode (b, k)]" . + then show + "block i (Suc t) = pdec1 (the (eval r_next [prod_encode (b, k)]))" + "gap i (Suc t) = pdec2 (the (eval r_next [prod_encode (b, k)]))" + by (simp add: block_def, simp add: gap_def) +qed + +lemma gap_Suc: + assumes "b = block i t" and "k = gap i t" + shows "change_on_0 b k \ gap i (Suc t) = e_length b" + and "change_on_1 b k \ gap i (Suc t) = e_length b" + and "change_on_neither b k\ gap i (Suc t) = k" + using assms r_next state_Suc by simp_all + +lemma block_Suc: + assumes "b = block i t" and "k = gap i t" + shows "change_on_0 b k \ block i (Suc t) = e_snoc b 0" + and "change_on_1 b k \ block i (Suc t) = e_snoc (e_update b k 1) 0" + and "change_on_neither b k\ block i (Suc t) = e_snoc b 0" + using assms r_next state_Suc by simp_all + +text \Non-gap positions in the block remain unchanged after an +iteration.\ + +lemma block_stable: + assumes "j < e_length (block i t)" and "j \ gap i t" + shows "e_nth (block i t) j = e_nth (block i (Suc t)) j" +proof - + from change_conditions[of "block i t" "gap i t"] show ?thesis + using assms block_Suc gap_Suc + by (cases, (simp_all add: nth_append)) +qed + +text \Next are some properties of @{term block} and @{term gap}.\ + +lemma gap_in_block: "gap i t < e_length (block i t)" +proof (induction t) + case 0 + then show ?case by (simp add: state_at_0) +next + case (Suc t) + with change_conditions[of "block i t" "gap i t"] show ?case + proof (cases) + case on_0 + then show ?thesis by (simp add: block_Suc(1) gap_Suc(1)) + next + case on_1 + then show ?thesis by (simp add: block_Suc(2) gap_Suc(2)) + next + case neither + then show ?thesis using Suc.IH block_Suc(3) gap_Suc(3) by force + qed +qed + +lemma length_block: "e_length (block i t) = Suc (Suc t)" +proof (induction t) + case 0 + then show ?case by (simp add: state_at_0) +next + case (Suc t) + with change_conditions[of "block i t" "gap i t"] show ?case + by (cases, simp_all add: block_Suc gap_Suc) +qed + +lemma gap_gr0: "gap i t > 0" +proof (induction t) + case 0 + then show ?case by (simp add: state_at_0) +next + case (Suc t) + with change_conditions[of "block i t" "gap i t"] show ?case + using length_block by (cases, simp_all add: block_Suc gap_Suc) +qed + +lemma hd_block: "e_hd (block i t) = i" +proof (induction t) + case 0 + then show ?case by (simp add: state_at_0) +next + case (Suc t) + from change_conditions[of "block i t" "gap i t"] show ?case + proof (cases) + case on_0 + then show ?thesis + using Suc block_Suc(1) length_block by (metis e_hd_snoc gap_Suc(1) gap_gr0) + next + case on_1 + let ?b = "block i t" and ?k = "gap i t" + have "?k > 0" + using gap_gr0 Suc by simp + then have "e_nth (e_update ?b ?k 1) 0 = e_nth ?b 0" + by simp + then have *: "e_hd (e_update ?b ?k 1) = e_hd ?b" + using e_hd_nth0 gap_Suc(2)[of _ i t] gap_gr0 on_1 by (metis e_length_update) + from on_1 have "block i (Suc t) = e_snoc (e_update ?b ?k 1) 0" + by (simp add: block_Suc(2)) + then show ?thesis + using e_hd_0 e_hd_snoc Suc length_block `?k > 0` * + by (metis e_length_update gap_Suc(2) gap_gr0 on_1) + next + case neither + then show ?thesis using Suc block_Suc(3) length_block by simp + qed +qed + +text \Formally, a block always ends in zero, even if it ends in a gap.\ + +lemma last_block: "e_nth (block i t) (gap i t) = 0" +proof (induction t) + case 0 + then show ?case by (simp add: state_at_0) +next + case (Suc t) + from change_conditions[of "block i t" "gap i t"] show ?case + proof cases + case on_0 + then show ?thesis using Suc by (simp add: block_Suc(1) gap_Suc(1)) + next + case on_1 + then show ?thesis using Suc by (simp add: block_Suc(2) gap_Suc(2) nth_append) + next + case neither + then have + "block i (Suc t) = e_snoc (block i t) 0" + "gap i (Suc t) = gap i t" + by (simp_all add: gap_Suc(3) block_Suc(3)) + then show ?thesis + using Suc gap_in_block by (simp add: nth_append) + qed +qed + +lemma gap_le_Suc: "gap i t \ gap i (Suc t)" + using change_conditions[of "block i t" "gap i t"] + gap_Suc gap_in_block less_imp_le[of "gap i t" "e_length (block i t)"] + by (cases) simp_all + +lemma gap_monotone: + assumes "t\<^sub>1 \ t\<^sub>2" + shows "gap i t\<^sub>1 \ gap i t\<^sub>2" +proof - + have "gap i t\<^sub>1 \ gap i (t\<^sub>1 + j)" for j + proof (induction j) + case 0 + then show ?case by simp + next + case (Suc j) + then show ?case using gap_le_Suc dual_order.trans by fastforce + qed + then show ?thesis using assms le_Suc_ex by blast +qed + +text \We need some lemmas relating the shape of the next state +to the hypothesis change conditions in Steps 1, 2, and 3.\ + +lemma state_change_on_neither: + assumes "gap i (Suc t) = gap i t" + shows "change_on_neither (block i t) (gap i t)" + and "block i (Suc t) = e_snoc (block i t) 0" +proof - + let ?b = "block i t" and ?k = "gap i t" + have "?k < e_length ?b" + using gap_in_block by simp + from change_conditions[of ?b ?k] show "change_on_neither (block i t) (gap i t)" + proof (cases) + case on_0 + then show ?thesis + using \?k < e_length ?b\ assms gap_Suc(1) by auto + next + case on_1 + then show ?thesis using assms gap_Suc(2) by auto + next + case neither + then show ?thesis by simp + qed + then show "block i (Suc t) = e_snoc (block i t) 0" + using block_Suc(3) by simp +qed + +lemma state_change_on_either: + assumes "gap i (Suc t) \ gap i t" + shows "\ change_on_neither (block i t) (gap i t)" + and "gap i (Suc t) = e_length (block i t)" +proof - + let ?b = "block i t" and ?k = "gap i t" + show "\ change_on_neither (block i t) (gap i t)" + proof + assume "change_on_neither (block i t) (gap i t)" + then have "gap i (Suc t) = ?k" + by (simp add: gap_Suc(3)) + with assms show False by simp + qed + then show "gap i (Suc t) = e_length (block i t)" + using gap_Suc(1) gap_Suc(2) by blast +qed + +text \Next up is the definition of $\tau$. In every iteration the +process determines $\tau_i(x)$ for some $x$ either by appending 0 to the +current block $b$, or by filling the current gap $k$. In the former case, +the value is determined for $x = |b|$, in the latter for $x = k$.\ + +text \For $i$ and $x$ the function @{term r_dettime} computes in which +iteration the process for $i$ determines the value $\tau_i(x)$. This is the +first iteration in which the block is long enough to contain position $x$ and +in which $x$ is not the gap. If $\tau_i(x)$ is never determined, because Case~2 is +reached with $k = x$, then @{term r_dettime} diverges.\ + +abbreviation determined :: "nat \ nat \ bool" where + "determined i x \ \t. x < e_length (block i t) \ x \ gap i t" + +lemma determined_0: "determined i 0" + using gap_gr0[of i 0] gap_in_block[of i 0] by force + +definition "r_dettime \ + Mn 2 + (Cn 3 r_and + [Cn 3 r_less + [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]], + Cn 3 r_neq + [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]]])" + +lemma r_dettime_recfn: "recfn 2 r_dettime" + unfolding r_dettime_def using r_state_recfn by simp + +abbreviation dettime :: partial2 where + "dettime i x \ eval r_dettime [i, x]" + +lemma r_dettime: + shows "determined i x \ dettime i x \= (LEAST t. x < e_length (block i t) \ x \ gap i t)" + and "\ determined i x \ dettime i x \" +proof - + define f where "f = + (Cn 3 r_and + [Cn 3 r_less + [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]], + Cn 3 r_neq + [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]]])" + then have "r_dettime = Mn 2 f" + unfolding f_def r_dettime_def by simp + have "recfn 3 f" + unfolding f_def using r_state_recfn by simp + then have "total f" + unfolding f_def using Cn_total r_state_total Mn_free_imp_total by simp + have f: "eval f [t, i, x] \= (if x < e_length (block i t) \ x \ gap i t then 0 else 1)" for t + proof - + let ?b = "Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]" + let ?k = "Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]" + have "eval ?b [t, i, x] \= pdec1 (the (eval r_state [t, i]))" + using r_state_recfn r_state_total by simp + then have b: "eval ?b [t, i, x] \= block i t" + using block_def by simp + have "eval ?k [t, i, x] \= pdec2 (the (eval r_state [t, i]))" + using r_state_recfn r_state_total by simp + then have k: "eval ?k [t, i, x] \= gap i t" + using gap_def by simp + have "eval + (Cn 3 r_neq [Id 3 2, Cn 3 r_pdec2 [Cn 3 r_state [Id 3 0, Id 3 1]]]) + [t, i, x] \= + (if x \ gap i t then 0 else 1)" + using b k r_state_recfn r_state_total by simp + moreover have "eval + (Cn 3 r_less + [Id 3 2, Cn 3 r_length [Cn 3 r_pdec1 [Cn 3 r_state [Id 3 0, Id 3 1]]]]) + [t, i, x] \= + (if x < e_length (block i t) then 0 else 1)" + using b k r_state_recfn r_state_total by simp + ultimately show ?thesis + unfolding f_def using b k r_state_recfn r_state_total by simp + qed + { + assume "determined i x" + with f have "\t. eval f [t, i, x] \= 0" by simp + then have "dettime i x \= (LEAST t. eval f [t, i, x] \= 0)" + using `total f` `r_dettime = Mn 2 f` r_dettime_recfn `recfn 3 f` + eval_Mn_total[of 2 f "[i, x]"] + by simp + then show "dettime i x \= (LEAST t. x < e_length (block i t) \ x \ gap i t)" + using f by simp + next + assume "\ determined i x" + with f have "\ (\t. eval f [t, i, x] \= 0)" by simp + then have "dettime i x \" + using `total f` `r_dettime = Mn 2 f` r_dettime_recfn `recfn 3 f` + eval_Mn_total[of 2 f "[i, x]"] + by simp + with f show "dettime i x \" by simp + } +qed + +lemma r_dettimeI: + assumes "x < e_length (block i t) \ x \ gap i t" + and "\T. x < e_length (block i T) \ x \ gap i T \ t \ T" + shows "dettime i x \= t" +proof - + let ?P = "\T. x < e_length (block i T) \ x \ gap i T" + have "determined i x" + using assms(1) by auto + moreover have "Least ?P = t" + using assms Least_equality[of ?P t] by simp + ultimately show ?thesis using r_dettime by simp +qed + +lemma r_dettime_0: "dettime i 0 \= 0" + using r_dettimeI[of _ i 0] determined_0 gap_gr0[of i 0] gap_in_block[of i 0] + by fastforce + +text \Computing the value of $\tau_i(x)$ works by running the process +@{term r_state} for @{term "dettime i x"} iterations and taking the value at +index $x$ of the resulting block.\ + +definition "r_tau \ Cn 2 r_nth [Cn 2 r_pdec1 [Cn 2 r_state [r_dettime, Id 2 0]], Id 2 1]" + +lemma r_tau_recfn: "recfn 2 r_tau" + unfolding r_tau_def using r_dettime_recfn r_state_recfn by simp + +abbreviation tau :: partial2 ("\") where + "\ i x \ eval r_tau [i, x]" + +lemma tau_in_P2: "\ \ \

\<^sup>2" + using r_tau_recfn by auto + +lemma tau_diverg: + assumes "\ determined i x" + shows "\ i x \" + unfolding r_tau_def using assms r_dettime r_dettime_recfn r_state_recfn by simp + +lemma tau_converg: + assumes "determined i x" + shows "\ i x \= e_nth (block i (the (dettime i x))) x" +proof - + from assms obtain t where t: "dettime i x \= t" + using r_dettime(1) by blast + then have "eval (Cn 2 r_state [r_dettime, Id 2 0]) [i, x] = eval r_state [t, i]" + using r_state_recfn r_dettime_recfn by simp + moreover have "eval r_state [t, i] \" + using r_state_total r_state_recfn by simp + ultimately have "eval (Cn 2 r_pdec1 [Cn 2 r_state [r_dettime, Id 2 0]]) [i, x] = + eval r_pdec1 [the (eval r_state [t, i])]" + using r_state_recfn r_dettime_recfn by simp + then show ?thesis + unfolding r_tau_def using r_state_recfn r_dettime_recfn t block_def by simp +qed + +lemma tau_converg': + assumes "dettime i x \= t" + shows "\ i x \= e_nth (block i t) x" + using assms tau_converg[of x i] r_dettime(2)[of x i] by fastforce + +lemma tau_at_0: "\ i 0 \= i" +proof - + have "\ i 0 \= e_nth (block i 0) 0" + using tau_converg'[OF r_dettime_0] by simp + then show ?thesis using block_def by (simp add: r_state_at_0) +qed + +lemma state_unchanged: + assumes "gap i t - 1 \ y" and "y \ t" + shows "gap i t = gap i y" +proof - + have "gap i t = gap i (gap i t - 1)" + proof (induction t) + case 0 + then show ?case by (simp add: gap_def r_state_at_0) + next + case (Suc t) + show ?case + proof (cases "gap i (Suc t) = t + 2") + case True + then show ?thesis by simp + next + case False + then show ?thesis + using Suc state_change_on_either(2) length_block by force + qed + qed + moreover have "gap i (gap i t - 1) \ gap i y" + using assms(1) gap_monotone by simp + moreover have "gap i y \ gap i t" + using assms(2) gap_monotone by simp + ultimately show ?thesis by simp +qed + +text \The values of the non-gap indices $x$ of every block created in +the diagonalization process equal $\tau_i(x)$.\ + +lemma tau_eq_state: + assumes "j < e_length (block i t)" and "j \ gap i t" + shows "\ i j \= e_nth (block i t) j" + using assms +proof (induction t) + case 0 + then have "j = 0" + using gap_gr0[of i 0] gap_in_block[of i 0] length_block[of i 0] by simp + then have "\ (e_hd (block i t)) j \= e_nth (block i (the (dettime i 0))) 0" + using determined_0 tau_converg hd_block by simp + then have "\ (e_hd (block i t)) j \= e_nth (block i 0) 0" + using r_dettime_0 by simp + then show ?case using \j = 0\ r_dettime_0 tau_converg' by simp +next + case (Suc t) + let ?b = "block i t" + let ?bb = "block i (Suc t)" + let ?k = "gap i t" + let ?kk = "gap i (Suc t)" + show ?case + proof (cases "?kk = ?k") + case kk_eq_k: True + then have bb_b0: "?bb = e_snoc ?b 0" + using state_change_on_neither by simp + show "\ i j \= e_nth ?bb j" + proof (cases "j < e_length ?b") + case True + then have "e_nth ?bb j = e_nth ?b j" + using bb_b0 by (simp add: nth_append) + moreover have "j \ ?k" + using Suc kk_eq_k by simp + ultimately show ?thesis using Suc True by simp + next + case False + then have j: "j = e_length ?b" + using Suc.prems(1) length_block by auto + then have "e_nth ?bb j = 0" + using bb_b0 by simp + have "dettime i j \= Suc t" + proof (rule r_dettimeI) + show "j < e_length ?bb \ j \ ?kk" + using Suc.prems(1,2) by linarith + show "\T. j < e_length (block i T) \ j \ gap i T \ Suc t \ T" + using length_block j by simp + qed + with tau_converg' show ?thesis by simp + qed + next + case False + then have kk_lenb: "?kk = e_length ?b" + using state_change_on_either by simp + then show ?thesis + proof (cases "j = ?k") + case j_eq_k: True + have "dettime i j \= Suc t" + proof (rule r_dettimeI) + show "j < e_length ?bb \ j \ ?kk" + using Suc.prems(1,2) by simp + show "Suc t \ T" if "j < e_length (block i T) \ j \ gap i T" for T + proof (rule ccontr) + assume "\ (Suc t \ T)" + then have "T < Suc t" by simp + then show False + proof (cases "T < ?k - 1") + case True + then have "e_length (block i T) = T + 2" + using length_block by simp + then have "e_length (block i T) < ?k + 1" + using True by simp + then have "e_length (block i T) \ ?k" by simp + then have "e_length (block i T) \ j" + using j_eq_k by simp + then show False + using that by simp + next + case False + then have "?k - 1 \ T" and "T \ t" + using `T < Suc t` by simp_all + with state_unchanged have "gap i t = gap i T" by blast + then show False + using j_eq_k that by simp + qed + qed + qed + then show ?thesis using tau_converg' by simp + next + case False + then have "j < e_length ?b" + using kk_lenb Suc.prems(1,2) length_block by auto + then show ?thesis using Suc False block_stable by fastforce + qed + qed +qed + +lemma tau_eq_state': + assumes "j < t + 2" and " j \ gap i t" + shows "\ i j \= e_nth (block i t) j" + using assms tau_eq_state length_block by simp + +text \We now consider the two cases described in the proof sketch. +In Case~2 there is a gap that never gets filled, or equivalently there is +a rightmost gap.\ + +abbreviation "case_two i \ (\t. \T. gap i T \ gap i t)" + +abbreviation "case_one i \ \ case_two i" + +text \Another characterization of Case~2 is that from some iteration on +only @{term change_on_neither} holds.\ + +lemma case_two_iff_forever_neither: + "case_two i \ (\t. \T\t. change_on_neither (block i T) (gap i T))" +proof + assume "\t. \T\t. change_on_neither (block i T) (gap i T)" + then obtain t where t: "\T\t. change_on_neither (block i T) (gap i T)" + by auto + have "(gap i T) \ (gap i t)" for T + proof (cases "T \ t") + case True + then show ?thesis using gap_monotone by simp + next + case False + then show ?thesis + proof (induction T) + case 0 + then show ?case by simp + next + case (Suc T) + with t have "change_on_neither ((block i T)) ((gap i T))" + by simp + then show ?case + using Suc.IH state_change_on_either(1)[of i T] gap_monotone[of T t i] + by metis + qed + qed + then show "\t. \T. gap i T \ gap i t" + by auto +next + assume "\t. \T. gap i T \ gap i t" + then obtain t where t: "\T. gap i T \ gap i t" + by auto + have "change_on_neither (block i T) (gap i T)" if "T\t" for T + proof - + have T: "(gap i T) \ (gap i t)" + using gap_monotone that by simp + show ?thesis + proof (rule ccontr) + assume "\ change_on_neither (block i T) (gap i T)" + then have "change_on_0 (block i T) (gap i T) \ change_on_1 (block i T) (gap i T)" + by simp + then have "gap i (Suc T) > gap i T" + using gap_le_Suc[of i] state_change_on_either(2)[of i] state_change_on_neither(1)[of i] + dual_order.strict_iff_order + by blast + with T have "gap i (Suc T) > gap i t" by simp + with t show False + using not_le by auto + qed + qed + then show "\t. \T\t. change_on_neither (block i T) (gap i T)" + by auto +qed + +text \In Case~1, $\tau_i$ is total.\ + +lemma case_one_tau_total: + assumes "case_one i" + shows "\ i x \" +proof (cases "x = gap i x") + case True + from assms have "\t. \T. gap i T > gap i t" + using le_less_linear gap_def[of i x] by blast + then obtain T where T: "gap i T > gap i x" + by auto + then have "T > x" + using gap_monotone leD le_less_linear by blast + then have "x < T + 2" by simp + moreover from T True have "x \ gap i T" by simp + ultimately show ?thesis using tau_eq_state' by simp +next + case False + moreover have "x < x + 2" by simp + ultimately show ?thesis using tau_eq_state' by blast +qed + +text \In Case~2, $\tau_i$ is undefined only at the gap that never gets filled.\ + +lemma case_two_tau_not_quite_total: + assumes "\T. gap i T \ gap i t" + shows "\ i (gap i t) \" + and "x \ gap i t \ \ i x \" +proof - + let ?k = "gap i t" + have "\ determined i ?k" + proof + assume "determined i ?k" + then obtain T where T: "?k < e_length (block i T) \ ?k \ gap i T" + by auto + with assms have snd_le: "gap i T < ?k" + by (simp add: dual_order.strict_iff_order) + then have "T < t" + using gap_monotone by (metis leD le_less_linear) + from T length_block have "?k < T + 2" by simp + moreover have "?k \ T + 1" + using T state_change_on_either(2) \T < t\ state_unchanged + by (metis Suc_eq_plus1 Suc_leI add_diff_cancel_right' le_add1 nat_neq_iff) + ultimately have "?k \ T" by simp + then have "gap i T = gap i ?k" + using state_unchanged[of i T "?k"] \?k < T + 2\ snd_le by simp + then show False + by (metis diff_le_self state_unchanged leD nat_le_linear gap_monotone snd_le) + qed + with tau_diverg show "\ i ?k \" by simp + + assume "x \ ?k" + show "\ i x \" + proof (cases "x < t + 2") + case True + with `x \ ?k` tau_eq_state' show ?thesis by simp + next + case False + then have "gap i x = ?k" + using assms by (simp add: dual_order.antisym gap_monotone) + with `x \ ?k` have "x \ gap i x" by simp + then show ?thesis using tau_eq_state'[of x x] by simp + qed +qed + +lemma case_two_tau_almost_total: + assumes "\t. \T. gap i T \ gap i t" (is "\t. ?P t") + shows "\ i (gap i (Least ?P)) \" + and "x \ gap i (Least ?P) \ \ i x \" +proof - + from assms have "?P (Least ?P)" + using LeastI_ex[of ?P] by simp + then show "\ i (gap i (Least ?P)) \" and "x \ gap i (Least ?P) \ \ i x \" + using case_two_tau_not_quite_total by simp_all +qed + +text \Some more properties of $\tau$.\ + +lemma init_tau_gap: "(\ i) \ (gap i t - 1) = e_take (gap i t) (block i t)" +proof (intro initI') + show 1: "e_length (e_take (gap i t) (block i t)) = Suc (gap i t - 1)" + proof - + have "gap i t > 0" + using gap_gr0 by simp + moreover have "gap i t < e_length (block i t)" + using gap_in_block by simp + ultimately have "e_length (e_take (gap i t) (block i t)) = gap i t" + by simp + then show ?thesis using gap_gr0 by simp + qed + show "\ i x \= e_nth (e_take (gap i t) (block i t)) x" if "x < Suc (gap i t - 1)" for x + proof - + have x_le: "x < gap i t" + using that gap_gr0 by simp + then have "x < e_length (block i t)" + using gap_in_block less_trans by blast + then have *: "\ i x \= e_nth (block i t) x" + using x_le tau_eq_state by auto + have "x < e_length (e_take (gap i t) (block i t))" + using x_le 1 by simp + then have "e_nth (block i t) x = e_nth (e_take (gap i t) (block i t)) x" + using x_le by simp + then show ?thesis using * by simp + qed +qed + +lemma change_on_0_init_tau: + assumes "change_on_0 (block i t) (gap i t)" + shows "(\ i) \ (t + 1) = block i t" +proof (intro initI') + let ?b = "block i t" and ?k = "gap i t" + show "e_length (block i t) = Suc (t + 1)" + using length_block by simp + show "(\ i) x \= e_nth (block i t) x" if "x < Suc (t + 1)" for x + proof (cases "x = ?k") + case True + have "gap i (Suc t) = e_length ?b" and b: "block i (Suc t) = e_snoc ?b 0" + using gap_Suc(1) block_Suc(1) assms by simp_all + then have "x < e_length (block i (Suc t))" "x \ gap i (Suc t)" + using that length_block by simp_all + then have "\ i x \= e_nth (block i (Suc t)) x" + using tau_eq_state by simp + then show ?thesis using that assms b by (simp add: nth_append) + next + case False + then show ?thesis using that assms tau_eq_state' by simp + qed +qed + +lemma change_on_0_hyp_change: + assumes "change_on_0 (block i t) (gap i t)" + shows "\ i ((\ i) \ (t + 1)) \ \ i ((\ i) \ (gap i t - 1))" + using assms hd_block init_tau_gap change_on_0_init_tau by simp + +lemma change_on_1_init_tau: + assumes "change_on_1 (block i t) (gap i t)" + shows "(\ i) \ (t + 1) = e_update (block i t) (gap i t) 1" +proof (intro initI') + let ?b = "block i t" and ?k = "gap i t" + show "e_length (e_update ?b ?k 1) = Suc (t + 1)" + using length_block by simp + show "(\ i) x \= e_nth (e_update ?b ?k 1) x" if "x < Suc (t + 1)" for x + proof (cases "x = ?k") + case True + have "gap i (Suc t) = e_length ?b" and b: "block i (Suc t) = e_snoc (e_update ?b ?k 1) 0" + using gap_Suc(2) block_Suc(2) assms by simp_all + then have "x < e_length (block i (Suc t))" "x \ gap i (Suc t)" + using that length_block by simp_all + then have "\ i x \= e_nth (block i (Suc t)) x" + using tau_eq_state by simp + then show ?thesis using that assms b nth_append by (simp add: nth_append) + next + case False + then show ?thesis using that assms tau_eq_state' by simp + qed +qed + +lemma change_on_1_hyp_change: + assumes "change_on_1 (block i t) (gap i t)" + shows "\ i ((\ i) \ (t + 1)) \ \ i ((\ i) \ (gap i t - 1))" + using assms hd_block init_tau_gap change_on_1_init_tau by simp + +lemma change_on_either_hyp_change: + assumes "\ change_on_neither (block i t) (gap i t)" + shows "\ i ((\ i) \ (t + 1)) \ \ i ((\ i) \ (gap i t - 1))" + using assms change_on_0_hyp_change change_on_1_hyp_change by auto + +lemma filled_gap_0_init_tau: + assumes "f\<^sub>0 = (\ i)((gap i t):=Some 0)" + shows "f\<^sub>0 \ (t + 1) = block i t" +proof (intro initI') + show len: "e_length (block i t) = Suc (t + 1)" + using assms length_block by auto + show "f\<^sub>0 x \= e_nth (block i t) x" if "x < Suc (t + 1)" for x + proof (cases "x = gap i t") + case True + then show ?thesis using assms last_block by auto + next + case False + then show ?thesis using assms len tau_eq_state that by auto + qed +qed + +lemma filled_gap_1_init_tau: + assumes "f\<^sub>1 = (\ i)((gap i t):=Some 1)" + shows "f\<^sub>1 \ (t + 1) = e_update (block i t) (gap i t) 1" +proof (intro initI') + show len: "e_length (e_update (block i t) (gap i t) 1) = Suc (t + 1)" + using e_length_update length_block by simp + show "f\<^sub>1 x \= e_nth (e_update (block i t) (gap i t) 1) x" if "x < Suc (t + 1)" for x + proof (cases "x = gap i t") + case True + moreover have "gap i t < e_length (block i t)" + using gap_in_block by simp + ultimately show ?thesis using assms by simp + next + case False + then show ?thesis using assms len tau_eq_state that by auto + qed +qed + + +subsection \The separating class\ + +text \Next we define the sets $V_i$ from the introductory proof sketch +(page~\pageref{s:lim_bc}).\ + +definition V_bclim :: "nat \ partial1 set" where + "V_bclim i \ + if case_two i + then let k = gap i (LEAST t. \T. gap i T \ gap i t) + in {(\ i)(k:=Some 0), (\ i)(k:=Some 1)} + else {\ i}" + +lemma V_subseteq_R1: "V_bclim i \ \" +proof (cases "case_two i") + case True + define k where "k = gap i (LEAST t. \T. gap i T \ gap i t)" + have "\ i \ \

" + using tau_in_P2 P2_proj_P1 by auto + then have "(\ i)(k:=Some 0) \ \

" and "(\ i)(k:=Some 1) \ \

" + using P1_update_P1 by simp_all + moreover have "total1 ((\ i)(k:=Some v))" for v + using case_two_tau_almost_total(2)[OF True] k_def total1_def by simp + ultimately have "(\ i)(k:=Some 0) \ \" and "(\ i)(k:=Some 1) \ \" + using P1_total_imp_R1 by simp_all + moreover have "V_bclim i = {(\ i)(k:=Some 0), (\ i)(k:=Some 1)}" + using True V_bclim_def k_def by (simp add: Let_def) + ultimately show ?thesis by simp +next + case False + have "V_bclim i = {\ i}" + unfolding V_bclim_def by (simp add: False) + moreover have "\ i \ \" + using total1I case_one_tau_total[OF False] tau_in_P2 P2_proj_P1[of \] P1_total_imp_R1 + by simp + ultimately show ?thesis by simp +qed + +lemma case_one_imp_gap_unbounded: + assumes "case_one i" + shows "\t. gap i t - 1 > n" +proof (induction n) + case 0 + then show ?case + using assms gap_gr0[of i] state_at_0(2)[of i] by (metis diff_is_0_eq gr_zeroI) +next + case (Suc n) + then obtain t where t: "gap i t - 1 > n" + by auto + moreover from assms have "\t. \T. gap i T > gap i t" + using leI by blast + ultimately obtain T where "gap i T > gap i t" + by auto + then have "gap i T - 1 > gap i t - 1" + using gap_gr0[of i] by (simp add: Suc_le_eq diff_less_mono) + with t have "gap i T - 1 > Suc n" by simp + then show ?case by auto +qed + +lemma case_one_imp_not_learn_lim_V: + assumes "case_one i" + shows "\ learn_lim \ (V_bclim i) (\ i)" +proof - + have V_bclim: "V_bclim i = {\ i}" + using assms V_bclim_def by (auto simp add: Let_def) + have "\m\<^sub>1>n. \m\<^sub>2>n. (\ i) ((\ i) \ m\<^sub>1) \ (\ i) ((\ i) \ m\<^sub>2)" for n + proof - + obtain t where t: "gap i t - 1 > n" + using case_one_imp_gap_unbounded[OF assms] by auto + moreover have "\t. \T\t. \ change_on_neither (block i T) (gap i T)" + using assms case_two_iff_forever_neither by blast + ultimately obtain T where T: "T \ t" "\ change_on_neither (block i T) (gap i T)" + by auto + then have "(\ i) ((\ i) \ (T + 1)) \ (\ i) ((\ i) \ (gap i T - 1))" + using change_on_either_hyp_change by simp + moreover have "gap i T - 1 > n" + using t T(1) gap_monotone by (simp add: diff_le_mono less_le_trans) + moreover have "T + 1 > n" + proof - + have "gap i T - 1 \ T" + using gap_in_block length_block by (simp add: le_diff_conv less_Suc_eq_le) + then show ?thesis using `gap i T - 1 > n` by simp + qed + ultimately show ?thesis by auto + qed + with infinite_hyp_changes_not_Lim V_bclim show ?thesis by simp +qed + +lemma case_two_imp_not_learn_lim_V: + assumes "case_two i" + shows "\ learn_lim \ (V_bclim i) (\ i)" +proof - + let ?P = "\t. \T. (gap i T) \ (gap i t)" + let ?t = "LEAST t. ?P t" + let ?k = "gap i ?t" + let ?b = "e_take ?k (block i ?t)" + have t: "\T. gap i T \ gap i ?t" + using assms LeastI_ex[of ?P] by simp + then have neither: "\T\?t. change_on_neither (block i T) (gap i T)" + using gap_le_Suc gap_monotone state_change_on_neither(1) + by (metis (no_types, lifting) antisym) + have gap_T: "\T\?t. gap i T = ?k" + using t gap_monotone antisym_conv by blast + define f\<^sub>0 where "f\<^sub>0 = (\ i)(?k:=Some 0)" + define f\<^sub>1 where "f\<^sub>1 = (\ i)(?k:=Some 1)" + show ?thesis + proof (rule same_hyp_for_two_not_Lim) + show "f\<^sub>0 \ V_bclim i" and "f\<^sub>1 \ V_bclim i" + using assms V_bclim_def f\<^sub>0_def f\<^sub>1_def by (simp_all add: Let_def) + show "f\<^sub>0 \ f\<^sub>1" using f\<^sub>0_def f\<^sub>1_def by (meson map_upd_eqD1 zero_neq_one) + show "\n\Suc ?t. \ i (f\<^sub>0 \ n) = \ i ?b" + proof - + have "\ i (block i T) = \ i (e_take ?k (block i T))" if "T \ ?t" for T + using that gap_T neither hd_block by metis + then have "\ i (block i T) = \ i ?b" if "T \ ?t" for T + by (metis (no_types, lifting) init_tau_gap gap_T that) + then have "\ i (f\<^sub>0 \ (T + 1)) = \ i ?b" if "T \ ?t" for T + using filled_gap_0_init_tau[of f\<^sub>0 i T] f\<^sub>0_def gap_T that + by (metis (no_types, lifting)) + then have "\ i (f\<^sub>0 \ T) = \ i ?b" if "T \ Suc ?t" for T + using that by (metis (no_types, lifting) Suc_eq_plus1 Suc_le_D Suc_le_mono) + then show ?thesis by simp + qed + show "\n\Suc ?t. \ i (f\<^sub>1 \ n) = \ i ?b" + proof - + have "\ i (e_update (block i T) ?k 1) = \ i (e_take ?k (block i T))" if "T \ ?t" for T + using neither by (metis (no_types, lifting) hd_block gap_T that) + then have "\ i (e_update (block i T) ?k 1) = \ i ?b" if "T \ ?t" for T + using that init_tau_gap[of i] gap_T by (metis (no_types, lifting)) + then have "\ i (f\<^sub>1 \ (T + 1)) = \ i ?b" if "T \ ?t" for T + using filled_gap_1_init_tau[of f\<^sub>1 i T] f\<^sub>1_def gap_T that + by (metis (no_types, lifting)) + then have "\ i (f\<^sub>1 \ T) = \ i ?b" if "T \ Suc ?t" for T + using that by (metis (no_types, lifting) Suc_eq_plus1 Suc_le_D Suc_le_mono) + then show ?thesis by simp + qed + qed +qed + +corollary not_learn_lim_V: "\ learn_lim \ (V_bclim i) (\ i)" + using case_one_imp_not_learn_lim_V case_two_imp_not_learn_lim_V + by (cases "case_two i") simp_all + +text \Next we define the separating class.\ + +definition V_BCLIM :: "partial1 set" ("V\<^bsub>BC-LIM\<^esub>") where + "V\<^bsub>BC-LIM\<^esub> \ \i. V_bclim i" + +lemma V_BCLIM_R1: "V\<^bsub>BC-LIM\<^esub> \ \" + using V_BCLIM_def V_subseteq_R1 by auto + +lemma V_BCLIM_not_in_Lim: "V\<^bsub>BC-LIM\<^esub> \ LIM" +proof + assume "V\<^bsub>BC-LIM\<^esub> \ LIM" + then obtain s where s: "learn_lim \ V\<^bsub>BC-LIM\<^esub> s" + using learn_lim_wrt_goedel[OF goedel_numbering_phi] Lim_def by blast + moreover obtain i where "\ i = s" + using s learn_limE(1) phi_universal by blast + ultimately have "learn_lim \ V\<^bsub>BC-LIM\<^esub> (\x. eval r_sigma [i, x])" + using learn_lim_sigma by simp + moreover have "V_bclim i \ V\<^bsub>BC-LIM\<^esub>" + using V_BCLIM_def by auto + ultimately have "learn_lim \ (V_bclim i) (\x. eval r_sigma [i, x])" + using learn_lim_closed_subseteq by simp + then show False + using not_learn_lim_V by simp +qed + + +subsection \The separating class is in BC\ + +text \In order to show @{term "V\<^bsub>BC-LIM\<^esub> \ BC"} we +define a hypothesis space that for every function $\tau_i$ and every list $b$ +of numbers contains a copy of $\tau_i$ with the first $|b|$ values replaced +by $b$.\ + +definition psitau :: partial2 ("\\<^sup>\") where + "\\<^sup>\ b x \ (if x < e_length b then Some (e_nth b x) else \ (e_hd b) x)" + +lemma psitau_in_P2: "\\<^sup>\ \ \

\<^sup>2" +proof - + define r where "r \ + Cn 2 + (r_lifz r_nth (Cn 2 r_tau [Cn 2 r_hd [Id 2 0], Id 2 1])) + [Cn 2 r_less [Id 2 1, Cn 2 r_length [Id 2 0]], Id 2 0, Id 2 1]" + then have "recfn 2 r" + using r_tau_recfn by simp + moreover have "eval r [b, x] = \\<^sup>\ b x" for b x + proof - + let ?f = "Cn 2 r_tau [Cn 2 r_hd [Id 2 0], Id 2 1]" + have "recfn 2 r_nth" "recfn 2 ?f" + using r_tau_recfn by simp_all + then have "eval (r_lifz r_nth ?f) [c, b, x] = + (if c = 0 then eval r_nth [b, x] else eval ?f [b, x])" for c + by simp + moreover have "eval r_nth [b, x] \= e_nth b x" + by simp + moreover have "eval ?f [b, x] = \ (e_hd b) x" + using r_tau_recfn by simp + ultimately have "eval (r_lifz r_nth ?f) [c, b, x] = + (if c = 0 then Some (e_nth b x) else \ (e_hd b) x)" for c + by simp + moreover have "eval (Cn 2 r_less [Id 2 1, Cn 2 r_length [Id 2 0]]) [b, x] \= + (if x < e_length b then 0 else 1)" + by simp + ultimately show ?thesis + unfolding r_def psitau_def using r_tau_recfn by simp + qed + ultimately show ?thesis by auto +qed + +lemma psitau_init: + "\\<^sup>\ (f \ n) x = (if x < Suc n then Some (the (f x)) else \ (the (f 0)) x)" +proof - + let ?e = "f \ n" + have "e_length ?e = Suc n" by simp + moreover have "x < Suc n \ e_nth ?e x = the (f x)" by simp + moreover have "e_hd ?e = the (f 0)" + using hd_init by simp + ultimately show ?thesis using psitau_def by simp +qed + +text \The class @{term V_BCLIM} can be learned BC-style in the +hypothesis space @{term psitau} by the identity function.\ + +lemma learn_bc_V_BCLIM: "learn_bc \\<^sup>\ V\<^bsub>BC-LIM\<^esub> Some" +proof (rule learn_bcI) + show "environment \\<^sup>\ V\<^bsub>BC-LIM\<^esub> Some" + using identity_in_R1 V_BCLIM_R1 psitau_in_P2 by auto + show "\n\<^sub>0. \n\n\<^sub>0. \\<^sup>\ (the (Some (f \ n))) = f" if "f \ V\<^bsub>BC-LIM\<^esub>" for f + proof - + from that V_BCLIM_def obtain i where i: "f \ V_bclim i" + by auto + show ?thesis + proof (cases "case_two i") + case True + let ?P = "\t. \T. (gap i T) \ (gap i t)" + let ?lmin = "LEAST t. ?P t" + define k where "k \ gap i ?lmin" + have V_bclim: "V_bclim i = {(\ i)(k:=Some 0), (\ i)(k:=Some 1)}" + using True V_bclim_def k_def by (simp add: Let_def) + moreover have "0 < k" + using gap_gr0[of i] k_def by simp + ultimately have "f 0 \= i" + using tau_at_0[of i] i by auto + have "\\<^sup>\ (f \ n) = f" if "n \ k" for n + proof + fix x + show "\\<^sup>\ (f \ n) x = f x" + proof (cases "x \ n") + case True + then show ?thesis + using R1_imp_total1 V_subseteq_R1 i psitau_init by fastforce + next + case False + then have "\\<^sup>\ (f \ n) x = \ (the (f 0)) x" + using psitau_init by simp + then have "\\<^sup>\ (f \ n) x = \ i x" + using `f 0 \= i` by simp + moreover have "f x = \ i x" + using False V_bclim i that by auto + ultimately show ?thesis by simp + qed + qed + then show ?thesis by auto + next + case False + then have "V_bclim i = {\ i}" + using V_bclim_def by (auto simp add: Let_def) + then have f: "f = \ i" + using i by simp + have "\\<^sup>\ (f \ n) = f" for n + proof + fix x + show "\\<^sup>\ (f \ n) x = f x" + proof (cases "x \ n") + case True + then show ?thesis + using R1_imp_total1 V_BCLIM_R1 psitau_init that by auto + next + case False + then show ?thesis by (simp add: f psitau_init tau_at_0) + qed + qed + then show ?thesis by simp + qed + qed +qed + +text \Finally, the main result of this section:\ + +theorem Lim_subset_BC: "LIM \ BC" + using learn_bc_V_BCLIM BC_def Lim_subseteq_BC V_BCLIM_not_in_Lim by auto + +end diff --git a/thys/Inductive_Inference/Lemma_R.thy b/thys/Inductive_Inference/Lemma_R.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Lemma_R.thy @@ -0,0 +1,2114 @@ +section \Lemma R\label{s:lemma_r}\ + +theory Lemma_R + imports Inductive_Inference_Basics +begin + +text \A common technique for constructing a class that cannot be +learned is diagonalization against all strategies (see, for instance, +Section~\ref{s:lim_bc}). Similarly, the typical way of proving that a class +cannot be learned is by assuming there is a strategy and deriving a +contradiction. Both techniques are easier to carry out if one has to consider +only \emph{total} recursive strategies. This is not possible in general, +since after all the definitions of the inference types admit strictly partial +strategies. However, for many inference types one can show that for every +strategy there is a total strategy with at least the same ``learning power''. +Results to that effect are called Lemma~R. + +Lemma~R comes in different strengths depending on how general the +construction of the total recursive strategy is. CONS is the only inference +type considered here for which not even a weak form of Lemma~R holds.\ + + +subsection \Strong Lemma R for LIM, FIN, and BC\ + +text \In its strong form Lemma~R says that for any strategy $S$, there +is a total strategy $T$ that learns all classes $S$ learns regardless of +hypothesis space. The strategy $T$ can be derived from $S$ by a delayed +simulation of $S$. More precisely, for input $f^n$, $T$ simulates $S$ for +prefixes $f^0, f^1, \ldots, f^n$ for at most $n$ steps. If $S$ halts on none +of the prefixes, $T$ outputs an arbitrary hypothesis. Otherwise let $k \leq +n$ be maximal such that $S$ halts on $f^k$ in at most $n$ steps. Then $T$ +outputs $S(f^k)$. \ + +text \We reformulate some lemmas for @{term r_result1} to make it easier +to use them with @{term "\"}.\ + +lemma r_result1_converg_phi: + assumes "\ i x \= v" + shows "\t. + (\t'\t. eval r_result1 [t', i, x] \= Suc v) \ + (\t'= 0)" + using assms r_result1_converg' phi_def by simp_all + +lemma r_result1_bivalent': + assumes "eval r_phi [i, x] \= v" + shows "eval r_result1 [t, i, x] \= Suc v \ eval r_result1 [t, i, x] \= 0" + using assms r_result1 r_result_bivalent' r_phi'' by simp + +lemma r_result1_bivalent_phi: + assumes "\ i x \= v" + shows "eval r_result1 [t, i, x] \= Suc v \ eval r_result1 [t, i, x] \= 0" + using assms r_result1_bivalent' phi_def by simp_all + +lemma r_result1_diverg_phi: + assumes "\ i x \" + shows "eval r_result1 [t, i, x] \= 0" + using assms phi_def r_result1_diverg' by simp + +lemma r_result1_some_phi: + assumes "eval r_result1 [t, i, x] \= Suc v" + shows "\ i x \= v" + using assms phi_def r_result1_Some' by simp + +lemma r_result1_saturating': + assumes "eval r_result1 [t, i, x] \= Suc v" + shows "eval r_result1 [t + d, i, x] \= Suc v" + using assms r_result1 r_result_saturating r_phi'' by simp + +lemma r_result1_saturating_the: + assumes "the (eval r_result1 [t, i, x]) > 0" and "t' \ t" + shows "the (eval r_result1 [t', i, x]) > 0" +proof - + from assms(1) obtain v where "eval r_result1 [t, i, x] \= Suc v" + using r_result1_bivalent_phi r_result1_diverg_phi + by (metis inc_induct le_0_eq not_less_zero option.discI option.expand option.sel) + with assms have "eval r_result1 [t', i, x] \= Suc v" + using r_result1_saturating' le_Suc_ex by blast + then show ?thesis by simp +qed + +lemma Greatest_bounded_Suc: + fixes P :: "nat \ nat" + shows "(if P n > 0 then Suc n + else if \j 0 then Suc (GREATEST j. j < n \ P j > 0) else 0) = + (if \j 0 then Suc (GREATEST j. j < Suc n \ P j > 0) else 0)" + (is "?lhs = ?rhs") +proof (cases "\j 0") + case 1: True + show ?thesis + proof (cases "P n > 0") + case True + then have "(GREATEST j. j < Suc n \ P j > 0) = n" + using Greatest_equality[of "\j. j < Suc n \ P j > 0"] by simp + moreover have "?rhs = Suc (GREATEST j. j < Suc n \ P j > 0)" + using 1 by simp + ultimately have "?rhs = Suc n" by simp + then show ?thesis using True by simp + next + case False + then have "?lhs = Suc (GREATEST j. j < n \ P j > 0)" + using 1 by (metis less_SucE) + moreover have "?rhs = Suc (GREATEST j. j < Suc n \ P j > 0)" + using 1 by simp + moreover have "(GREATEST j. j < n \ P j > 0) = + (GREATEST j. j < Suc n \ P j > 0)" + using 1 False by (metis less_SucI less_Suc_eq) + ultimately show ?thesis by simp + qed +next + case False + then show ?thesis by auto +qed + +text \For $n$, $i$, $x$, the next function simulates $\varphi_i$ on all +non-empty prefixes of at most length $n$ of the list $x$ for at most $n$ +steps. It returns the length of the longest such prefix for which $\varphi_i$ +halts, or zero if $\varphi_i$ does not halt for any prefix.\ + +definition "r_delay_aux \ + Pr 2 (r_constn 1 0) + (Cn 4 r_ifz + [Cn 4 r_result1 + [Cn 4 r_length [Id 4 3], Id 4 2, + Cn 4 r_take [Cn 4 S [Id 4 0], Id 4 3]], + Id 4 1, Cn 4 S [Id 4 0]])" + +lemma r_delay_aux_prim: "prim_recfn 3 r_delay_aux" + unfolding r_delay_aux_def by simp_all + +lemma r_delay_aux_total: "total r_delay_aux" + using prim_recfn_total[OF r_delay_aux_prim] . + +lemma r_delay_aux: + assumes "n \ e_length x" + shows "eval r_delay_aux [n, i, x] \= + (if \j 0 + then Suc (GREATEST j. + j < n \ + the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0) + else 0)" +proof - + define z where "z \ + Cn 4 r_result1 + [Cn 4 r_length [Id 4 3], Id 4 2, Cn 4 r_take [Cn 4 S [Id 4 0], Id 4 3]]" + then have z_recfn: "recfn 4 z" by simp + have z: "eval z [j, r, i, x] = eval r_result1 [e_length x, i, e_take (Suc j) x]" + if "j < e_length x" for j r i x + unfolding z_def using that by simp + + define g where "g \ Cn 4 r_ifz [z, Id 4 1, Cn 4 S [Id 4 0]]" + then have g: "eval g [j, r, i, x] \= + (if the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0 then Suc j else r)" + if "j < e_length x" for j r i x + using that z prim_recfn_total z_recfn by simp + + show ?thesis + using assms + proof (induction n) + case 0 + moreover have "eval r_delay_aux [0, i, x] \= 0" + using eval_Pr_0 r_delay_aux_def r_delay_aux_prim r_constn + by (simp add: r_delay_aux_def) + ultimately show ?case by simp + next + case (Suc n) + let ?P = "\j. the (eval r_result1 [e_length x, i, e_take (Suc j) x])" + have "eval r_delay_aux [n, i, x] \" + using Suc by simp + moreover have "eval r_delay_aux [Suc n, i, x] = + eval (Pr 2 (r_constn 1 0) g) [Suc n, i, x]" + unfolding r_delay_aux_def g_def z_def by simp + ultimately have "eval r_delay_aux [Suc n, i, x] = + eval g [n, the (eval r_delay_aux [n, i, x]), i, x]" + using r_delay_aux_prim Suc eval_Pr_converg_Suc + by (simp add: r_delay_aux_def g_def z_def numeral_3_eq_3) + then have "eval r_delay_aux [Suc n, i, x] \= + (if ?P n > 0 then Suc n + else if \j 0 then Suc (GREATEST j. j < n \ ?P j > 0) else 0)" + using g Suc by simp + then have "eval r_delay_aux [Suc n, i, x] \= + (if \j 0 then Suc (GREATEST j. j < Suc n \ ?P j > 0) else 0)" + using Greatest_bounded_Suc[where ?P="?P"] by simp + then show ?case by simp + qed +qed + +text \The next function simulates $\varphi_i$ on all non-empty prefixes +of a list $x$ of length $n$ for at most $n$ steps and outputs the length of +the longest prefix for which $\varphi_i$ halts, or zero if $\varphi_i$ does +not halt for any such prefix.\ + +definition "r_delay \ Cn 2 r_delay_aux [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]" + +lemma r_delay_recfn [simp]: "recfn 2 r_delay" + unfolding r_delay_def by (simp add: r_delay_aux_prim) + +lemma r_delay: + "eval r_delay [i, x] \= + (if \j 0 + then Suc (GREATEST j. + j < e_length x \ the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0) + else 0)" + unfolding r_delay_def using r_delay_aux r_delay_aux_prim by simp + +definition "delay i x \ Some + (if \j 0 + then Suc (GREATEST j. + j < e_length x \ the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0) + else 0)" + +lemma delay_in_R2: "delay \ \\<^sup>2" + using r_delay totalI2 R2I delay_def r_delay_recfn + by (metis (no_types, lifting) numeral_2_eq_2 option.simps(3)) + +lemma delay_le_length: "the (delay i x) \ e_length x" +proof (cases "\j 0") + case True + let ?P = "\j. j < e_length x \ the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0" + from True have "\j. ?P j" by simp + moreover have "\y. ?P y \ y \ e_length x" by simp + ultimately have "?P (Greatest ?P)" + using GreatestI_ex_nat[where ?P="?P"] by blast + then have "Greatest ?P < e_length x" by simp + moreover have "delay i x \= Suc (Greatest ?P)" + using delay_def True by simp + ultimately show ?thesis by auto +next + case False + then show ?thesis using delay_def by auto +qed + +lemma e_take_delay_init: + assumes "f \ \" and "the (delay i (f \ n)) > 0" + shows "e_take (the (delay i (f \ n))) (f \ n) = f \ (the (delay i (f \ n)) - 1)" + using assms e_take_init[of f _ n] length_init[of f n] delay_le_length[of i "f \ n"] + by (metis One_nat_def Suc_le_lessD Suc_pred) + +lemma delay_gr0_converg: + assumes "the (delay i x) > 0" + shows "\ i (e_take (the (delay i x)) x) \" +proof - + let ?P = "\j. j < e_length x \ the (eval r_result1 [e_length x, i, e_take (Suc j) x]) > 0" + have "\j. ?P j" + proof (rule ccontr) + assume "\ (\j. ?P j)" + then have "delay i x \= 0" + using delay_def by simp + with assms show False by simp + qed + then have d: "the (delay i x) = Suc (Greatest ?P)" + using delay_def by simp + moreover have "\y. ?P y \ y \ e_length x" by simp + ultimately have "?P (Greatest ?P)" + using `\j. ?P j` GreatestI_ex_nat[where ?P="?P"] by blast + then have "the (eval r_result1 [e_length x, i, e_take (Suc (Greatest ?P)) x]) > 0" + by simp + then have "the (eval r_result1 [e_length x, i, e_take (the (delay i x)) x]) > 0" + using d by simp + then show ?thesis using r_result1_diverg_phi by fastforce +qed + +lemma delay_unbounded: + fixes n :: nat + assumes "f \ \" and "\n. \ i (f \ n) \" + shows "\m. the (delay i (f \ m)) > n" +proof - + from assms have "\t. the (eval r_result1 [t, i, f \ n]) > 0" + using r_result1_converg_phi + by (metis le_refl option.exhaust_sel option.sel zero_less_Suc) + then obtain t where t: "the (eval r_result1 [t, i, f \ n]) > 0" + by auto + let ?m = "max n t" + have "Suc ?m \ t" by simp + have m: "the (eval r_result1 [Suc ?m, i, f \ n]) > 0" + proof - + let ?w = "eval r_result1 [t, i, f \ n]" + obtain v where v: "?w \= Suc v" + using t assms(2) r_result1_bivalent_phi by fastforce + have "eval r_result1 [Suc ?m, i, f \ n] = ?w" + using v t r_result1_saturating' `Suc ?m \ t` le_Suc_ex by fastforce + then show ?thesis using t by simp + qed + let ?x = "f \ ?m" + have "the (delay i ?x) > n" + proof - + let ?P = "\j. j < e_length ?x \ the (eval r_result1 [e_length ?x, i, e_take (Suc j) ?x]) > 0" + have "e_length ?x = Suc ?m" by simp + moreover have "e_take (Suc n) ?x = f \ n" + using assms(1) e_take_init by auto + ultimately have "?P n" + using m by simp + have "\y. ?P y \ y \ e_length ?x" by simp + with `?P n` have "n \ (Greatest ?P)" + using Greatest_le_nat[of ?P n "e_length ?x"] by simp + moreover have "the (delay i ?x) = Suc (Greatest ?P)" + using delay_def `?P n` by auto + ultimately show ?thesis by simp + qed + then show ?thesis by auto +qed + +lemma delay_monotone: + assumes "f \ \" and "n\<^sub>1 \ n\<^sub>2" + shows "the (delay i (f \ n\<^sub>1)) \ the (delay i (f \ n\<^sub>2))" + (is "the (delay i ?x1) \ the (delay i ?x2)") +proof (cases "the (delay i (f \ n\<^sub>1)) = 0") + case True + then show ?thesis by simp +next + case False + let ?P1 = "\j. j < e_length ?x1 \ the (eval r_result1 [e_length ?x1, i, e_take (Suc j) ?x1]) > 0" + let ?P2 = "\j. j < e_length ?x2 \ the (eval r_result1 [e_length ?x2, i, e_take (Suc j) ?x2]) > 0" + from False have d1: "the (delay i ?x1) = Suc (Greatest ?P1)" "\j. ?P1 j" + using delay_def option.collapse by fastforce+ + moreover have "\y. ?P1 y \ y \ e_length ?x1" by simp + ultimately have *: "?P1 (Greatest ?P1)" using GreatestI_ex_nat[of ?P1] by blast + let ?j = "Greatest ?P1" + from * have "?j < e_length ?x1" by auto + then have 1: "e_take (Suc ?j) ?x1 = e_take (Suc ?j) ?x2" + using assms e_take_init by auto + from * have 2: "?j < e_length ?x2" using assms(2) by auto + with 1 * have "the (eval r_result1 [e_length ?x1, i, e_take (Suc ?j) ?x2]) > 0" + by simp + moreover have "e_length ?x1 \ e_length ?x2" + using assms(2) by auto + ultimately have "the (eval r_result1 [e_length ?x2, i, e_take (Suc ?j) ?x2]) > 0" + using r_result1_saturating_the by simp + with 2 have "?P2 ?j" by simp + then have d2: "the (delay i ?x2) = Suc (Greatest ?P2)" + using delay_def by auto + have "\y. ?P2 y \ y \ e_length ?x2" by simp + with `?P2 ?j` have "?j \ (Greatest ?P2)" using Greatest_le_nat[of ?P2] by blast + with d1 d2 show ?thesis by simp +qed + +lemma delay_unbounded_monotone: + fixes n :: nat + assumes "f \ \" and "\n. \ i (f \ n) \" + shows "\m\<^sub>0. \m\m\<^sub>0. the (delay i (f \ m)) > n" +proof - + from assms delay_unbounded obtain m\<^sub>0 where "the (delay i (f \ m\<^sub>0)) > n" + by blast + then have "\m\m\<^sub>0. the (delay i (f \ m)) > n" + using assms(1) delay_monotone order.strict_trans2 by blast + then show ?thesis by auto +qed + +text \Now we can define a function that simulates an arbitrary strategy +$\varphi_i$ in a delayed way. The parameter $d$ is the default hypothesis for +when $\varphi_i$ does not halt within the time bound for any prefix.\ + +definition r_totalizer :: "nat \ recf" where + "r_totalizer d \ + Cn 2 + (r_lifz + (r_constn 1 d) + (Cn 2 r_phi + [Id 2 0, Cn 2 r_take [Cn 2 r_delay [Id 2 0, Id 2 1], Id 2 1]])) + [Cn 2 r_delay [Id 2 0, Id 2 1], Id 2 0, Id 2 1]" + +lemma r_totalizer_recfn: "recfn 2 (r_totalizer d)" + unfolding r_totalizer_def by simp + +lemma r_totalizer: + "eval (r_totalizer d) [i, x] = + (if the (delay i x) = 0 then Some d else \ i (e_take (the (delay i x)) x))" +proof - + let ?i = "Cn 2 r_delay [Id 2 0, Id 2 1]" + have "eval ?i [i, x] = eval r_delay [i, x]" for i x + using r_delay_recfn by simp + then have i: "eval ?i [i, x] = delay i x" for i x + using r_delay by (simp add: delay_def) + let ?t = "r_constn 1 d" + have t: "eval ?t [i, x] \= d" for i x by simp + let ?e1 = "Cn 2 r_take [?i, Id 2 1]" + let ?e = "Cn 2 r_phi [Id 2 0, ?e1]" + have "eval ?e1 [i, x] = eval r_take [the (delay i x), x]" for i x + using r_delay i delay_def by simp + then have "eval ?e1 [i, x] \= e_take (the (delay i x)) x" for i x + using delay_le_length by simp + then have e: "eval ?e [i, x] = \ i (e_take (the (delay i x)) x)" + using phi_def by simp + let ?z = "r_lifz ?t ?e" + have recfn_te: "recfn 2 ?t" "recfn 2 ?e" + by simp_all + then have "eval (r_totalizer d) [i, x] = eval (r_lifz ?t ?e) [the (delay i x), i, x]" + for i x + unfolding r_totalizer_def using i r_totalizer_recfn delay_def by simp + then have "eval (r_totalizer d) [i, x] = + (if the (delay i x) = 0 then eval ?t [i, x] else eval ?e [i, x])" + for i x + using recfn_te by simp + then show ?thesis using t e by simp +qed + +lemma r_totalizer_total: "total (r_totalizer d)" +proof (rule totalI2) + show "recfn 2 (r_totalizer d)" using r_totalizer_recfn by simp + show "\x y. eval (r_totalizer d) [x, y] \" + using r_totalizer delay_gr0_converg by simp +qed + +definition totalizer :: "nat \ partial2" where + "totalizer d i x \ + if the (delay i x) = 0 then Some d else \ i (e_take (the (delay i x)) x)" + +lemma totalizer_init: + assumes "f \ \" + shows "totalizer d i (f \ n) = + (if the (delay i (f \ n)) = 0 then Some d + else \ i (f \ (the (delay i (f \ n)) - 1)))" + using assms e_take_delay_init by (simp add: totalizer_def) + +lemma totalizer_in_R2: "totalizer d \ \\<^sup>2" + using totalizer_def r_totalizer r_totalizer_total R2I r_totalizer_recfn + by metis + +text \For LIM, @{term totalizer} works with every default hypothesis +$d$.\ + +lemma lemma_R_for_Lim: + assumes "learn_lim \ U (\ i)" + shows "learn_lim \ U (totalizer d i)" +proof (rule learn_limI) + show env: "environment \ U (totalizer d i)" + using assms learn_limE(1) totalizer_in_R2 by auto + show "\j. \ j = f \ (\\<^sup>\n. totalizer d i (f \ n) \= j)" if "f \ U" for f + proof - + have "f \ \" + using assms env that by auto + from assms learn_limE obtain j n\<^sub>0 where + j: "\ j = f" and + n0: "\n\n\<^sub>0. (\ i) (f \ n) \= j" + using `f \ U` by metis + obtain m\<^sub>0 where m0: "\m\m\<^sub>0. the (delay i (f \ m)) > n\<^sub>0" + using delay_unbounded_monotone `f \ \` \f \ U\ assms learn_limE(1) + by blast + then have "\m\m\<^sub>0. totalizer d i (f \ m) = \ i (e_take (the (delay i (f \ m))) (f \ m))" + using totalizer_def by auto + then have "\m\m\<^sub>0. totalizer d i (f \ m) = \ i (f \ (the (delay i (f \ m)) - 1))" + using e_take_delay_init m0 `f \ \` by auto + with m0 n0 have "\m\m\<^sub>0. totalizer d i (f \ m) \= j" + by auto + with j show ?thesis by auto + qed +qed + +text \The effective version of Lemma~R for LIM states that there is a +total recursive function computing Gödel numbers of total strategies +from those of arbitrary strategies.\ + +lemma lemma_R_for_Lim_effective: + "\g\\. \i. + \ (the (g i)) \ \ \ + (\U \. learn_lim \ U (\ i) \ learn_lim \ U (\ (the (g i))))" +proof - + have "totalizer 0 \ \

\<^sup>2" using totalizer_in_R2 by auto + then obtain g where g: "g \ \" "\i. (totalizer 0) i = \ (the (g i))" + using numbering_translation_for_phi by blast + with totalizer_in_R2 have "\i. \ (the (g i)) \ \" + by (metis R2_proj_R1) + moreover from g(2) lemma_R_for_Lim[where ?d=0] have + "\i U \. learn_lim \ U (\ i) \ learn_lim \ U (\ (the (g i)))" + by simp + ultimately show ?thesis using g(1) by blast +qed + +text \In order for us to use the previous lemma, we need a function +that performs the actual computation:\ + +definition "r_limr \ + SOME g. + recfn 1 g \ + total g \ + (\i. \ (the (eval g [i])) \ \ \ + (\U \. learn_lim \ U (\ i) \ learn_lim \ U (\ (the (eval g [i])))))" + +lemma r_limr_recfn: "recfn 1 r_limr" + and r_limr_total: "total r_limr" + and r_limr: + "\ (the (eval r_limr [i])) \ \" + "learn_lim \ U (\ i) \ learn_lim \ U (\ (the (eval r_limr [i])))" +proof - + let ?P = "\g. + g \ \ \ + (\i. \ (the (g i)) \ \ \ (\U \. learn_lim \ U (\ i) \ learn_lim \ U (\ (the (g i)))))" + let ?Q = "\g. + recfn 1 g \ + total g \ + (\i. \ (the (eval g [i])) \ \ \ + (\U \. learn_lim \ U (\ i) \ learn_lim \ U (\ (the (eval g [i])))))" + have "\g. ?P g" using lemma_R_for_Lim_effective by auto + then obtain g where "?P g" by auto + then obtain g' where g': "recfn 1 g'" "total g'" "\i. eval g' [i] = g i" + by blast + with `?P g` have "?Q g'" by simp + with r_limr_def someI_ex[of ?Q] show + "recfn 1 r_limr" + "total r_limr" + "\ (the (eval r_limr [i])) \ \" + "learn_lim \ U (\ i) \ learn_lim \ U (\ (the (eval r_limr [i])))" + by auto +qed + +text \For BC, too, @{term totalizer} works with every default +hypothesis $d$.\ + +lemma lemma_R_for_BC: + assumes "learn_bc \ U (\ i)" + shows "learn_bc \ U (totalizer d i)" +proof (rule learn_bcI) + show env: "environment \ U (totalizer d i)" + using assms learn_bcE(1) totalizer_in_R2 by auto + show "\n\<^sub>0. \n\n\<^sub>0. \ (the (totalizer d i (f \ n))) = f" if "f \ U" for f + proof - + have "f \ \" + using assms env that by auto + obtain n\<^sub>0 where n0: "\n\n\<^sub>0. \ (the ((\ i) (f \ n))) = f" + using assms learn_bcE `f \ U` by metis + obtain m\<^sub>0 where m0: "\m\m\<^sub>0. the (delay i (f \ m)) > n\<^sub>0" + using delay_unbounded_monotone `f \ \` \f \ U\ assms learn_bcE(1) + by blast + then have "\m\m\<^sub>0. totalizer d i (f \ m) = \ i (e_take (the (delay i (f \ m))) (f \ m))" + using totalizer_def by auto + then have "\m\m\<^sub>0. totalizer d i (f \ m) = \ i (f \ (the (delay i (f \ m)) - 1))" + using e_take_delay_init m0 `f \ \` by auto + with m0 n0 have "\m\m\<^sub>0. \ (the (totalizer d i (f \ m))) = f" + by auto + then show ?thesis by auto + qed +qed + +corollary lemma_R_for_BC_simple: + assumes "learn_bc \ U s" + shows "\s'\\. learn_bc \ U s'" + using assms lemma_R_for_BC totalizer_in_R2 learn_bcE + by (metis R2_proj_R1 learn_bcE(1) phi_universal) + + +text \For FIN the default hypothesis of @{term totalizer} must be +zero, signalling ``don't know yet''.\ + +lemma lemma_R_for_FIN: + assumes "learn_fin \ U (\ i)" + shows "learn_fin \ U (totalizer 0 i)" +proof (rule learn_finI) + show env: "environment \ U (totalizer 0 i)" + using assms learn_finE(1) totalizer_in_R2 by auto + show "\j n\<^sub>0. \ j = f \ + (\n0. totalizer 0 i (f \ n) \= 0) \ + (\n\n\<^sub>0. totalizer 0 i (f \ n) \= Suc j)" + if "f \ U" for f + proof - + have "f \ \" + using assms env that by auto + from assms learn_finE[of \ U "\ i"] obtain j where + j: "\ j = f" and + ex_n0: "\n\<^sub>0. (\n0. (\ i) (f \ n) \= 0) \ (\n\n\<^sub>0. (\ i) (f \ n) \= Suc j)" + using `f \ U` by blast + let ?Q = "\n\<^sub>0. (\n0. (\ i) (f \ n) \= 0) \ (\n\n\<^sub>0. (\ i) (f \ n) \= Suc j)" + define n\<^sub>0 where "n\<^sub>0 = Least ?Q" + with ex_n0 have n0: "?Q n\<^sub>0" "\n0. \ ?Q n" + using LeastI_ex[of ?Q] not_less_Least[of _ ?Q] by blast+ + define m\<^sub>0 where "m\<^sub>0 = (LEAST m\<^sub>0. \m\m\<^sub>0. the (delay i (f \ m)) > n\<^sub>0)" + (is "m\<^sub>0 = Least ?P") + moreover have "\m\<^sub>0. \m\m\<^sub>0. the (delay i (f \ m)) > n\<^sub>0" + using delay_unbounded_monotone `f\\` \f \ U\ assms learn_finE(1) + by simp + ultimately have m0: "?P m\<^sub>0" "\m0. \ ?P m" + using LeastI_ex[of ?P] not_less_Least[of _ ?P] by blast+ + then have "\m\m\<^sub>0. totalizer 0 i (f \ m) = \ i (e_take (the (delay i (f \ m))) (f \ m))" + using totalizer_def by auto + then have "\m\m\<^sub>0. totalizer 0 i (f \ m) = \ i (f \ (the (delay i (f \ m)) - 1))" + using e_take_delay_init m0 `f\\` by auto + with m0 n0 have "\m\m\<^sub>0. totalizer 0 i (f \ m) \= Suc j" + by auto + moreover have "totalizer 0 i (f \ m) \= 0" if "m < m\<^sub>0" for m + proof (cases "the (delay i (f \ m)) = 0") + case True + then show ?thesis by (simp add: totalizer_def) + next + case False + then have "the (delay i (f \ m)) \ n\<^sub>0" + using m0 that `f \ \` delay_monotone by (meson leI order.strict_trans2) + then show ?thesis + using \f \ \\ n0(1) totalizer_init by (simp add: Suc_le_lessD) + qed + ultimately show ?thesis using j by auto + qed +qed + + +subsection \Weaker Lemma R for CP and TOTAL\ + +text \For TOTAL the default hypothesis used by @{term totalizer} +depends on the hypothesis space, because it must refer to a total function in +that space. Consequently the total strategy depends on the hypothesis space, +which makes this form of Lemma~R weaker than the ones in the previous +section.\ + +lemma lemma_R_for_TOTAL: + fixes \ :: partial2 + shows "\d. \U. \i. learn_total \ U (\ i) \ learn_total \ U (totalizer d i)" +proof (cases "\d. \ d \ \") + case True + then obtain d where "\ d \ \" by auto + have "learn_total \ U (totalizer d i)" if "learn_total \ U (\ i)" for U i + proof (rule learn_totalI) + show env: "environment \ U (totalizer d i)" + using that learn_totalE(1) totalizer_in_R2 by auto + show "\f. f \ U \ \j. \ j = f \ (\\<^sup>\n. totalizer d i (f \ n) \= j)" + using that learn_total_def lemma_R_for_Lim[where ?d=d] learn_limE(2) by metis + show "\ (the (totalizer d i (f \ n))) \ \" if "f \ U" for f n + proof (cases "the (delay i (f \ n)) = 0") + case True + then show ?thesis using totalizer_def `\ d \ \` by simp + next + case False + have "f \ \" + using that env by auto + then show ?thesis + using False that `learn_total \ U (\ i)` totalizer_init learn_totalE(3) + by simp + qed + qed + then show ?thesis by auto +next + case False + then show ?thesis using learn_total_def lemma_R_for_Lim by auto +qed + +corollary lemma_R_for_TOTAL_simple: + assumes "learn_total \ U s" + shows "\s'\\. learn_total \ U s'" + using assms lemma_R_for_TOTAL totalizer_in_R2 + by (metis R2_proj_R1 learn_totalE(1) phi_universal) + +text \For CP the default hypothesis used by @{term totalizer} depends +on both the hypothesis space and the class. Therefore the total strategy +depends on both the the hypothesis space and the class, which makes Lemma~R +for CP even weaker than the one for TOTAL.\ + +lemma lemma_R_for_CP: + fixes \ :: partial2 and U :: "partial1 set" + assumes "learn_cp \ U (\ i)" + shows "\d. learn_cp \ U (totalizer d i)" +proof (cases "U = {}") + case True + then show ?thesis using assms learn_cp_def lemma_R_for_Lim by auto +next + case False + then obtain f where "f \ U" by auto + from `f \ U` obtain d where "\ d = f" + using learn_cpE(2)[OF assms] by auto + with `f \ U` have "\ d \ U" by simp + have "learn_cp \ U (totalizer d i)" + proof (rule learn_cpI) + show env: "environment \ U (totalizer d i)" + using assms learn_cpE(1) totalizer_in_R2 by auto + show "\f. f \ U \ \j. \ j = f \ (\\<^sup>\n. totalizer d i (f \ n) \= j)" + using assms learn_cp_def lemma_R_for_Lim[where ?d=d] learn_limE(2) by metis + show "\ (the (totalizer d i (f \ n))) \ U" if "f \ U" for f n + proof (cases "the (delay i (f \ n)) = 0") + case True + then show ?thesis using totalizer_def `\ d \ U` by simp + next + case False + then show ?thesis + using that env assms totalizer_init learn_cpE(3) by auto + qed + qed + then show ?thesis by auto +qed + + +subsection \No Lemma R for CONS\ + +text \This section demonstrates that the class $V_{01}$ of all total +recursive functions $f$ where $f(0)$ or $f(1)$ is a Gödel number of $f$ can +be consistently learned in the limit, but not by a total strategy. This implies +that Lemma~R does not hold for CONS.\ + +definition V01 :: "partial1 set" ("V\<^sub>0\<^sub>1") where + "V\<^sub>0\<^sub>1 = {f. f \ \ \ (\ (the (f 0)) = f \ \ (the (f 1)) = f)}" + + +subsubsection \No total CONS strategy for @{term "V\<^sub>0\<^sub>1"}\label{s:v01_not_total}\ + +text \In order to show that no total strategy can learn @{term +"V\<^sub>0\<^sub>1"} we construct, for each total strategy $S$, one or two +functions in @{term "V\<^sub>0\<^sub>1"} such that $S$ fails for at least one +of them. At the core of this construction is a process that given a total +recursive strategy $S$ and numbers $z, i, j \in \mathbb{N}$ builds a function +$f$ as follows: Set $f(0) = i$ and $f(1) = j$. For $x\geq1$: +\begin{enumerate} +\item[(a)] Check whether $S$ changes its hypothesis when $f^x$ is + extended by 0, that is, if $S(f^x) \neq S(f^x0)$. If so, set $f(x+1) = 0$. +\item[(b)] Otherwise check if $S$ changes its hypothesis when $f^x$ is extended + by $1$, that is, if $S(f^x) \neq S(f^x1)$. If so, set $f(x+1) = 1$. +\item[(c)] If neither happens, set $f(x+1) = z$. +\end{enumerate} +In other words, as long as we can force $S$ to change its hypothesis by +extending the function by 0 or 1, we do just that. Now there are two +cases: +\begin{enumerate} +\item[Case 1.] For all $x\geq1$ either (a) or (b) occurs; then $S$ + changes its hypothesis on $f$ all the time and thus does not learn $f$ in + the limit (not to mention consistently). The value of $z$ makes no + difference in this case. +\item[Case 2.] For some minimal $x$, (c) occurs, that is, + there is an $f^x$ such that $h := S(f^x) = S(f^x0) = S(f^x1)$. But the + hypothesis $h$ cannot be consistent with both prefixes $f^x0$ and $f^x1$. + Running the process once with $z = 0$ and once with $z = 1$ yields two + functions starting with $f^x0$ and $f^x1$, respectively, such that $S$ + outputs the same hypothesis, $h$, on both prefixes and thus cannot be + consistent for both functions. +\end{enumerate} +This process is computable because $S$ is total. The construction does not +work if we only assume $S$ to be a CONS strategy for $V_{01}$, because we +need to be able to apply $S$ to prefixes not in $V_{01}$. + +The parameters $i$ and $j$ provide flexibility to find functions built by the +above process that are actually in $V_{01}$. To this end we will use +Smullyan's double fixed-point theorem.\ + +context + fixes s :: partial1 + assumes s_in_R1 [simp, intro]: "s \ \" +begin + +text \The function @{term prefixes} constructs prefixes according to the +aforementioned process.\ + +fun prefixes :: "nat \ nat \ nat \ nat \ nat list" where + "prefixes z i j 0 = [i]" +| "prefixes z i j (Suc x) = prefixes z i j x @ + [if x = 0 then j + else if s (list_encode (prefixes z i j x @ [0])) \ s (list_encode (prefixes z i j x)) + then 0 + else if s (list_encode (prefixes z i j x @ [1])) \ s (list_encode (prefixes z i j x)) + then 1 + else z]" + +lemma prefixes_length: "length (prefixes z i j x) = Suc x" + by (induction x) simp_all + +text \The functions @{term[names_short] "adverse z i j"} are the +functions constructed by @{term[names_short] "prefixes"}.\ + +definition adverse :: "nat \ nat \ nat \ nat \ nat option" where + "adverse z i j x \ Some (last (prefixes z i j x))" + +lemma init_adverse_eq_prefixes: "(adverse z i j) \ n = list_encode (prefixes z i j n)" +proof - + have "prefix (adverse z i j) n = prefixes z i j n" + proof (induction n) + case 0 + then show ?case using adverse_def prefixes_length prefixI' by fastforce + next + case (Suc n) + then show ?case using adverse_def by (simp add: prefix_Suc) + qed + then show ?thesis by (simp add: init_def) +qed + +lemma adverse_at_01: + "adverse z i j 0 \= i" + "adverse z i j 1 \= j" + by (auto simp add: adverse_def) + +text \Had we introduced ternary partial recursive functions, the +@{term[names_short] "adverse z"} functions would be among them.\ + +lemma adverse_in_R3: "\r. recfn 3 r \ total r \ (\i j x. eval r [i, j, x]) = adverse z" +proof - + obtain rs where rs: "recfn 1 rs" "total rs" "(\x. eval rs [x]) = s" + using R1E by auto + have s_total: "\x. s x \" by simp + + define f where "f = Cn 2 r_singleton_encode [Id 2 0]" + then have "recfn 2 f" by simp + have f: "\i j. eval f [i, j] \= list_encode [i]" + unfolding f_def by simp + + define ch1 where "ch1 = Cn 4 r_ifeq + [Cn 4 rs [Cn 4 r_snoc [Id 4 1, r_constn 3 1]], + Cn 4 rs [Id 4 1], + r_dummy 3 (r_const z), + r_constn 3 1]" + then have ch1: "recfn 4 ch1" "total ch1" + using Cn_total prim_recfn_total rs by auto + + define ch0 where "ch0 = Cn 4 r_ifeq + [Cn 4 rs [Cn 4 r_snoc [Id 4 1, r_constn 3 0]], + Cn 4 rs [Id 4 1], + ch1, + r_constn 3 0]" + then have ch0_total: "total ch0" "recfn 4 ch0" + using Cn_total prim_recfn_total rs ch1 by auto + + have "eval ch1 [l, v, i, j] \= (if s (e_snoc v 1) = s v then z else 1)" for l v i j + proof - + have "eval ch1 [l, v, i, j] = eval r_ifeq [the (s (e_snoc v 1)), the (s v), z, 1]" + unfolding ch1_def using rs by auto + then show ?thesis by (simp add: s_total option.expand) + qed + moreover have "eval ch0 [l, v, i, j] \= + (if s (e_snoc v 0) = s v then the (eval ch1 [l, v, i, j]) else 0)" for l v i j + proof - + have "eval ch0 [l, v, i, j] = + eval r_ifeq [the (s (e_snoc v 0)), the (s v), the (eval ch1 [l, v, i, j]), 0]" + unfolding ch0_def using rs ch1 by auto + then show ?thesis by (simp add: s_total option.expand) + qed + ultimately have ch0: "\l v i j. eval ch0 [l, v, i, j] \= + (if s (e_snoc v 0) \ s v then 0 + else if s (e_snoc v 1) \ s v then 1 else z)" + by simp + + define app where "app = Cn 4 r_ifz [Id 4 0, Id 4 3, ch0]" + then have "recfn 4 app" "total app" + using ch0_total totalI4 by auto + have "eval app [l, v, i, j] \= (if l = 0 then j else the (eval ch0 [l, v, i, j]))" for l v i j + unfolding app_def using ch0_total by simp + with ch0 have app: "\l v i j. eval app [l, v, i, j] \= + (if l = 0 then j + else if s (e_snoc v 0) \ s v then 0 + else if s (e_snoc v 1) \ s v then 1 else z)" + by simp + + define g where "g = Cn 4 r_snoc [Id 4 1, app]" + with app have g: "\l v i j. eval g [l, v, i, j] \= e_snoc v + (if l = 0 then j + else if s (e_snoc v 0) \ s v then 0 + else if s (e_snoc v 1) \ s v then 1 else z)" + using `recfn 4 app` by auto + from g_def have "recfn 4 g" "total g" + using `recfn 4 app` `total app` Cn_total Mn_free_imp_total by auto + + define b where "b = Pr 2 f g" + then have "recfn 3 b" + using `recfn 2 f` `recfn 4 g` by simp + have b: "eval b [x, i, j] \= list_encode (prefixes z i j x)" for x i j + proof (induction x) + case 0 + then show ?case + unfolding b_def using f `recfn 2 f` \recfn 4 g\ by simp + next + case (Suc x) + then have "eval b [Suc x, i, j] = eval g [x, the (eval b [x, i, j]), i, j]" + using b_def `recfn 3 b` by simp + also have "... \= + (let v = list_encode (prefixes z i j x) + in e_snoc v + (if x = 0 then j + else if s (e_snoc v 0) \ s v then 0 + else if s (e_snoc v 1) \ s v then 1 else z))" + using g Suc by simp + also have "... \= + (let v = list_encode (prefixes z i j x) + in e_snoc v + (if x = 0 then j + else if s (list_encode (prefixes z i j x @ [0])) \ s v then 0 + else if s (list_encode (prefixes z i j x @ [1])) \ s v then 1 else z))" + using list_decode_encode by presburger + finally show ?case by simp + qed + + define b' where "b' = Cn 3 b [Id 3 2, Id 3 0, Id 3 1]" + then have "recfn 3 b'" + using `recfn 3 b` by simp + with b have b': "\i j x. eval b' [i, j, x] \= list_encode (prefixes z i j x)" + using b'_def by simp + + define r where "r = Cn 3 r_last [b']" + then have "recfn 3 r" + using `recfn 3 b'` by simp + with b' have "\i j x. eval r [i, j, x] \= last (prefixes z i j x)" + using r_def prefixes_length by auto + moreover from this have "total r" + using totalI3 `recfn 3 r` by simp + ultimately have "(\i j x. eval r [i, j, x]) = adverse z" + unfolding adverse_def by simp + with `recfn 3 r` `total r` show ?thesis by auto +qed + +lemma adverse_in_R1: "adverse z i j \ \" +proof - + from adverse_in_R3 obtain r where + r: "recfn 3 r" "total r" "(\i j x. eval r [i, j, x]) = adverse z" + by blast + define rij where "rij = Cn 1 r [r_const i, r_const j, Id 1 0]" + then have "recfn 1 rij" "total rij" + using r(1,2) Cn_total Mn_free_imp_total by auto + from rij_def have "\x. eval rij [x] = eval r [i, j, x]" + using r(1) by auto + with r(3) have "\x. eval rij [x] = adverse z i j x" + by metis + with `recfn 1 rij` `total rij` show ?thesis by auto +qed + +text \Next we show that for every $z$ there are $i$, $j$ such that +@{term[names_short] "adverse z i j \ V\<^sub>0\<^sub>1"}. The first step is to show that for every +$z$, Gödel numbers for @{term[names_short] "adverse z i j"} can be computed +uniformly from $i$ and $j$.\ + +lemma phi_translate_adverse: "\f\\\<^sup>2.\i j. \ (the (f i j)) = adverse z i j" +proof - + obtain r where r: "recfn 3 r" "total r" "(\i j x. eval r [i, j, x]) = adverse z" + using adverse_in_R3 by blast + let ?p = "encode r" + define rf where "rf = Cn 2 (r_smn 1 2) [r_dummy 1 (r_const ?p), Id 2 0, Id 2 1]" + then have "recfn 2 rf" and "total rf" + using Mn_free_imp_total by simp_all + define f where "f \ \i j. eval rf [i, j]" + with `recfn 2 rf` `total rf` have "f \ \\<^sup>2" by auto + have rf: "eval rf [i, j] = eval (r_smn 1 2) [?p, i, j]" for i j + unfolding rf_def by simp + { + fix i j x + have "\ (the (f i j)) x = eval r_phi [the (f i j), x]" + using phi_def by simp + also have "... = eval r_phi [the (eval rf [i, j]), x]" + using f_def by simp + also have "... = eval (r_universal 1) [the (eval (r_smn 1 2) [?p, i, j]), x]" + using rf r_phi_def by simp + also have "... = eval (r_universal (2 + 1)) (?p # [i, j] @ [x])" + using smn_lemma[of 1 "[i, j]" 2 "[x]"] by simp + also have "... = eval (r_universal 3) [?p, i, j, x]" + by simp + also have "... = eval r [i, j, x]" + using r_universal r by simp + also have "... = adverse z i j x" + using r(3) by metis + finally have "\ (the (f i j)) x = adverse z i j x" . + } + with `f \ \\<^sup>2` show ?thesis by blast +qed + +text \The second, and final, step is to apply Smullyan's double +fixed-point theorem to show the existence of @{term[names_short] adverse} +functions in @{term "V\<^sub>0\<^sub>1"}.\ + +lemma adverse_in_V01: "\m n. adverse 0 m n \ V\<^sub>0\<^sub>1 \ adverse 1 m n \ V\<^sub>0\<^sub>1" +proof - + obtain f\<^sub>0 where f0: "f\<^sub>0 \ \\<^sup>2" "\i j. \ (the (f\<^sub>0 i j)) = adverse 0 i j" + using phi_translate_adverse[of 0] by auto + obtain f\<^sub>1 where f1: "f\<^sub>1 \ \\<^sup>2" "\i j. \ (the (f\<^sub>1 i j)) = adverse 1 i j" + using phi_translate_adverse[of 1] by auto + obtain m n where "\ m = \ (the (f\<^sub>0 m n))" and "\ n = \ (the (f\<^sub>1 m n))" + using smullyan_double_fixed_point[OF f0(1) f1(1)] by blast + with f0(2) f1(2) have "\ m = adverse 0 m n" and "\ n = adverse 1 m n" + by simp_all + moreover have "the (adverse 0 m n 0) = m" and "the (adverse 1 m n 1) = n" + using adverse_at_01 by simp_all + ultimately have + "\ (the (adverse 0 m n 0)) = adverse 0 m n" + "\ (the (adverse 1 m n 1)) = adverse 1 m n" + by simp_all + moreover have "adverse 0 m n \ \" and "adverse 1 m n \ \" + using adverse_in_R1 by simp_all + ultimately show ?thesis using V01_def by auto +qed + +text \Before we prove the main result of this section we need some +lemmas regarding the shape of the @{term[names_short] adverse} functions and +hypothesis changes of the strategy.\ + +lemma adverse_Suc: + assumes "x > 0" + shows "adverse z i j (Suc x) \= + (if s (e_snoc ((adverse z i j) \ x) 0) \ s ((adverse z i j) \ x) + then 0 + else if s (e_snoc ((adverse z i j) \ x) 1) \ s ((adverse z i j) \ x) + then 1 else z)" +proof - + have "adverse z i j (Suc x) \= + (if s (list_encode (prefixes z i j x @ [0])) \ s (list_encode (prefixes z i j x)) + then 0 + else if s (list_encode (prefixes z i j x @ [1])) \ s (list_encode (prefixes z i j x)) + then 1 else z)" + using assms adverse_def by simp + then show ?thesis by (simp add: init_adverse_eq_prefixes) +qed + +text \The process in the proof sketch (page~\pageref{s:v01_not_total}) +consists of steps (a), (b), and (c). The next abbreviation is true iff.\ step +(a) or (b) applies.\ + +abbreviation "hyp_change z i j x \ + s (e_snoc ((adverse z i j) \ x) 0) \ s ((adverse z i j) \ x) \ + s (e_snoc ((adverse z i j) \ x) 1) \ s ((adverse z i j) \ x)" + +text \If step (c) applies, the process appends $z$.\ + +lemma adverse_Suc_not_hyp_change: + assumes "x > 0" and "\ hyp_change z i j x" + shows "adverse z i j (Suc x) \= z" + using assms adverse_Suc by simp + +text \While (a) or (b) applies, the process appends a value that +forces $S$ to change its hypothesis.\ + +lemma while_hyp_change: + assumes "\x\n. x > 0 \ hyp_change z i j x" + shows "\x\Suc n. adverse z i j x = adverse z' i j x" + using assms +proof (induction n) + case 0 + then show ?case by (simp add: adverse_def le_Suc_eq) +next + case (Suc n) + then have "\x\n. x > 0 \ hyp_change z i j x" by simp + with Suc have "\x\Suc n. x > 0 \ adverse z i j x = adverse z' i j x" + by simp + moreover have "adverse z i j 0 = adverse z' i j 0" + using adverse_at_01 by simp + ultimately have zz': "\x\Suc n. adverse z i j x = adverse z' i j x" + by auto + moreover have "adverse z i j \ \" "adverse z' i j \ \" + using adverse_in_R1 by simp_all + ultimately have init_zz': "(adverse z i j) \ (Suc n) = (adverse z' i j) \ (Suc n)" + using init_eqI by blast + + have "adverse z i j (Suc (Suc n)) = adverse z' i j (Suc (Suc n))" + proof (cases "s (e_snoc ((adverse z i j) \ (Suc n)) 0) \ s ((adverse z i j) \ (Suc n))") + case True + then have "s (e_snoc ((adverse z' i j) \ (Suc n)) 0) \ s ((adverse z' i j) \ (Suc n))" + using init_zz' by simp + then have "adverse z' i j (Suc (Suc n)) \= 0" + by (simp add: adverse_Suc) + moreover have "adverse z i j (Suc (Suc n)) \= 0" + using True by (simp add: adverse_Suc) + ultimately show ?thesis by simp + next + case False + then have "s (e_snoc ((adverse z' i j) \ (Suc n)) 0) = s ((adverse z' i j) \ (Suc n))" + using init_zz' by simp + then have "adverse z' i j (Suc (Suc n)) \= 1" + using init_zz' Suc.prems adverse_Suc by (smt le_refl zero_less_Suc) + moreover have "adverse z i j (Suc (Suc n)) \= 1" + using False Suc.prems adverse_Suc by auto + ultimately show ?thesis by simp + qed + with zz' show ?case using le_SucE by blast +qed + +text \The next result corresponds to Case~1 from the proof sketch.\ + +lemma always_hyp_change_no_lim: + assumes "\x>0. hyp_change z i j x" + shows "\ learn_lim \ {adverse z i j} s" +proof (rule infinite_hyp_changes_not_Lim[of "adverse z i j"]) + show "adverse z i j \ {adverse z i j}" by simp + show "\n. \m\<^sub>1>n. \m\<^sub>2>n. s (adverse z i j \ m\<^sub>1) \ s (adverse z i j \ m\<^sub>2)" + proof + fix n + from assms obtain m\<^sub>1 where m1: "m\<^sub>1 > n" "hyp_change z i j m\<^sub>1" + by auto + have "s (adverse z i j \ m\<^sub>1) \ s (adverse z i j \ (Suc m\<^sub>1))" + proof (cases "s (e_snoc ((adverse z i j) \ m\<^sub>1) 0) \ s ((adverse z i j) \ m\<^sub>1)") + case True + then have "adverse z i j (Suc m\<^sub>1) \= 0" + using m1 adverse_Suc by simp + then have "(adverse z i j) \ (Suc m\<^sub>1) = e_snoc ((adverse z i j) \ m\<^sub>1) 0" + by (simp add: init_Suc_snoc) + with True show ?thesis by simp + next + case False + then have "adverse z i j (Suc m\<^sub>1) \= 1" + using m1 adverse_Suc by simp + then have "(adverse z i j) \ (Suc m\<^sub>1) = e_snoc ((adverse z i j) \ m\<^sub>1) 1" + by (simp add: init_Suc_snoc) + with False m1(2) show ?thesis by simp + qed + then show "\m\<^sub>1>n. \m\<^sub>2>n. s (adverse z i j \ m\<^sub>1) \ s (adverse z i j \ m\<^sub>2)" + using less_SucI m1(1) by blast + qed +qed + +text \The next result corresponds to Case~2 from the proof sketch.\ + +lemma no_hyp_change_no_cons: + assumes "x > 0" and "\ hyp_change z i j x" + shows "\ learn_cons \ {adverse 0 i j, adverse 1 i j} s" +proof - + let ?P = "\x. x > 0 \ \ hyp_change z i j x" + define xmin where "xmin = Least ?P" + with assms have xmin: + "?P xmin" + "\x. x < xmin \ \ ?P x" + using LeastI[of ?P] not_less_Least[of _ ?P] by simp_all + then have "xmin > 0" by simp + + have "\x\xmin - 1. x > 0 \ hyp_change z i j x" + using xmin by (metis One_nat_def Suc_pred le_imp_less_Suc) + then have + "\x\xmin. adverse z i j x = adverse 0 i j x" + "\x\xmin. adverse z i j x = adverse 1 i j x" + using while_hyp_change[of "xmin - 1" z i j 0] + using while_hyp_change[of "xmin - 1" z i j 1] + by simp_all + then have + init_z0: "(adverse z i j) \ xmin = (adverse 0 i j) \ xmin" and + init_z1: "(adverse z i j) \ xmin = (adverse 1 i j) \ xmin" + using adverse_in_R1 init_eqI by blast+ + then have + a0: "adverse 0 i j (Suc xmin) \= 0" and + a1: "adverse 1 i j (Suc xmin) \= 1" + using adverse_Suc_not_hyp_change xmin(1) init_z1 + by metis+ + then have + i0: "(adverse 0 i j) \ (Suc xmin) = e_snoc ((adverse z i j) \ xmin) 0" and + i1: "(adverse 1 i j) \ (Suc xmin) = e_snoc ((adverse z i j) \ xmin) 1" + using init_z0 init_z1 by (simp_all add: init_Suc_snoc) + moreover have + "s (e_snoc ((adverse z i j) \ xmin) 0) = s ((adverse z i j) \ xmin)" + "s (e_snoc ((adverse z i j) \ xmin) 1) = s ((adverse z i j) \ xmin)" + using xmin by simp_all + ultimately have + "s ((adverse 0 i j) \ (Suc xmin)) = s ((adverse z i j) \ xmin)" + "s ((adverse 1 i j) \ (Suc xmin)) = s ((adverse z i j) \ xmin)" + by simp_all + then have + "s ((adverse 0 i j) \ (Suc xmin)) = s ((adverse 1 i j) \ (Suc xmin))" + by simp + moreover have "(adverse 0 i j) \ (Suc xmin) \ (adverse 1 i j) \ (Suc xmin)" + using a0 a1 i0 i1 by (metis append1_eq_conv list_decode_encode zero_neq_one) + ultimately show "\ learn_cons \ {adverse 0 i j, adverse 1 i j} s" + using same_hyp_different_init_not_cons by blast +qed + +text \Combining the previous two lemmas shows that @{term +"V\<^sub>0\<^sub>1"} cannot be learned consistently in the limit by the total +strategy $S$.\ + +lemma V01_not_in_R_cons: "\ learn_cons \ V\<^sub>0\<^sub>1 s" +proof - + obtain m n where + mn0: "adverse 0 m n \ V\<^sub>0\<^sub>1" and + mn1: "adverse 1 m n \ V\<^sub>0\<^sub>1" + using adverse_in_V01 by auto + show "\ learn_cons \ V\<^sub>0\<^sub>1 s" + proof (cases "\x>0. hyp_change 0 m n x") + case True + then have "\ learn_lim \ {adverse 0 m n} s" + using always_hyp_change_no_lim by simp + with mn0 show ?thesis + using learn_cons_def learn_lim_closed_subseteq by auto + next + case False + then obtain x where x: "x > 0" "\ hyp_change 0 m n x" by auto + then have "\ learn_cons \ {adverse 0 m n, adverse 1 m n} s" + using no_hyp_change_no_cons[OF x] by simp + with mn0 mn1 show ?thesis using learn_cons_closed_subseteq by auto + qed +qed + +end + + +subsubsection \@{term "V\<^sub>0\<^sub>1"} is in CONS\ + +text \At first glance, consistently learning @{term "V\<^sub>0\<^sub>1"} looks fairly +easy. After all every @{term "f \ V\<^sub>0\<^sub>1"} provides a Gödel number of itself +either at argument 0 or 1. A strategy only has to figure out which one is +right. However, the strategy $S$ we are going to devise does not always +converge to $f(0)$ or $f(1)$. Instead it uses a technique called +``amalgamation''. The amalgamation of two Gödel numbers $i$ and $j$ is a +function whose value at $x$ is determined by simulating $\varphi_i(x)$ and +$\varphi_j(x)$ in parallel and outputting the value of the first one to halt. +If neither halts the value is undefined. There is a function +$a\in\mathcal{R}^2$ such that $\varphi_{a(i,j)}$ is the amalgamation of $i$ +and $j$. + +If @{term "f \ V\<^sub>0\<^sub>1"} then $\varphi_{a(f(0), f(1))}$ is +total because by definition of @{term "V\<^sub>0\<^sub>1"} we have +$\varphi_{f(0)} = f$ or $\varphi_{f(1)} = f$ and $f$ is total. + +Given a prefix $f^n$ of an @{term "f \ V\<^sub>0\<^sub>1"} the strategy +$S$ first computes $\varphi_{a(f(0), f(1))}(x)$ for $x = 0, \ldots, n$. For +the resulting prefix $\varphi^n_{a(f(0), f(1))}$ there are two cases: +\begin{enumerate} +\item[Case 1.] It differs from $f^n$, say at minimum index $x$. Then for + either $z = 0$ or $z = 1$ we have $\varphi_{f(z)}(x) \neq f(x)$ by + definition of amalgamation. This + implies $\varphi_{f(z)} \neq f$, and thus $\varphi_{f(1-z)} = f$ by + definition of @{term "V\<^sub>0\<^sub>1"}. We set $S(f^n) = f(1 - z)$. This + hypothesis is correct and hence consistent. +\item[Case 2.] It equals $f^n$. Then we set $S(f^n) = a(f(0), f(1))$. This + hypothesis is consistent by definition of this case. +\end{enumerate} + +In both cases the hypothesis is consistent. If Case~1 holds for some $n$, the +same $x$ and $z$ will be found also for all larger values of $n$. Therefore +$S$ converges to the correct hypothesis $f(1 - z)$. If Case~2 holds for all +$n$, then $S$ always outputs the same hypothesis $a(f(0), f(1))$ and thus +also converges. + +The above discussion tacitly assumes $n \geq 1$, such that both $f(0)$ and +$f(1)$ are available to $S$. For $n = 0$ the strategy outputs an arbitrary +consistent hypothesis.\ + +text \Amalgamation uses the concurrent simulation of functions.\ + +definition parallel :: "nat \ nat \ nat \ nat option" where + "parallel i j x \ eval r_parallel [i, j, x]" + +lemma r_parallel': "eval r_parallel [i, j, x] = parallel i j x" + using parallel_def by simp + +lemma r_parallel'': + shows "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ eval r_parallel [i, j, x] \" + and "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval r_phi [i, x]))" + and "eval r_phi [j, x] \ \ eval r_phi [i, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval r_phi [j, x]))" + and "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval r_phi [i, x])) \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval r_phi [j, x]))" +proof - + let ?f = "Cn 1 r_phi [r_const i, Id 1 0]" + let ?g = "Cn 1 r_phi [r_const j, Id 1 0]" + have *: "\x. eval r_phi [i, x] = eval ?f [x]" "\x. eval r_phi [j, x] = eval ?g [x]" + by simp_all + show "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ eval r_parallel [i, j, x] \" + and "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval r_phi [i, x]))" + and "eval r_phi [j, x] \ \ eval r_phi [i, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval r_phi [j, x]))" + and "eval r_phi [i, x] \ \ eval r_phi [j, x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval r_phi [i, x])) \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval r_phi [j, x]))" + using r_parallel[OF *] by simp_all +qed + +lemma parallel: + "\ i x \ \ \ j x \ \ parallel i j x \" + "\ i x \ \ \ j x \ \ parallel i j x \= prod_encode (0, the (\ i x))" + "\ j x \ \ \ i x \ \ parallel i j x \= prod_encode (1, the (\ j x))" + "\ i x \ \ \ j x \ \ + parallel i j x \= prod_encode (0, the (\ i x)) \ + parallel i j x \= prod_encode (1, the (\ j x))" + using phi_def r_parallel'' r_parallel parallel_def by simp_all + +lemma parallel_converg_pdec1_0_or_1: + assumes "parallel i j x \" + shows "pdec1 (the (parallel i j x)) = 0 \ pdec1 (the (parallel i j x)) = 1" + using assms parallel[of i x j] parallel(3)[of j x i] + by (metis fst_eqD option.sel prod_encode_inverse) + +lemma parallel_converg_either: "(\ i x \ \ \ j x \) = (parallel i j x \)" + using parallel by (metis option.simps(3)) + +lemma parallel_0: + assumes "parallel i j x \= prod_encode (0, v)" + shows "\ i x \= v" + using parallel assms + by (smt option.collapse option.sel option.simps(3) prod.inject prod_encode_eq zero_neq_one) + +lemma parallel_1: + assumes "parallel i j x \= prod_encode (1, v)" + shows "\ j x \= v" + using parallel assms + by (smt option.collapse option.sel option.simps(3) prod.inject prod_encode_eq zero_neq_one) + +lemma parallel_converg_V01: + assumes "f \ V\<^sub>0\<^sub>1" + shows "parallel (the (f 0)) (the (f 1)) x \" +proof - + have "f \ \ \ (\ (the (f 0)) = f \ \ (the (f 1)) = f)" + using assms V01_def by auto + then have "\ (the (f 0)) \ \ \ \ (the (f 1)) \ \" + by auto + then have "\ (the (f 0)) x \ \ \ (the (f 1)) x \" + using R1_imp_total1 by auto + then show ?thesis using parallel_converg_either by simp +qed + +text \The amalgamation of two Gödel numbers can then be described +in terms of @{term "parallel"}.\ + +definition amalgamation :: "nat \ nat \ partial1" where + "amalgamation i j x \ + if parallel i j x \ then None else Some (pdec2 (the (parallel i j x)))" + +lemma amalgamation_diverg: "amalgamation i j x \ \ \ i x \ \ \ j x \" + using amalgamation_def parallel by (metis option.simps(3)) + +lemma amalgamation_total: + assumes "total1 (\ i) \ total1 (\ j)" + shows "total1 (amalgamation i j)" + using assms amalgamation_diverg[of i j] total_def by auto + +lemma amalgamation_V01_total: + assumes "f \ V\<^sub>0\<^sub>1" + shows "total1 (amalgamation (the (f 0)) (the (f 1)))" + using assms V01_def amalgamation_total R1_imp_total1 total1_def + by (metis (mono_tags, lifting) mem_Collect_eq) + +definition "r_amalgamation \ Cn 3 r_pdec2 [r_parallel]" + +lemma r_amalgamation_recfn: "recfn 3 r_amalgamation" + unfolding r_amalgamation_def by simp + +lemma r_amalgamation: "eval r_amalgamation [i, j, x] = amalgamation i j x" +proof (cases "parallel i j x \") + case True + then have "eval r_parallel [i, j, x] \" + by (simp add: r_parallel') + then have "eval r_amalgamation [i, j, x] \" + unfolding r_amalgamation_def by simp + moreover from True have "amalgamation i j x \" + using amalgamation_def by simp + ultimately show ?thesis by simp +next + case False + then have "eval r_parallel [i, j, x] \" + by (simp add: r_parallel') + then have "eval r_amalgamation [i, j, x] = eval r_pdec2 [the (eval r_parallel [i, j, x])]" + unfolding r_amalgamation_def by simp + also have "... \= pdec2 (the (eval r_parallel [i, j, x]))" + by simp + finally show ?thesis by (simp add: False amalgamation_def r_parallel') +qed + +text \The function @{term "amalgamate"} computes Gödel numbers of +amalgamations. It corresponds to the function $a$ from the proof sketch.\ + +definition amalgamate :: "nat \ nat \ nat" where + "amalgamate i j \ smn 1 (encode r_amalgamation) [i, j]" + +lemma amalgamate: "\ (amalgamate i j) = amalgamation i j" +proof + fix x + have "\ (amalgamate i j) x = eval r_phi [amalgamate i j, x]" + by (simp add: phi_def) + also have "... = eval r_phi [smn 1 (encode r_amalgamation) [i, j], x]" + using amalgamate_def by simp + also have "... = eval r_phi + [encode (Cn 1 (r_universal 3) + (r_constn 0 (encode r_amalgamation) # map (r_constn 0) [i, j] @ map (Id 1) [0])), x]" + using smn[of 1 "encode r_amalgamation" "[i, j]"] by (simp add: numeral_3_eq_3) + also have "... = eval r_phi + [encode (Cn 1 (r_universal 3) + (r_const (encode r_amalgamation) # [r_const i, r_const j, Id 1 0])), x]" + (is "... = eval r_phi [encode ?f, x]") + by (simp add: r_constn_def) + finally have "\ (amalgamate i j) x = eval r_phi + [encode (Cn 1 (r_universal 3) + (r_const (encode r_amalgamation) # [r_const i, r_const j, Id 1 0])), x]" . + then have "\ (amalgamate i j) x = eval (r_universal 3) [encode r_amalgamation, i, j, x]" + unfolding r_phi_def using r_universal[of ?f 1] r_amalgamation_recfn by simp + then show "\ (amalgamate i j) x = amalgamation i j x" + using r_amalgamation by (simp add: r_amalgamation_recfn r_universal) +qed + +lemma amalgamation_in_P1: "amalgamation i j \ \

" + using amalgamate by (metis P2_proj_P1 phi_in_P2) + +lemma amalgamation_V01_R1: + assumes "f \ V\<^sub>0\<^sub>1" + shows "amalgamation (the (f 0)) (the (f 1)) \ \" + using assms amalgamation_V01_total amalgamation_in_P1 + by (simp add: P1_total_imp_R1) + +definition "r_amalgamate \ + Cn 2 (r_smn 1 2) [r_dummy 1 (r_const (encode r_amalgamation)), Id 2 0, Id 2 1]" + +lemma r_amalgamate_recfn: "recfn 2 r_amalgamate" + unfolding r_amalgamate_def by simp + +lemma r_amalgamate: "eval r_amalgamate [i, j] \= amalgamate i j" +proof - + let ?p = "encode r_amalgamation" + have rs21: "eval (r_smn 1 2) [?p, i, j] \= smn 1 ?p [i, j]" + using r_smn by simp + moreover have "eval r_amalgamate [i, j] = eval (r_smn 1 2) [?p, i, j]" + unfolding r_amalgamate_def by auto + ultimately have "eval r_amalgamate [i, j] \= smn 1 ?p [i, j]" + by simp + then show ?thesis using amalgamate_def by simp +qed + +text \The strategy $S$ distinguishes the two cases from the proof +sketch with the help of the next function, which checks if a hypothesis +$\varphi_i$ is inconsistent with a prefix $e$. If so, it returns the least $x +< |e|$ witnessing the inconsistency; otherwise it returns the length $|e|$. +If $\varphi_i$ diverges for some $x < |e|$, so does the function.\ + +definition inconsist :: partial2 where + "inconsist i e \ + (if \x i x \ then None + else if \x i x \\ e_nth e x + then Some (LEAST x. x < e_length e \ \ i x \\ e_nth e x) + else Some (e_length e))" + +lemma inconsist_converg: + assumes "inconsist i e \" + shows "inconsist i e = + (if \x i x \\ e_nth e x + then Some (LEAST x. x < e_length e \ \ i x \\ e_nth e x) + else Some (e_length e))" + and "\x i x \" + using inconsist_def assms by (presburger, meson) + +lemma inconsist_bounded: + assumes "inconsist i e \" + shows "the (inconsist i e) \ e_length e" +proof (cases "\x i x \\ e_nth e x") + case True + then show ?thesis + using inconsist_converg[OF assms] + by (smt Least_le dual_order.strict_implies_order dual_order.strict_trans2 option.sel) +next + case False + then show ?thesis using inconsist_converg[OF assms] by auto +qed + +lemma inconsist_consistent: + assumes "inconsist i e \" + shows "inconsist i e \= e_length e \ (\x i x \= e_nth e x)" +proof + show "\x i x \= e_nth e x" if "inconsist i e \= e_length e" + proof (cases "\x i x \\ e_nth e x") + case True + then show ?thesis + using that inconsist_converg[OF assms] + by (metis (mono_tags, lifting) not_less_Least option.inject) + next + case False + then show ?thesis + using that inconsist_converg[OF assms] by simp + qed + show "\x i x \= e_nth e x \ inconsist i e \= e_length e" + unfolding inconsist_def using assms by auto +qed + +lemma inconsist_converg_eq: + assumes "inconsist i e \= e_length e" + shows "\x i x \= e_nth e x" + using assms inconsist_consistent by auto + +lemma inconsist_converg_less: + assumes "inconsist i e \" and "the (inconsist i e) < e_length e" + shows "\x i x \\ e_nth e x" + and "inconsist i e \= (LEAST x. x < e_length e \ \ i x \\ e_nth e x)" +proof - + show "\x i x \\ e_nth e x" + using assms by (metis (no_types, lifting) inconsist_converg(1) nat_neq_iff option.sel) + then show "inconsist i e \= (LEAST x. x < e_length e \ \ i x \\ e_nth e x)" + using assms inconsist_converg by presburger +qed + +lemma least_bounded_Suc: + assumes "\x. x < upper \ P x" + shows "(LEAST x. x < upper \ P x) = (LEAST x. x < Suc upper \ P x)" +proof - + let ?Q = "\x. x < upper \ P x" + let ?x = "Least ?Q" + from assms have "?x < upper \ P ?x" + using LeastI_ex[of ?Q] by simp + then have 1: "?x < Suc upper \ P ?x" by simp + from assms have 2: "\y P y" + using Least_le[of ?Q] not_less_Least by fastforce + have "(LEAST x. x < Suc upper \ P x) = ?x" + proof (rule Least_equality) + show "?x < Suc upper \ P ?x" using 1 2 by blast + show "\y. y < Suc upper \ P y \ ?x \ y" + using 1 2 leI by blast + qed + then show ?thesis .. +qed + +lemma least_bounded_gr: + fixes P :: "nat \ bool" and m :: nat + assumes "\x. x < upper \ P x" + shows "(LEAST x. x < upper \ P x) = (LEAST x. x < upper + m \ P x)" +proof (induction m) + case 0 + then show ?case by simp +next + case (Suc m) + moreover have "\x. x < upper + m \ P x" + using assms trans_less_add1 by blast + ultimately show ?case using least_bounded_Suc by simp +qed + +lemma inconsist_init_converg_less: + assumes "f \ \" + and "\ i \ \" + and "inconsist i (f \ n) \" + and "the (inconsist i (f \ n)) < Suc n" + shows "inconsist i (f \ (n + m)) = inconsist i (f \ n)" +proof - + have phi_i_total: "\ i x \" for x + using assms by simp + moreover have f_nth: "f x \= e_nth (f \ n) x" if "x < Suc n" for x n + using that assms(1) by simp + ultimately have "(\ i x \ f x) = (\ i x \\ e_nth (f \ n) x)" if "x < Suc n" for x n + using that by simp + then have cond: "(x < Suc n \ \ i x \ f x) = + (x < e_length (f \ n) \ \ i x \\ e_nth (f \ n) x)" for x n + using length_init by metis + then have + 1: "\x i x \ f x" and + 2: "inconsist i (f \ n) \= (LEAST x. x < Suc n \ \ i x \ f x)" + using assms(3,4) inconsist_converg_less[of i "f \ n"] by simp_all + then have 3: "\x i x \ f x" + using not_add_less1 by fastforce + then have "\x i x \\ e_nth (f \ (n + m)) x" + using cond by blast + then have "\x (n + m)). \ i x \\ e_nth (f \ (n + m)) x" + by simp + moreover have 4: "inconsist i (f \ (n + m)) \" + using assms(2) R1_imp_total1 inconsist_def by simp + ultimately have "inconsist i (f \ (n + m)) \= + (LEAST x. x < e_length (f \ (n + m)) \ \ i x \\ e_nth (f \ (n + m)) x)" + using inconsist_converg[OF 4] by simp + then have 5: "inconsist i (f \ (n + m)) \= (LEAST x. x < Suc (n + m) \ \ i x \ f x)" + using cond[of _ "n + m"] by simp + then have "(LEAST x. x < Suc n \ \ i x \ f x) = + (LEAST x. x < Suc n + m \ \ i x \ f x)" + using least_bounded_gr[where ?upper="Suc n"] 1 3 by simp + then show ?thesis using 2 5 by simp +qed + +definition "r_inconsist \ + let + f = Cn 2 r_length [Id 2 1]; + g = Cn 4 r_ifless + [Id 4 1, + Cn 4 r_length [Id 4 3], + Id 4 1, + Cn 4 r_ifeq + [Cn 4 r_phi [Id 4 2, Id 4 0], + Cn 4 r_nth [Id 4 3, Id 4 0], + Id 4 1, + Id 4 0]] + in Cn 2 (Pr 2 f g) [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]" + +lemma r_inconsist_recfn: "recfn 2 r_inconsist" + unfolding r_inconsist_def by simp + +lemma r_inconsist: "eval r_inconsist [i, e] = inconsist i e" +proof - + define f where "f = Cn 2 r_length [Id 2 1]" + define len where "len = Cn 4 r_length [Id 4 3]" + define nth where "nth = Cn 4 r_nth [Id 4 3, Id 4 0]" + define ph where "ph = Cn 4 r_phi [Id 4 2, Id 4 0]" + define g where + "g = Cn 4 r_ifless [Id 4 1, len, Id 4 1, Cn 4 r_ifeq [ph, nth, Id 4 1, Id 4 0]]" + have "recfn 2 f" + unfolding f_def by simp + have f: "eval f [i, e] \= e_length e" + unfolding f_def by simp + have "recfn 4 len" + unfolding len_def by simp + have len: "eval len [j, v, i, e] \= e_length e" for j v + unfolding len_def by simp + have "recfn 4 nth" + unfolding nth_def by simp + have nth: "eval nth [j, v, i, e] \= e_nth e j" for j v + unfolding nth_def by simp + have "recfn 4 ph" + unfolding ph_def by simp + have ph: "eval ph [j, v, i, e] = \ i j" for j v + unfolding ph_def using phi_def by simp + have "recfn 4 g" + unfolding g_def using `recfn 4 nth` `recfn 4 ph` `recfn 4 len` by simp + have g_diverg: "eval g [j, v, i, e] \" if "eval ph [j, v, i, e] \" for j v + unfolding g_def using that `recfn 4 nth` `recfn 4 ph` `recfn 4 len` by simp + have g_converg: "eval g [j, v, i, e] \= + (if v < e_length e then v else if \ i j \= e_nth e j then v else j)" + if "eval ph [j, v, i, e] \" for j v + unfolding g_def using that `recfn 4 nth` `recfn 4 ph` `recfn 4 len` len nth ph + by auto + define h where "h \ Pr 2 f g" + then have "recfn 3 h" + by (simp add: \recfn 2 f\ \recfn 4 g\) + + let ?invariant = "\j i e. + (if \x i x \ then None + else if \x i x \\ e_nth e x + then Some (LEAST x. x < j \ \ i x \\ e_nth e x) + else Some (e_length e))" + + have "eval h [j, i, e] = ?invariant j i e" if "j \ e_length e" for j + using that + proof (induction j) + case 0 + then show ?case unfolding h_def using `recfn 2 f` f `recfn 4 g` by simp + next + case (Suc j) + then have j_less: "j < e_length e" by simp + then have j_le: "j \ e_length e" by simp + show ?case + proof (cases "eval h [j, i, e] \") + case True + then have "\x i x \" + using j_le Suc.IH by (metis option.simps(3)) + then have "\x i x \" + using less_SucI by blast + moreover have h: "eval h [Suc j, i, e] \" + using True h_def `recfn 3 h` by simp + ultimately show ?thesis by simp + next + case False + with Suc.IH j_le have h_j: "eval h [j, i, e] = + (if \x i x \\ e_nth e x + then Some (LEAST x. x < j \ \ i x \\ e_nth e x) + else Some (e_length e))" + by presburger + then have the_h_j: "the (eval h [j, i, e]) = + (if \x i x \\ e_nth e x + then LEAST x. x < j \ \ i x \\ e_nth e x + else e_length e)" + (is "_ = ?v") + by auto + have h_Suc: "eval h [Suc j, i, e] = eval g [j, the (eval h [j, i, e]), i, e]" + using False h_def `recfn 4 g` `recfn 2 f` by auto + show ?thesis + proof (cases "\ i j \") + case True + with ph g_diverg h_Suc show ?thesis by auto + next + case False + with h_Suc have "eval h [Suc j, i, e] \= + (if ?v < e_length e then ?v + else if \ i j \= e_nth e j then ?v else j)" + (is "_ \= ?lhs") + using g_converg ph the_h_j by simp + moreover have "?invariant (Suc j) i e \= + (if \x i x \\ e_nth e x + then LEAST x. x < Suc j \ \ i x \\ e_nth e x + else e_length e)" + (is "_ \= ?rhs") + proof - + from False have "\ i j \" by simp + moreover have "\ (\x i x \)" + by (metis (no_types, lifting) Suc.IH h_j j_le option.simps(3)) + ultimately have "\ (\x i x \)" + using less_Suc_eq by auto + then show ?thesis by auto + qed + moreover have "?lhs = ?rhs" + proof (cases "?v < e_length e") + case True + then have + ex_j: "\x i x \\ e_nth e x" and + v_eq: "?v = (LEAST x. x < j \ \ i x \\ e_nth e x)" + by presburger+ + with True have "?lhs = ?v" by simp + from ex_j have "\x i x \\ e_nth e x" + using less_SucI by blast + then have "?rhs = (LEAST x. x < Suc j \ \ i x \\ e_nth e x)" by simp + with True v_eq ex_j show ?thesis + using least_bounded_Suc[of j "\x. \ i x \\ e_nth e x"] by simp + next + case False + then have not_ex: "\ (\x i x \\ e_nth e x)" + using Least_le[of "\x. x < j \ \ i x \\ e_nth e x"] j_le + by (smt leD le_less_linear le_trans) + then have "?v = e_length e" by argo + with False have lhs: "?lhs = (if \ i j \= e_nth e j then e_length e else j)" + by simp + show ?thesis + proof (cases "\ i j \= e_nth e j") + case True + then have "\ (\x i x \\ e_nth e x)" + using less_SucE not_ex by blast + then have "?rhs = e_length e" by argo + moreover from True have "?lhs = e_length e" + using lhs by simp + ultimately show ?thesis by simp + next case False + then have "\ i j \\ e_nth e j" + using `\ i j \` by simp + with not_ex have "(LEAST x. x \ i x \\ e_nth e x) = j" + using LeastI[of "\x. x \ i x \\ e_nth e x" j] less_Suc_eq + by blast + then have "?rhs = j" + using \\ i j \\ e_nth e j\ by (meson lessI) + moreover from False lhs have "?lhs = j" by simp + ultimately show ?thesis by simp + qed + qed + ultimately show ?thesis by simp + qed + qed + qed + then have "eval h [e_length e, i, e] = ?invariant (e_length e) i e" + by auto + then have "eval h [e_length e, i, e] = inconsist i e" + using inconsist_def by simp + moreover have "eval (Cn 2 (Pr 2 f g) [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]) [i, e] = + eval h [e_length e, i, e]" + using `recfn 4 g` `recfn 2 f` h_def by auto + ultimately show ?thesis + unfolding r_inconsist_def by (simp add: f_def g_def len_def nth_def ph_def) +qed + +lemma inconsist_for_total: + assumes "total1 (\ i)" + shows "inconsist i e \= + (if \x i x \\ e_nth e x + then LEAST x. x < e_length e \ \ i x \\ e_nth e x + else e_length e)" + unfolding inconsist_def using assms total1_def by (auto; blast) + +lemma inconsist_for_V01: + assumes "f \ V\<^sub>0\<^sub>1" and "k = amalgamate (the (f 0)) (the (f 1))" + shows "inconsist k e \= + (if \x k x \\ e_nth e x + then LEAST x. x < e_length e \ \ k x \\ e_nth e x + else e_length e)" +proof - + have "\ k \ \" + using amalgamation_V01_R1[OF assms(1)] assms(2) amalgamate by simp + then have "total1 (\ k)" by simp + with inconsist_for_total[of k] show ?thesis by simp +qed + +text \The next function computes Gödel numbers of functions consistent +with a given prefix. The strategy will use these as consistent auxiliary +hypotheses when receiving a prefix of length one.\ + +definition "r_auxhyp \ Cn 1 (r_smn 1 1) [r_const (encode r_prenum), Id 1 0]" + +lemma r_auxhyp_prim: "prim_recfn 1 r_auxhyp" + unfolding r_auxhyp_def by simp + +lemma r_auxhyp: "\ (the (eval r_auxhyp [e])) = prenum e" +proof + fix x + let ?p = "encode r_prenum" + let ?p = "encode r_prenum" + have "eval r_auxhyp [e] = eval (r_smn 1 1) [?p, e]" + unfolding r_auxhyp_def by simp + then have "eval r_auxhyp [e] \= smn 1 ?p [e]" + by (simp add: r_smn) + also have "... \= encode (Cn 1 (r_universal (1 + length [e])) + (r_constn (1 - 1) ?p # + map (r_constn (1 - 1)) [e] @ map (recf.Id 1) [0..<1]))" + using smn[of 1 ?p "[e]"] by simp + also have "... \= encode (Cn 1 (r_universal (1 + 1)) + (r_constn 0 ?p # map (r_constn 0) [e] @ [Id 1 0]))" + by simp + also have "... \= encode (Cn 1 (r_universal 2) + (r_constn 0 ?p # map (r_constn 0) [e] @ [Id 1 0]))" + by (metis one_add_one) + also have "... \= encode (Cn 1 (r_universal 2) [r_constn 0 ?p, r_constn 0 e, Id 1 0])" + by simp + also have "... \= encode (Cn 1 (r_universal 2) [r_const ?p, r_const e, Id 1 0])" + using r_constn_def by simp + finally have "eval r_auxhyp [e] \= + encode (Cn 1 (r_universal 2) [r_const ?p, r_const e, Id 1 0])" . + moreover have "\ (the (eval r_auxhyp [e])) x = eval r_phi [the (eval r_auxhyp [e]), x]" + by (simp add: phi_def) + ultimately have "\ (the (eval r_auxhyp [e])) x = + eval r_phi [encode (Cn 1 (r_universal 2) [r_const ?p, r_const e, Id 1 0]), x]" + (is "_ = eval r_phi [encode ?f, x]") + by simp + then have "\ (the (eval r_auxhyp [e])) x = + eval (Cn 1 (r_universal 2) [r_const ?p, r_const e, Id 1 0]) [x]" + using r_phi_def r_universal[of ?f 1 "[x]"] by simp + then have "\ (the (eval r_auxhyp [e])) x = eval (r_universal 2) [?p, e, x]" + by simp + then have "\ (the (eval r_auxhyp [e])) x = eval r_prenum [e, x]" + using r_universal by simp + then show "\ (the (eval r_auxhyp [e])) x = prenum e x" by simp +qed + +definition auxhyp :: partial1 where + "auxhyp e \ eval r_auxhyp [e]" + +lemma auxhyp_prenum: "\ (the (auxhyp e)) = prenum e" + using auxhyp_def r_auxhyp by metis + +lemma auxhyp_in_R1: "auxhyp \ \" + using auxhyp_def Mn_free_imp_total R1I r_auxhyp_prim by metis + +text \Now we can define our consistent learning strategy for @{term "V\<^sub>0\<^sub>1"}.\ + +definition "r_sv01 \ + let + at0 = Cn 1 r_nth [Id 1 0, Z]; + at1 = Cn 1 r_nth [Id 1 0, r_const 1]; + m = Cn 1 r_amalgamate [at0, at1]; + c = Cn 1 r_inconsist [m, Id 1 0]; + p = Cn 1 r_pdec1 [Cn 1 r_parallel [at0, at1, c]]; + g = Cn 1 r_ifeq [c, r_length, m, Cn 1 r_ifz [p, at1, at0]] + in Cn 1 (r_lifz r_auxhyp g) [Cn 1 r_eq [r_length, r_const 1], Id 1 0]" + +lemma r_sv01_recfn: "recfn 1 r_sv01" + unfolding r_sv01_def using r_auxhyp_prim r_inconsist_recfn r_amalgamate_recfn + by (simp add: Let_def) + +definition sv01 :: partial1 ("s\<^bsub>01\<^esub>")where + "sv01 e \ eval r_sv01 [e]" + +lemma sv01_in_P1: "s\<^bsub>01\<^esub> \ \

" + using sv01_def r_sv01_recfn P1I by presburger + +text \We are interested in the behavior of @{term "s\<^bsub>01\<^esub>"} only on +prefixes of functions in @{term "V\<^sub>0\<^sub>1"}. This behavior is linked +to the amalgamation of $f(0)$ and $f(1)$, where $f$ is the function +to be learned.\ + +abbreviation amalg01 :: "partial1 \ nat" where + "amalg01 f \ amalgamate (the (f 0)) (the (f 1))" + +lemma sv01: + assumes "f \ V\<^sub>0\<^sub>1" + shows "s\<^bsub>01\<^esub> (f \ 0) = auxhyp (f \ 0)" + and "n \ 0 \ + inconsist (amalg01 f) (f \ n) \= Suc n \ + s\<^bsub>01\<^esub> (f \ n) \= amalg01 f" + and "n \ 0 \ + the (inconsist (amalg01 f) (f \ n)) < Suc n \ + pdec1 (the (parallel (the (f 0)) (the (f 1)) (the (inconsist (amalg01 f) (f \ n))))) = 0 \ + s\<^bsub>01\<^esub> (f \ n) = f 1" + and "n \ 0 \ + the (inconsist (amalg01 f) (f \ n)) < Suc n \ + pdec1 (the (parallel (the (f 0)) (the (f 1)) (the (inconsist (amalg01 f) (f \ n))))) \ 0 \ + s\<^bsub>01\<^esub> (f \ n) = f 0" +proof - + have f_total: "\x. f x \" + using assms V01_def R1_imp_total1 by blast + define at0 where "at0 = Cn 1 r_nth [Id 1 0, Z]" + define at1 where "at1 = Cn 1 r_nth [Id 1 0, r_const 1]" + define m where "m = Cn 1 r_amalgamate [at0, at1]" + define c where "c = Cn 1 r_inconsist [m, Id 1 0]" + define p where "p = Cn 1 r_pdec1 [Cn 1 r_parallel [at0, at1, c]]" + define g where "g = Cn 1 r_ifeq [c, r_length, m, Cn 1 r_ifz [p, at1, at0]]" + have "recfn 1 g" + unfolding g_def p_def c_def m_def at1_def at0_def + using r_auxhyp_prim r_inconsist_recfn r_amalgamate_recfn + by simp + have "eval (Cn 1 r_eq [r_length, r_const 1]) [f \ 0] \= 0" + by simp + then have "eval r_sv01 [f \ 0] = eval r_auxhyp [f \ 0]" + unfolding r_sv01_def using `recfn 1 g` c_def g_def m_def p_def r_auxhyp_prim + by (auto simp add: Let_def) + then show "s\<^bsub>01\<^esub> (f \ 0) = auxhyp (f \ 0)" + by (simp add: auxhyp_def sv01_def) + + have sv01: "s\<^bsub>01\<^esub> (f \ n) = eval g [f \ n]" if "n \ 0" + proof - + have *: "eval (Cn 1 r_eq [r_length, r_const 1]) [f \ n] \\ 0" + (is "?r_eq \\ 0") + using that by simp + moreover have "recfn 2 (r_lifz r_auxhyp g)" + using `recfn 1 g` r_auxhyp_prim by simp + moreover have "eval r_sv01 [f \ n] = + eval (Cn 1 (r_lifz r_auxhyp g) [Cn 1 r_eq [r_length, r_const 1], Id 1 0]) [f \ n]" + using r_sv01_def by (metis at0_def at1_def c_def g_def m_def p_def) + ultimately have "eval r_sv01 [f \ n] = eval (r_lifz r_auxhyp g) [the ?r_eq, f \ n]" + by simp + then have "eval r_sv01 [f \ n] = eval g [f \ n]" + using "*" \recfn 1 g\ r_auxhyp_prim by auto + then show ?thesis by (simp add: sv01_def that) + qed + + have "recfn 1 at0" + unfolding at0_def by simp + have at0: "eval at0 [f \ n] \= the (f 0)" + unfolding at0_def by simp + have "recfn 1 at1" + unfolding at1_def by simp + have at1: "n \ 0 \ eval at1 [f \ n] \= the (f 1)" + unfolding at1_def by simp + have "recfn 1 m" + unfolding m_def at0_def at1_def using r_amalgamate_recfn by simp + have m: "n \ 0 \ eval m [f \ n] \= amalg01 f" + (is "_ \ _ \= ?m") + unfolding m_def at0_def at1_def + using at0 at1 amalgamate r_amalgamate r_amalgamate_recfn by simp + then have c: "n \ 0 \ eval c [f \ n] = inconsist (amalg01 f) (f \ n)" + (is "_ \ _ = ?c") + unfolding c_def using r_inconsist_recfn `recfn 1 m` r_inconsist by auto + then have c_converg: "n \ 0 \ eval c [f \ n] \" + using inconsist_for_V01[OF assms] by simp + have "recfn 1 c" + unfolding c_def using `recfn 1 m` r_inconsist_recfn by simp + + have par: "n \ 0 \ + eval (Cn 1 r_parallel [at0, at1, c]) [f \ n] = parallel (the (f 0)) (the (f 1)) (the ?c)" + (is "_ \ _ = ?par") + using at0 at1 c c_converg m r_parallel' `recfn 1 at0` `recfn 1 at1` `recfn 1 c` + by simp + with parallel_converg_V01[OF assms] have + par_converg: "n \ 0 \ eval (Cn 1 r_parallel [at0, at1, c]) [f \ n] \" + by simp + then have p_converg: "n \ 0 \ eval p [f \ n] \" + unfolding p_def using at0 at1 c_converg `recfn 1 at0` `recfn 1 at1` `recfn 1 c` + by simp + have p: "n \ 0 \ eval p [f \ n] \= pdec1 (the ?par)" + unfolding p_def + using at0 at1 c_converg `recfn 1 at0` `recfn 1 at1` `recfn 1 c` par par_converg + by simp + have "recfn 1 p" + unfolding p_def using `recfn 1 at0` `recfn 1 at1` `recfn 1 m` `recfn 1 c` + by simp + + let ?r = "Cn 1 r_ifz [p, at1, at0]" + have r: "n \ 0 \ eval ?r [f \ n] = (if pdec1 (the ?par) = 0 then f 1 else f 0)" + using at0 at1 c_converg `recfn 1 at0` `recfn 1 at1` `recfn 1 c` + `recfn 1 m` `recfn 1 p` p f_total + by fastforce + + have g: "n \ 0 \ + eval g [f \ n] \= + (if the ?c = e_length (f \ n) + then ?m else the (eval (Cn 1 r_ifz [p, at1, at0]) [f \ n]))" + unfolding g_def + using `recfn 1 p` `recfn 1 at0` `recfn 1 at1` `recfn 1 c` `recfn 1 m` + p_converg at1 at0 c c_converg m + by simp + { + assume "n \ 0" and "?c \= Suc n" + moreover have "e_length (f \ n) = Suc n" by simp + ultimately have "eval g [f \ n] \= ?m" using g by simp + then show "s\<^bsub>01\<^esub> (f \ n) \= amalg01 f" + using sv01[OF `n \ 0`] by simp + next + assume "n \ 0" and "the ?c < Suc n" and "pdec1 (the ?par) = 0" + with g r f_total have "eval g [f \ n] = f 1" by simp + then show "s\<^bsub>01\<^esub> (f \ n) = f 1" + using sv01[OF `n \ 0`] by simp + next + assume "n \ 0" and "the ?c < Suc n" and "pdec1 (the ?par) \ 0" + with g r f_total have "eval g [f \ n] = f 0" by simp + then show "s\<^bsub>01\<^esub> (f \ n) = f 0" + using sv01[OF `n \ 0`] by simp + } +qed + +text \Part of the correctness of @{term sv01} is convergence on +prefixes of functions in @{term "V\<^sub>0\<^sub>1"}.\ + +lemma sv01_converg_V01: + assumes "f \ V\<^sub>0\<^sub>1" + shows "s\<^bsub>01\<^esub> (f \ n) \" +proof (cases "n = 0") + case True + then show ?thesis + using assms sv01 R1_imp_total1 auxhyp_in_R1 by simp +next + case n_gr_0: False + show ?thesis + proof (cases "inconsist (amalg01 f) (f \ n) \= Suc n") + case True + then show ?thesis + using n_gr_0 assms sv01 by simp + next + case False + then have "the (inconsist (amalg01 f) (f \ n)) < Suc n" + using assms inconsist_bounded inconsist_for_V01 length_init + by (metis (no_types, lifting) le_neq_implies_less option.collapse option.simps(3)) + then show ?thesis + using n_gr_0 assms sv01 R1_imp_total1 total1E V01_def + by (metis (no_types, lifting) mem_Collect_eq) + qed +qed + +text \Another part of the correctness of @{term sv01} is its hypotheses +being consistent on prefixes of functions in @{term "V\<^sub>0\<^sub>1"}.\ + +lemma sv01_consistent_V01: + assumes "f \ V\<^sub>0\<^sub>1" + shows "\x\n. \ (the (s\<^bsub>01\<^esub> (f \ n))) x = f x" +proof (cases "n = 0") + case True + then have "s\<^bsub>01\<^esub> (f \ n) = auxhyp (f \ n)" + using sv01[OF assms] by simp + then have "\ (the (s\<^bsub>01\<^esub> (f \ n))) = prenum (f \ n)" + using auxhyp_prenum by simp + then show ?thesis + using R1_imp_total1 total1E assms by (simp add: V01_def) +next + case n_gr_0: False + let ?m = "amalg01 f" + let ?e = "f \ n" + let ?c = "the (inconsist ?m ?e)" + have c: "inconsist ?m ?e \" + using assms inconsist_for_V01 by blast + show ?thesis + proof (cases "inconsist ?m ?e \= Suc n") + case True + then show ?thesis + using assms n_gr_0 sv01 R1_imp_total1 total1E V01_def is_init_of_def + inconsist_consistent not_initial_imp_not_eq length_init inconsist_converg_eq + by (metis (no_types, lifting) le_imp_less_Suc mem_Collect_eq option.sel) + next + case False + then have less: "the (inconsist ?m ?e) < Suc n" + using c assms inconsist_bounded inconsist_for_V01 length_init + by (metis le_neq_implies_less option.collapse) + then have "the (inconsist ?m ?e) < e_length ?e" + by auto + then have + "\x ?m x \\ e_nth ?e x" + "inconsist ?m ?e \= (LEAST x. x < e_length ?e \ \ ?m x \\ e_nth ?e x)" + (is "_ \= Least ?P") + using inconsist_converg_less[OF c] by simp_all + then have "?P ?c" and "\x. x < ?c \ \ ?P x" + using LeastI_ex[of ?P] not_less_Least[of _ ?P] by (auto simp del: e_nth) + then have "\ ?m ?c \ f ?c" by auto + then have "amalgamation (the (f 0)) (the (f 1)) ?c \ f ?c" + using amalgamate by simp + then have *: "Some (pdec2 (the (parallel (the (f 0)) (the (f 1)) ?c))) \ f ?c" + using amalgamation_def by (metis assms parallel_converg_V01) + let ?p = "parallel (the (f 0)) (the (f 1)) ?c" + show ?thesis + proof (cases "pdec1 (the ?p) = 0") + case True + then have "\ (the (f 0)) ?c \= pdec2 (the ?p)" + using assms parallel_0 parallel_converg_V01 + by (metis option.collapse prod.collapse prod_decode_inverse) + then have "\ (the (f 0)) ?c \ f ?c" + using * by simp + then have "\ (the (f 0)) \ f" by auto + then have "\ (the (f 1)) = f" + using assms V01_def by auto + moreover have "s\<^bsub>01\<^esub> (f \ n) = f 1" + using True less n_gr_0 sv01 assms by simp + ultimately show ?thesis by simp + next + case False + then have "pdec1 (the ?p) = 1" + by (meson assms parallel_converg_V01 parallel_converg_pdec1_0_or_1) + then have "\ (the (f 1)) ?c \= pdec2 (the ?p)" + using assms parallel_1 parallel_converg_V01 + by (metis option.collapse prod.collapse prod_decode_inverse) + then have "\ (the (f 1)) ?c \ f ?c" + using * by simp + then have "\ (the (f 1)) \ f" by auto + then have "\ (the (f 0)) = f" + using assms V01_def by auto + moreover from False less n_gr_0 sv01 assms have "s\<^bsub>01\<^esub> (f \ n) = f 0" + by simp + ultimately show ?thesis by simp + qed + qed +qed + +text \The final part of the correctness is @{term "sv01"} converging +for all functions in @{term "V\<^sub>0\<^sub>1"}.\ + +lemma sv01_limit_V01: + assumes "f \ V\<^sub>0\<^sub>1" + shows "\i. \\<^sup>\n. s\<^bsub>01\<^esub> (f \ n) \= i" +proof (cases "\n>0. s\<^bsub>01\<^esub> (f \ n) \= amalgamate (the (f 0)) (the (f 1))") + case True + then show ?thesis by (meson less_le_trans zero_less_one) +next + case False + then obtain n\<^sub>0 where n0: + "n\<^sub>0 \ 0" + "s\<^bsub>01\<^esub> (f \ n\<^sub>0) \\ amalg01 f" + using \f \ V\<^sub>0\<^sub>1\ sv01_converg_V01 by blast + then have *: "the (inconsist (amalg01 f) (f \ n\<^sub>0)) < Suc n\<^sub>0" + (is "the (inconsist ?m (f \ n\<^sub>0)) < Suc n\<^sub>0") + using assms `n\<^sub>0 \ 0` sv01(2) inconsist_bounded inconsist_for_V01 length_init + by (metis (no_types, lifting) le_neq_implies_less option.collapse option.simps(3)) + moreover have "f \ \" + using assms V01_def by auto + moreover have "\ ?m \ \" + using amalgamate amalgamation_V01_R1 assms by auto + moreover have "inconsist ?m (f \ n\<^sub>0) \" + using inconsist_for_V01 assms by blast + ultimately have **: "inconsist ?m (f \ (n\<^sub>0 + m)) = inconsist ?m (f \ n\<^sub>0)" for m + using inconsist_init_converg_less[of f ?m] by simp + then have "the (inconsist ?m (f \ (n\<^sub>0 + m))) < Suc n\<^sub>0 + m" for m + using * by auto + moreover have + "pdec1 (the (parallel (the (f 0)) (the (f 1)) (the (inconsist ?m (f \ (n\<^sub>0 + m)))))) = + pdec1 (the (parallel (the (f 0)) (the (f 1)) (the (inconsist ?m (f \ n\<^sub>0)))))" + for m + using ** by auto + moreover have "n\<^sub>0 + m \ 0" for m + using `n\<^sub>0 \ 0` by simp + ultimately have "s\<^bsub>01\<^esub> (f \ (n\<^sub>0 + m)) = s\<^bsub>01\<^esub> (f \ n\<^sub>0)" for m + using assms sv01 * \n\<^sub>0 \ 0\ by (metis add_Suc) + moreover define i where "i = s\<^bsub>01\<^esub> (f \ n\<^sub>0)" + ultimately have "\n\n\<^sub>0. s\<^bsub>01\<^esub> (f \ n) = i" + using nat_le_iff_add by auto + then have "\n\n\<^sub>0. s\<^bsub>01\<^esub> (f \ n) \= the i" + using n0(2) by simp + then show ?thesis by auto +qed + +lemma V01_learn_cons: "learn_cons \ V\<^sub>0\<^sub>1 s\<^bsub>01\<^esub>" +proof (rule learn_consI2) + show "environment \ V\<^sub>0\<^sub>1 s\<^bsub>01\<^esub>" + by (simp add: Collect_mono V01_def phi_in_P2 sv01_in_P1 sv01_converg_V01) + show "\f n. f \ V\<^sub>0\<^sub>1 \ \k\n. \ (the (s\<^bsub>01\<^esub> (f \ n))) k = f k" + using sv01_consistent_V01 . + show "\i n\<^sub>0. \n\n\<^sub>0. s\<^bsub>01\<^esub> (f \ n) \= i" if "f \ V\<^sub>0\<^sub>1" for f + using sv01_limit_V01 that by simp +qed + +corollary V01_in_CONS: "V\<^sub>0\<^sub>1 \ CONS" + using V01_learn_cons CONS_def by auto + +text \Now we can show the main result of this section, namely that +there is a consistently learnable class that cannot be learned consistently +by a total strategy. In other words, there is no Lemma~R for CONS.\ + +lemma no_lemma_R_for_CONS: "\U. U \ CONS \ (\ (\s. s \ \ \ learn_cons \ U s))" + using V01_in_CONS V01_not_in_R_cons by auto + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/Partial_Recursive.thy b/thys/Inductive_Inference/Partial_Recursive.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Partial_Recursive.thy @@ -0,0 +1,1914 @@ +chapter \Partial recursive functions\ + +theory Partial_Recursive + imports Main "HOL-Library.Nat_Bijection" +begin + +text \This chapter lays the foundation for Chapter~\ref{c:iirf}. +Essentially it develops recursion theory up to the point of certain +fixed-point theorems. This in turn requires standard results such as the +existence of a universal function and the $s$-$m$-$n$ theorem. Besides these, +the chapter contains some results, mostly regarding decidability and the +Kleene normal form, that are not strictly needed later. They are included as +relatively low-hanging fruits to round off the chapter. + +The formalization of partial recursive functions is very much inspired by the +Universal Turing Machine AFP entry by Xu +et~al.~\cite{Universal_Turing_Machine-AFP}. It models partial recursive +functions as algorithms whose semantics is given by an evaluation function. +This works well for most of this chapter. For the next chapter, however, it +is beneficial to regard partial recursive functions as ``proper'' partial +functions. To that end, Section~\ref{s:alternative} introduces more +conventional and convenient notation for the common special cases of unary +and binary partial recursive functions. + +Especially for the nontrivial proofs I consulted the classical textbook by +Rogers~\cite{Rogers87}, which also partially explains my preferring the +traditional term ``recursive'' to the more modern ``computable''.\ + + +section \Basic definitions\ + + +subsection \Partial recursive functions\ + +text \To represent partial recursive functions we start from the same +datatype as Xu et~al.~\cite{Universal_Turing_Machine-AFP}, more specifically +from Urban's version of the formalization. In fact the datatype @{text recf} +and the function @{text arity} below have been copied verbatim from it.\ + +datatype recf = + Z +| S +| Id nat nat +| Cn nat recf "recf list" +| Pr nat recf recf +| Mn nat recf + +fun arity :: "recf \ nat" where + "arity Z = 1" +| "arity S = 1" +| "arity (Id m n) = m" +| "arity (Cn n f gs) = n" +| "arity (Pr n f g) = Suc n" +| "arity (Mn n f) = n" + +text \Already we deviate from Xu et~al.\ in that we define a +well-formedness predicate for partial recursive functions. Well-formedness +essentially means arity constraints are respected when combining @{typ +recf}s.\ + +fun wellf :: "recf \ bool" where + "wellf Z = True" +| "wellf S = True" +| "wellf (Id m n) = (n < m)" +| "wellf (Cn n f gs) = + (n > 0 \ (\g \ set gs. arity g = n \ wellf g) \ arity f = length gs \ wellf f)" +| "wellf (Pr n f g) = + (arity g = Suc (Suc n) \ arity f = n \ wellf f \ wellf g)" +| "wellf (Mn n f) = (n > 0 \ arity f = Suc n \ wellf f)" + +lemma wellf_arity_nonzero: "wellf f \ arity f > 0" + by (induction f rule: arity.induct) simp_all + +lemma wellf_Pr_arity_greater_1: "wellf (Pr n f g) \ arity (Pr n f g) > 1" + using wellf_arity_nonzero by auto + +text \For the most part of this chapter this is the meaning of ``$f$ +is an $n$-ary partial recursive function'':\ + +abbreviation recfn :: "nat \ recf \ bool" where + "recfn n f \ wellf f \ arity f = n" + +text \Some abbreviations for working with @{typ "nat option"}:\ + +abbreviation divergent :: "nat option \ bool" ("_ \" [50] 50) where + "x \ \ x = None" + +abbreviation convergent :: "nat option \ bool" ("_ \" [50] 50) where + "x \ \ x \ None" + +abbreviation convergent_eq :: "nat option \ nat \ bool" (infix "\=" 50) where + "x \= y \ x = Some y" + +abbreviation convergent_neq :: "nat option \ nat \ bool" (infix "\\" 50) where + "x \\ y \ x \ \ x \ Some y" + +text \In prose the terms ``halt'', ``terminate'', ``converge'', and +``defined'' will be used interchangeably; likewise for ``not halt'', +``diverge'', and ``undefined''. In names of lemmas, the abbreviations @{text +converg} and @{text diverg} will be used consistently.\ + +text \Our second major deviation from Xu +et~al.~\cite{Universal_Turing_Machine-AFP} is that we model the semantics of +a @{typ recf} by combining the value and the termination of a function into +one evaluation function with codomain @{typ "nat option"}, rather than +separating both aspects into an evaluation function with codomain @{typ nat} +and a termination predicate. + +The value of a well-formed partial recursive function applied to a +correctly-sized list of arguments:\ + +fun eval_wellf :: "recf \ nat list \ nat option" where + "eval_wellf Z xs \= 0" +| "eval_wellf S xs \= Suc (xs ! 0)" +| "eval_wellf (Id m n) xs \= xs ! n" +| "eval_wellf (Cn n f gs) xs = + (if \g \ set gs. eval_wellf g xs \ + then eval_wellf f (map (\g. the (eval_wellf g xs)) gs) + else None)" +| "eval_wellf (Pr n f g) [] = undefined" +| "eval_wellf (Pr n f g) (0 # xs) = eval_wellf f xs" +| "eval_wellf (Pr n f g) (Suc x # xs) = + Option.bind (eval_wellf (Pr n f g) (x # xs)) (\v. eval_wellf g (x # v # xs))" +| "eval_wellf (Mn n f) xs = + (let E = \z. eval_wellf f (z # xs) + in if \z. E z \= 0 \ (\y) + then Some (LEAST z. E z \= 0 \ (\y)) + else None)" + +text \We define a function value only if the @{typ recf} is well-formed +and its arity matches the number of arguments.\ + +definition eval :: "recf \ nat list \ nat option" where + "recfn (length xs) f \ eval f xs \ eval_wellf f xs" + +lemma eval_Z [simp]: "eval Z [x] \= 0" + by (simp add: eval_def) + +lemma eval_Z' [simp]: "length xs = 1 \ eval Z xs \= 0" + by (simp add: eval_def) + +lemma eval_S [simp]: "eval S [x] \= Suc x" + by (simp add: eval_def) + +lemma eval_S' [simp]: "length xs = 1 \ eval S xs \= Suc (hd xs)" + using eval_def hd_conv_nth[of xs] by fastforce + +lemma eval_Id [simp]: + assumes "n < m" and "m = length xs" + shows "eval (Id m n) xs \= xs ! n" + using assms by (simp add: eval_def) + +lemma eval_Cn [simp]: + assumes "recfn (length xs) (Cn n f gs)" + shows "eval (Cn n f gs) xs = + (if \g\set gs. eval g xs \ + then eval f (map (\g. the (eval g xs)) gs) + else None)" +proof - + have "eval (Cn n f gs) xs = eval_wellf (Cn n f gs) xs" + using assms eval_def by blast + moreover have "\g. g \ set gs \ eval_wellf g xs = eval g xs" + using assms eval_def by simp + ultimately have "eval (Cn n f gs) xs = + (if \g\set gs. eval g xs \ + then eval_wellf f (map (\g. the (eval g xs)) gs) + else None)" + using map_eq_conv[of "\g. the (eval_wellf g xs)" gs "\g. the (eval g xs)"] + by (auto, metis) + moreover have "\ys. length ys = length gs \ eval f ys = eval_wellf f ys" + using assms eval_def by simp + ultimately show ?thesis by auto +qed + +lemma eval_Pr_0 [simp]: + assumes "recfn (Suc n) (Pr n f g)" and "n = length xs" + shows "eval (Pr n f g) (0 # xs) = eval f xs" + using assms by (simp add: eval_def) + +lemma eval_Pr_diverg_Suc [simp]: + assumes "recfn (Suc n) (Pr n f g)" + and "n = length xs" + and "eval (Pr n f g) (x # xs) \" + shows "eval (Pr n f g) (Suc x # xs) \" + using assms by (simp add: eval_def) + +lemma eval_Pr_converg_Suc [simp]: + assumes "recfn (Suc n) (Pr n f g)" + and "n = length xs" + and "eval (Pr n f g) (x # xs) \" + shows "eval (Pr n f g) (Suc x # xs) = eval g (x # the (eval (Pr n f g) (x # xs)) # xs)" + using assms eval_def by auto + +lemma eval_Pr_diverg_add: + assumes "recfn (Suc n) (Pr n f g)" + and "n = length xs" + and "eval (Pr n f g) (x # xs) \" + shows "eval (Pr n f g) ((x + y) # xs) \" + using assms by (induction y) auto + +lemma eval_Pr_converg_le: + assumes "recfn (Suc n) (Pr n f g)" + and "n = length xs" + and "eval (Pr n f g) (x # xs) \" + and "y \ x" + shows "eval (Pr n f g) (y # xs) \" + using assms eval_Pr_diverg_add le_Suc_ex by metis + +lemma eval_Pr_Suc_converg: + assumes "recfn (Suc n) (Pr n f g)" + and "n = length xs" + and "eval (Pr n f g) (Suc x # xs) \" + shows "eval g (x # (the (eval (Pr n f g) (x # xs))) # xs) \" + and "eval (Pr n f g) (Suc x # xs) = eval g (x # the (eval (Pr n f g) (x # xs)) # xs)" + using eval_Pr_converg_Suc[of n f g xs x, OF assms(1,2)] + eval_Pr_converg_le[of n f g xs "Suc x" x, OF assms] assms(3) + by simp_all + +lemma eval_Mn [simp]: + assumes "recfn (length xs) (Mn n f)" + shows "eval (Mn n f) xs = + (if (\z. eval f (z # xs) \= 0 \ (\y)) + then Some (LEAST z. eval f (z # xs) \= 0 \ (\y)) + else None)" + using assms eval_def by auto + +text \For $\mu$-recursion, the condition @{term "(\y)"} +inside @{text LEAST} in the definition of @{term eval_wellf} is redundant.\ + +lemma eval_wellf_Mn: + "eval_wellf (Mn n f) xs = + (if (\z. eval_wellf f (z # xs) \= 0 \ (\y)) + then Some (LEAST z. eval_wellf f (z # xs) \= 0) + else None)" +proof - + let ?P = "\z. eval_wellf f (z # xs) \= 0 \ (\y)" + { + assume "\z. ?P z" + moreover define z where "z = Least ?P" + ultimately have "?P z" + using LeastI[of ?P] by blast + have "(LEAST z. eval_wellf f (z # xs) \= 0) = z" + proof (rule Least_equality) + show "eval_wellf f (z # xs) \= 0" + using `?P z` by simp + show "z \ y" if "eval_wellf f (y # xs) \= 0" for y + proof (rule ccontr) + assume "\ z \ y" + then have "y < z" by simp + moreover from this have "?P y" + using that `?P z` by simp + ultimately show False + using that not_less_Least z_def by blast + qed + qed + } + then show ?thesis by simp +qed + +lemma eval_Mn': + assumes "recfn (length xs) (Mn n f)" + shows "eval (Mn n f) xs = + (if (\z. eval f (z # xs) \= 0 \ (\y)) + then Some (LEAST z. eval f (z # xs) \= 0) + else None)" + using assms eval_def eval_wellf_Mn by auto + +text \Proving that $\mu$-recursion converges is easier if one does not +have to deal with @{text LEAST} directly.\ + +lemma eval_Mn_convergI: + assumes "recfn (length xs) (Mn n f)" + and "eval f (z # xs) \= 0" + and "\y. y < z \ eval f (y # xs) \\ 0" + shows "eval (Mn n f) xs \= z" +proof - + let ?P = "\z. eval f (z # xs) \= 0 \ (\y)" + have "z = Least ?P" + using Least_equality[of ?P z] assms(2,3) not_le_imp_less by blast + moreover have "?P z" using assms(2,3) by simp + ultimately show "eval (Mn n f) xs \= z" + using eval_Mn[OF assms(1)] by meson +qed + +text \Similarly, reasoning from a $\mu$-recursive function is +simplified somewhat by the next lemma.\ + +lemma eval_Mn_convergE: + assumes "recfn (length xs) (Mn n f)" and "eval (Mn n f) xs \= z" + shows "z = (LEAST z. eval f (z # xs) \= 0 \ (\y))" + and "eval f (z # xs) \= 0" + and "\y. y < z \ eval f (y # xs) \\ 0" +proof - + let ?P = "\z. eval f (z # xs) \= 0 \ (\y)" + show "z = Least ?P" + using assms eval_Mn[OF assms(1)] + by (metis (no_types, lifting) option.inject option.simps(3)) + moreover have "\z. ?P z" + using assms eval_Mn[OF assms(1)] by (metis option.distinct(1)) + ultimately have "?P z" + using LeastI[of ?P] by blast + then have "eval f (z # xs) \= 0 \ (\y)" + by simp + then show "eval f (z # xs) \= 0" by simp + show "\y. y < z \ eval f (y # xs) \\ 0" + using not_less_Least[of _ ?P] `z = Least ?P` `?P z` less_trans by blast +qed + +lemma eval_Mn_diverg: + assumes "recfn (length xs) (Mn n f)" + shows "\ (\z. eval f (z # xs) \= 0 \ (\y)) \ eval (Mn n f) xs \" + using assms eval_Mn[OF assms(1)] by simp + + +subsection \Extensional equality\ + +definition exteq :: "recf \ recf \ bool" (infix "\" 55) where + "f \ g \ arity f = arity g \ (\xs. length xs = arity f \ eval f xs = eval g xs)" + +lemma exteq_refl: "f \ f" + using exteq_def by simp + +lemma exteq_sym: "f \ g \ g \ f" + using exteq_def by simp + +lemma exteq_trans: "f \ g \ g \ h \ f \ h" + using exteq_def by simp + +lemma exteqI: + assumes "arity f = arity g" and "\xs. length xs = arity f \ eval f xs = eval g xs" + shows "f \ g" + using assms exteq_def by simp + +lemma exteqI1: + assumes "arity f = 1" and "arity g = 1" and "\x. eval f [x] = eval g [x]" + shows "f \ g" + using assms exteqI by (metis One_nat_def Suc_length_conv length_0_conv) + +text \For every partial recursive function @{term f} there are +infinitely many extensionally equal ones, for example, those that wrap @{term +f} arbitrarily often in the identity function.\ + +fun wrap_Id :: "recf \ nat \ recf" where + "wrap_Id f 0 = f" +| "wrap_Id f (Suc n) = Cn (arity f) (Id 1 0) [wrap_Id f n]" + +lemma recfn_wrap_Id: "recfn a f \ recfn a (wrap_Id f n)" + using wellf_arity_nonzero by (induction n) auto + +lemma exteq_wrap_Id: "recfn a f \ f \ wrap_Id f n" +proof (induction n) + case 0 + then show ?case by (simp add: exteq_refl) +next + case (Suc n) + have "wrap_Id f n \ wrap_Id f (Suc n) " + proof (rule exteqI) + show "arity (wrap_Id f n) = arity (wrap_Id f (Suc n))" + using Suc by (simp add: recfn_wrap_Id) + show "eval (wrap_Id f n) xs = eval (wrap_Id f (Suc n)) xs" + if "length xs = arity (wrap_Id f n)" for xs + proof - + have "recfn (length xs) (Cn (arity f) (Id 1 0) [wrap_Id f n])" + using that Suc recfn_wrap_Id by (metis wrap_Id.simps(2)) + then show "eval (wrap_Id f n) xs = eval (wrap_Id f (Suc n)) xs" + by auto + qed + qed + then show ?case using Suc exteq_trans by fast +qed + +fun depth :: "recf \ nat" where + "depth Z = 0" +| "depth S = 0" +| "depth (Id m n) = 0" +| "depth (Cn n f gs) = Suc (max (depth f) (Max (set (map depth gs))))" +| "depth (Pr n f g) = Suc (max (depth f) (depth g))" +| "depth (Mn n f) = Suc (depth f)" + +lemma depth_wrap_Id: "recfn a f \ depth (wrap_Id f n) = depth f + n" + by (induction n) simp_all + +lemma wrap_Id_injective: + assumes "recfn a f" and "wrap_Id f n\<^sub>1 = wrap_Id f n\<^sub>2" + shows "n\<^sub>1 = n\<^sub>2" + using assms by (metis add_left_cancel depth_wrap_Id) + +lemma exteq_infinite: + assumes "recfn a f" + shows "infinite {g. recfn a g \ g \ f}" (is "infinite ?R") +proof - + have "inj (wrap_Id f)" + using wrap_Id_injective `recfn a f` by (meson inj_onI) + then have "infinite (range (wrap_Id f))" + using finite_imageD by blast + moreover have "range (wrap_Id f) \ ?R" + using assms exteq_sym exteq_wrap_Id recfn_wrap_Id by blast + ultimately show ?thesis by (simp add: infinite_super) +qed + + +subsection \Primitive recursive and total functions\ + +fun Mn_free :: "recf \ bool" where + "Mn_free Z = True" +| "Mn_free S = True" +| "Mn_free (Id m n) = True" +| "Mn_free (Cn n f gs) = ((\g \ set gs. Mn_free g) \ Mn_free f)" +| "Mn_free (Pr n f g) = (Mn_free f \ Mn_free g)" +| "Mn_free (Mn n f) = False" + +text \This is our notion of $n$-ary primitive recursive function:\ + +abbreviation prim_recfn :: "nat \ recf \ bool" where + "prim_recfn n f \ recfn n f \ Mn_free f" + +definition total :: "recf \ bool" where + "total f \ \xs. length xs = arity f \ eval f xs \" + +lemma totalI [intro]: + assumes "\xs. length xs = arity f \ eval f xs \" + shows "total f" + using assms total_def by simp + +lemma totalE [simp]: + assumes "total f" and "recfn n f" and "length xs = n" + shows "eval f xs \" + using assms total_def by simp + +lemma totalI1 : + assumes "recfn 1 f" and "\x. eval f [x] \" + shows "total f" + using assms totalI[of f] by (metis One_nat_def length_0_conv length_Suc_conv) + +lemma totalI2: + assumes "recfn 2 f" and "\x y. eval f [x, y] \" + shows "total f" + using assms totalI[of f] by (smt length_0_conv length_Suc_conv numeral_2_eq_2) + +lemma totalI3: + assumes "recfn 3 f" and "\x y z. eval f [x, y, z] \" + shows "total f" + using assms totalI[of f] by (smt length_0_conv length_Suc_conv numeral_3_eq_3) + +lemma totalI4: + assumes "recfn 4 f" and "\w x y z. eval f [w, x, y, z] \" + shows "total f" +proof (rule totalI[of f]) + fix xs :: "nat list" + assume "length xs = arity f" + then have "length xs = Suc (Suc (Suc (Suc 0)))" + using assms(1) by simp + then obtain w x y z where "xs = [w, x, y, z]" + by (smt Suc_length_conv length_0_conv) + then show "eval f xs \" using assms(2) by simp +qed + +lemma Mn_free_imp_total [intro]: + assumes "wellf f" and "Mn_free f" + shows "total f" + using assms +proof (induction f rule: Mn_free.induct) + case (5 n f g) + have "eval (Pr n f g) (x # xs) \" if "length (x # xs) = arity (Pr n f g)" for x xs + using 5 that by (induction x) auto + then show ?case by (metis arity.simps(5) length_Suc_conv totalI) +qed (auto simp add: total_def eval_def) + +lemma prim_recfn_total: "prim_recfn n f \ total f" + using Mn_free_imp_total by simp + +lemma eval_Pr_prim_Suc: + assumes "h = Pr n f g" and "prim_recfn (Suc n) h" and "length xs = n" + shows "eval h (Suc x # xs) = eval g (x # the (eval h (x # xs)) # xs)" + using assms eval_Pr_converg_Suc prim_recfn_total by simp + +lemma Cn_total: + assumes "\g\set gs. total g" and "total f" and "recfn n (Cn n f gs)" + shows "total (Cn n f gs)" + using assms by (simp add: totalI) + +lemma Pr_total: + assumes "total f" and "total g" and "recfn (Suc n) (Pr n f g)" + shows "total (Pr n f g)" +proof - + have "eval (Pr n f g) (x # xs) \" if "length xs = n" for x xs + using that assms by (induction x) auto + then show ?thesis + using assms(3) totalI by (metis Suc_length_conv arity.simps(5)) +qed + +lemma eval_Mn_total: + assumes "recfn (length xs) (Mn n f)" and "total f" + shows "eval (Mn n f) xs = + (if (\z. eval f (z # xs) \= 0) + then Some (LEAST z. eval f (z # xs) \= 0) + else None)" + using assms by auto + + +section \Simple functions\ + +text \This section, too, bears some similarity to Urban's formalization +in Xu et~al.~\cite{Universal_Turing_Machine-AFP}, but is more minimalistic in +scope. + +As a general naming rule, instances of @{typ recf} and functions +returning such instances get names starting with @{text r_}. Typically, for +an @{text r_xyz} there will be a lemma @{text r_xyz_recfn} or @{text +r_xyz_prim} establishing its (primitive) recursiveness, arity, and +well-formedness. Moreover there will be a lemma @{text r_xyz} describing its +semantics, for which we will sometimes introduce an Isabelle function @{text +xyz}.\ + + +subsection \Manipulating parameters\ + +text \Appending dummy parameters:\ + +definition r_dummy :: "nat \ recf \ recf" where + "r_dummy n f \ Cn (arity f + n) f (map (\i. Id (arity f + n) i) [0.. prim_recfn (a + n) (r_dummy n f)" + using wellf_arity_nonzero by (auto simp add: r_dummy_def) + +lemma r_dummy_recfn [simp]: + "recfn a f \ recfn (a + n) (r_dummy n f)" + using wellf_arity_nonzero by (auto simp add: r_dummy_def) + +lemma r_dummy [simp]: + "r_dummy n f = Cn (arity f + n) f (map (\i. Id (arity f + n) i) [0..= xs ! i" if "i < arity f" for i + using that assms by (simp add: nth_append) + ultimately have "map (\g. the (eval_wellf g (xs @ ys))) ?gs = xs" + by (metis (no_types, lifting) assms(1) length_map nth_equalityI nth_map option.sel) + moreover have "\g \ set ?gs. eval_wellf g (xs @ ys) \" + using * by simp + moreover have "recfn (length (xs @ ys)) ?r" + using assms r_dummy_recfn by fastforce + ultimately show ?thesis + by (auto simp add: assms eval_def) +qed + +text \Shrinking a binary function to a unary one is useful when we want +to define a unary function via the @{term Pr} operation, which can only +construct @{typ recf}s of arity two or higher.\ + +definition r_shrink :: "recf \ recf" where + "r_shrink f \ Cn 1 f [Id 1 0, Id 1 0]" + +lemma r_shrink_prim [simp]: "prim_recfn 2 f \ prim_recfn 1 (r_shrink f)" + by (simp add: r_shrink_def) + +lemma r_shrink_recfn [simp]: "recfn 2 f \ recfn 1 (r_shrink f)" + by (simp add: r_shrink_def) + +lemma r_shrink [simp]: "recfn 2 f \ eval (r_shrink f) [x] = eval f [x, x]" + by (simp add: r_shrink_def) + +definition r_swap :: "recf \ recf" where + "r_swap f \ Cn 2 f [Id 2 1, Id 2 0]" + +lemma r_swap_recfn [simp]: "recfn 2 f \ recfn 2 (r_swap f)" + by (simp add: r_swap_def) + +lemma r_swap_prim [simp]: "prim_recfn 2 f \ prim_recfn 2 (r_swap f)" + by (simp add: r_swap_def) + +lemma r_swap [simp]: "recfn 2 f \ eval (r_swap f) [x, y] = eval f [y, x]" + by (simp add: r_swap_def) + +text \Prepending one dummy parameter:\ + +definition r_shift :: "recf \ recf" where + "r_shift f \ Cn (Suc (arity f)) f (map (\i. Id (Suc (arity f)) (Suc i)) [0.. prim_recfn (Suc a) (r_shift f)" + by (simp add: r_shift_def) + +lemma r_shift_recfn [simp]: "recfn a f \ recfn (Suc a) (r_shift f)" + by (simp add: r_shift_def) + +lemma r_shift [simp]: + assumes "recfn (length xs) f" + shows "eval (r_shift f) (x # xs) = eval f xs" +proof - + let ?r = "r_shift f" + let ?gs = "map (\i. Id (Suc (arity f)) (Suc i)) [0..= xs ! i" if "i < arity f" for i + using assms nth_append that by simp + ultimately have "map (\g. the (eval g (x # xs))) ?gs = xs" + by (metis (no_types, lifting) assms length_map nth_equalityI nth_map option.sel) + moreover have "\g \ set ?gs. eval g (x # xs) \ None" + using * by simp + ultimately show ?thesis using r_shift_def assms by simp +qed + + +subsection \Arithmetic and logic\ + +text \The unary constants:\ + +fun r_const :: "nat \ recf" where + "r_const 0 = Z" +| "r_const (Suc c) = Cn 1 S [r_const c]" + +lemma r_const_prim [simp]: "prim_recfn 1 (r_const c)" + by (induction c) (simp_all) + +lemma r_const [simp]: "eval (r_const c) [x] \= c" + by (induction c) simp_all + +text \Constants of higher arities:\ + +definition "r_constn n c \ if n = 0 then r_const c else r_dummy n (r_const c)" + +lemma r_constn_prim [simp]: "prim_recfn (Suc n) (r_constn n c)" + unfolding r_constn_def by simp + +lemma r_constn [simp]: "length xs = Suc n \ eval (r_constn n c) xs \= c" + unfolding r_constn_def + by simp (metis length_0_conv length_Suc_conv r_const) + +text \We introduce addition, subtraction, and multiplication, but +interestingly enough we can make do without division.\ + +definition "r_add \ Pr 1 (Id 1 0) (Cn 3 S [Id 3 1])" + +lemma r_add_prim [simp]: "prim_recfn 2 r_add" + by (simp add: r_add_def) + +lemma r_add [simp]: "eval r_add [a, b] \= a + b" + unfolding r_add_def by (induction a) simp_all + +definition "r_mul \ Pr 1 Z (Cn 3 r_add [Id 3 1, Id 3 2])" + +lemma r_mul_prim [simp]: "prim_recfn 2 r_mul" + unfolding r_mul_def by simp + +lemma r_mul [simp]: "eval r_mul [a, b] \= a * b" + unfolding r_mul_def by (induction a) simp_all + +definition "r_dec \ Cn 1 (Pr 1 Z (Id 3 0)) [Id 1 0, Id 1 0]" + +lemma r_dec_prim [simp]: "prim_recfn 1 r_dec" + by (simp add: r_dec_def) + +lemma r_dec [simp]: "eval r_dec [a] \= a - 1" +proof - + have "eval (Pr 1 Z (Id 3 0)) [x, y] \= x - 1" for x y + by (induction x) simp_all + then show ?thesis by (simp add: r_dec_def) +qed + +definition "r_sub \ r_swap (Pr 1 (Id 1 0) (Cn 3 r_dec [Id 3 1]))" + +lemma r_sub_prim [simp]: "prim_recfn 2 r_sub" + unfolding r_sub_def by simp + +lemma r_sub [simp]: "eval r_sub [a, b] \= a - b" +proof - + have "eval (Pr 1 (Id 1 0) (Cn 3 r_dec [Id 3 1])) [x, y] \= y - x" for x y + by (induction x) simp_all + then show ?thesis unfolding r_sub_def by simp +qed + +definition "r_sign \ r_shrink (Pr 1 Z (r_constn 2 1))" + +lemma r_sign_prim [simp]: "prim_recfn 1 r_sign" + unfolding r_sign_def by simp + +lemma r_sign [simp]: "eval r_sign [x] \= (if x = 0 then 0 else 1)" +proof - + have "eval (Pr 1 Z (r_constn 2 1)) [x, y] \= (if x = 0 then 0 else 1)" for x y + by (induction x) simp_all + then show ?thesis unfolding r_sign_def by simp +qed + +text \In the logical functions, true will be represented by zero, and +false will be represented by non-zero as argument and by one as +result.\ + +definition "r_not \ Cn 1 r_sub [r_const 1, r_sign]" + +lemma r_not_prim [simp]: "prim_recfn 1 r_not" + unfolding r_not_def by simp + +lemma r_not [simp]: "eval r_not [x] \= (if x = 0 then 1 else 0)" + unfolding r_not_def by simp + +definition "r_nand \ Cn 2 r_not [r_add]" + +lemma r_nand_prim [simp]: "prim_recfn 2 r_nand" + unfolding r_nand_def by simp + +lemma r_nand [simp]: "eval r_nand [x, y] \= (if x = 0 \ y = 0 then 1 else 0)" + unfolding r_nand_def by simp + +definition "r_and \ Cn 2 r_not [r_nand]" + +lemma r_and_prim [simp]: "prim_recfn 2 r_and" + unfolding r_and_def by simp + +lemma r_and [simp]: "eval r_and [x, y] \= (if x = 0 \ y = 0 then 0 else 1)" + unfolding r_and_def by simp + +definition "r_or \ Cn 2 r_sign [r_mul]" + +lemma r_or_prim [simp]: "prim_recfn 2 r_or" + unfolding r_or_def by simp + +lemma r_or [simp]: "eval r_or [x, y] \= (if x = 0 \ y = 0 then 0 else 1)" + unfolding r_or_def by simp + + +subsection \Comparison and conditions\ + +definition "r_ifz \ + let ifzero = (Cn 3 r_mul [r_dummy 2 r_not, Id 3 1]); + ifnzero = (Cn 3 r_mul [r_dummy 2 r_sign, Id 3 2]) + in Cn 3 r_add [ifzero, ifnzero]" + +lemma r_ifz_prim [simp]: "prim_recfn 3 r_ifz" + unfolding r_ifz_def by simp + +lemma r_ifz [simp]: "eval r_ifz [cond, val0, val1] \= (if cond = 0 then val0 else val1)" + unfolding r_ifz_def by (simp add: Let_def) + +definition "r_eq \ Cn 2 r_sign [Cn 2 r_add [r_sub, r_swap r_sub]]" + +lemma r_eq_prim [simp]: "prim_recfn 2 r_eq" + unfolding r_eq_def by simp + +lemma r_eq [simp]: "eval r_eq [x, y] \= (if x = y then 0 else 1)" + unfolding r_eq_def by simp + +definition "r_ifeq \ Cn 4 r_ifz [r_dummy 2 r_eq, Id 4 2, Id 4 3]" + +lemma r_ifeq_prim [simp]: "prim_recfn 4 r_ifeq" + unfolding r_ifeq_def by simp + +lemma r_ifeq [simp]: "eval r_ifeq [a, b, v\<^sub>0, v\<^sub>1] \= (if a = b then v\<^sub>0 else v\<^sub>1)" + unfolding r_ifeq_def using r_dummy_append[of r_eq "[a, b]" "[v\<^sub>0, v\<^sub>1]" 2] + by simp + +definition "r_neq \ Cn 2 r_not [r_eq]" + +lemma r_neq_prim [simp]: "prim_recfn 2 r_neq" + unfolding r_neq_def by simp + +lemma r_neq [simp]: "eval r_neq [x, y] \= (if x = y then 1 else 0)" + unfolding r_neq_def by simp + +definition "r_ifle \ Cn 4 r_ifz [r_dummy 2 r_sub, Id 4 2, Id 4 3]" + +lemma r_ifle_prim [simp]: "prim_recfn 4 r_ifle" + unfolding r_ifle_def by simp + +lemma r_ifle [simp]: "eval r_ifle [a, b, v\<^sub>0, v\<^sub>1] \= (if a \ b then v\<^sub>0 else v\<^sub>1)" + unfolding r_ifle_def using r_dummy_append[of r_sub "[a, b]" "[v\<^sub>0, v\<^sub>1]" 2] + by simp + +definition "r_ifless \ Cn 4 r_ifle [Id 4 1, Id 4 0, Id 4 3, Id 4 2]" + +lemma r_ifless_prim [simp]: "prim_recfn 4 r_ifless" + unfolding r_ifless_def by simp + +lemma r_ifless [simp]: "eval r_ifless [a, b, v\<^sub>0, v\<^sub>1] \= (if a < b then v\<^sub>0 else v\<^sub>1)" + unfolding r_ifless_def by simp + +definition "r_less \ Cn 2 r_ifle [Id 2 1, Id 2 0, r_constn 1 1, r_constn 1 0]" + +lemma r_less_prim [simp]: "prim_recfn 2 r_less" + unfolding r_less_def by simp + +lemma r_less [simp]: "eval r_less [x, y] \= (if x < y then 0 else 1)" + unfolding r_less_def by simp + +definition "r_le \ Cn 2 r_ifle [Id 2 0, Id 2 1, r_constn 1 0, r_constn 1 1]" + +lemma r_le_prim [simp]: "prim_recfn 2 r_le" + unfolding r_le_def by simp + +lemma r_le [simp]: "eval r_le [x, y] \= (if x \ y then 0 else 1)" + unfolding r_le_def by simp + +text \Arguments are evaluated eagerly. Therefore @{term "r_ifz"}, etc. +cannot be combined with a diverging function to implement a conditionally +diverging function in the naive way. The following function implements a +special case needed in the next section. A \hyperlink{p:r_lifz}{general lazy +version} of @{term "r_ifz"} will be introduced later with the help of a +universal function.\ + +definition "r_ifeq_else_diverg \ + Cn 3 r_add [Id 3 2, Mn 3 (Cn 4 r_add [Id 4 0, Cn 4 r_eq [Id 4 1, Id 4 2]])]" + +lemma r_ifeq_else_diverg_recfn [simp]: "recfn 3 r_ifeq_else_diverg" + unfolding r_ifeq_else_diverg_def by simp + +lemma r_ifeq_else_diverg [simp]: + "eval r_ifeq_else_diverg [a, b, v] = (if a = b then Some v else None)" + unfolding r_ifeq_else_diverg_def by simp + + +section \The halting problem\label{s:halting}\ + +text \Decidability will be treated more thoroughly in +Section~\ref{s:decidable}. But the halting problem is prominent enough to +deserve an early mention.\ + +definition decidable :: "nat set \ bool" where + "decidable X \ \f. recfn 1 f \ (\x. eval f [x] \= (if x \ X then 1 else 0))" + +text \No matter how partial recursive functions are encoded as natural +numbers, the set of all codes of functions halting on their own code is +undecidable.\ + +theorem halting_problem_undecidable: + fixes code :: "nat \ recf" + assumes "\f. recfn 1 f \ \i. code i = f" + shows "\ decidable {x. eval (code x) [x] \}" (is "\ decidable ?K") +proof + assume "decidable ?K" + then obtain f where "recfn 1 f" and f: "\x. eval f [x] \= (if x \ ?K then 1 else 0)" + using decidable_def by auto + define g where "g \ Cn 1 r_ifeq_else_diverg [f, Z, Z]" + then have "recfn 1 g" + using `recfn 1 f` r_ifeq_else_diverg_recfn by simp + with assms obtain i where i: "code i = g" by auto + from g_def have "eval g [x] = (if x \ ?K then Some 0 else None)" for x + using r_ifeq_else_diverg_recfn `recfn 1 f` f by simp + then have "eval g [i] \ \ i \ ?K" by simp + also have "... \ eval (code i) [i] \" by simp + also have "... \ eval g [i] \" + using i by simp + finally have "eval g [i] \ \ eval g [i] \" . + then show False by auto +qed + + +section \Encoding tuples and lists\ + +text \This section is based on the Cantor encoding for pairs. Tuples +are encoded by repeated application of the pairing function, lists by pairing +their length with the code for a tuple. Thus tuples have a fixed length that +must be known when decoding, whereas lists are dynamically sized and know +their current length.\ + + +subsection \Pairs and tuples\ + + +subsubsection \The Cantor pairing function\ + +definition "r_triangle \ r_shrink (Pr 1 Z (r_dummy 1 (Cn 2 S [r_add])))" + +lemma r_triangle_prim: "prim_recfn 1 r_triangle" + unfolding r_triangle_def by simp + +lemma r_triangle: "eval r_triangle [n] \= Sum {0..n}" +proof - + let ?r = "r_dummy 1 (Cn 2 S [r_add])" + have "eval ?r [x, y, z] \= Suc (x + y)" for x y z + using r_dummy_append[of "Cn 2 S [r_add]" "[x, y]" "[z]" 1] by simp + then have "eval (Pr 1 Z ?r) [x, y] \= Sum {0..x}" for x y + by (induction x) simp_all + then show ?thesis unfolding r_triangle_def by simp +qed + +lemma r_triangle_eq_triangle [simp]: "eval r_triangle [n] \= triangle n" + using r_triangle gauss_sum_nat triangle_def by simp + +definition "r_prod_encode \ Cn 2 r_add [Cn 2 r_triangle [r_add], Id 2 0]" + +lemma r_prod_encode_prim [simp]: "prim_recfn 2 r_prod_encode" + unfolding r_prod_encode_def using r_triangle_prim by simp + +lemma r_prod_encode [simp]: "eval r_prod_encode [m, n] \= prod_encode (m, n)" + unfolding r_prod_encode_def prod_encode_def using r_triangle_prim by simp + +text \These abbreviations are just two more things borrowed from +Xu~et~al.~\cite{Universal_Turing_Machine-AFP}.\ + +abbreviation "pdec1 z \ fst (prod_decode z)" + +abbreviation "pdec2 z \ snd (prod_decode z)" + +lemma pdec1_le: "pdec1 i \ i" + by (metis le_prod_encode_1 prod.collapse prod_decode_inverse) + +lemma pdec2_le: "pdec2 i \ i" + by (metis le_prod_encode_2 prod.collapse prod_decode_inverse) + +lemma pdec_less: "pdec2 i < Suc i" + using pdec2_le by (simp add: le_imp_less_Suc) + +lemma pdec1_zero: "pdec1 0 = 0" + using pdec1_le by auto + +definition "r_maxletr \ + Pr 1 Z (Cn 3 r_ifle [r_dummy 2 (Cn 1 r_triangle [S]), Id 3 2, Cn 3 S [Id 3 0], Id 3 1])" + +lemma r_maxletr_prim: "prim_recfn 2 r_maxletr" + unfolding r_maxletr_def using r_triangle_prim by simp + +lemma not_Suc_Greatest_not_Suc: + assumes "\ P (Suc x)" and "\x. P x" + shows "(GREATEST y. y \ x \ P y) = (GREATEST y. y \ Suc x \ P y)" + using assms by (metis le_SucI le_Suc_eq) + +lemma r_maxletr: "eval r_maxletr [x\<^sub>0, x\<^sub>1] \= (GREATEST y. y \ x\<^sub>0 \ triangle y \ x\<^sub>1)" +proof - + let ?g = "Cn 3 r_ifle [r_dummy 2 (Cn 1 r_triangle [S]), Id 3 2, Cn 3 S [Id 3 0], Id 3 1]" + have greatest: + "(if triangle (Suc x\<^sub>0) \ x\<^sub>1 then Suc x\<^sub>0 else (GREATEST y. y \ x\<^sub>0 \ triangle y \ x\<^sub>1)) = + (GREATEST y. y \ Suc x\<^sub>0 \ triangle y \ x\<^sub>1)" + for x\<^sub>0 x\<^sub>1 + proof (cases "triangle (Suc x\<^sub>0) \ x\<^sub>1") + case True + then show ?thesis + using Greatest_equality[of "\y. y \ Suc x\<^sub>0 \ triangle y \ x\<^sub>1"] by fastforce + next + case False + then show ?thesis + using not_Suc_Greatest_not_Suc[of "\y. triangle y \ x\<^sub>1" x\<^sub>0] by fastforce + qed + show ?thesis + unfolding r_maxletr_def using r_triangle_prim + proof (induction x\<^sub>0) + case 0 + then show ?case + using Greatest_equality[of "\y. y \ 0 \ triangle y \ x\<^sub>1" 0] by simp + next + case (Suc x\<^sub>0) + then show ?case using greatest by simp + qed +qed + +definition "r_maxlt \ r_shrink r_maxletr" + +lemma r_maxlt_prim: "prim_recfn 1 r_maxlt" + unfolding r_maxlt_def using r_maxletr_prim by simp + +lemma r_maxlt: "eval r_maxlt [e] \= (GREATEST y. triangle y \ e)" +proof - + have "y \ triangle y" for y + by (induction y) auto + then have "triangle y \ e \ y \ e" for y e + using order_trans by blast + then have "(GREATEST y. y \ e \ triangle y \ e) = (GREATEST y. triangle y \ e)" + by metis + moreover have "eval r_maxlt [e] \= (GREATEST y. y \ e \ triangle y \ e)" + using r_maxletr r_shrink r_maxlt_def r_maxletr_prim by fastforce + ultimately show ?thesis by simp +qed + +definition "pdec1' e \ e - triangle (GREATEST y. triangle y \ e)" + +definition "pdec2' e \ (GREATEST y. triangle y \ e) - pdec1' e" + +lemma max_triangle_bound: "triangle z \ e \ z \ e" + by (metis Suc_pred add_leD2 less_Suc_eq triangle_Suc zero_le zero_less_Suc) + +lemma triangle_greatest_le: "triangle (GREATEST y. triangle y \ e) \ e" + using max_triangle_bound GreatestI_nat[of "\y. triangle y \ e" 0 e] by simp + +lemma prod_encode_pdec': "prod_encode (pdec1' e, pdec2' e) = e" +proof - + let ?P = "\y. triangle y \ e" + let ?y = "GREATEST y. ?P y" + have "pdec1' e \ ?y" + proof (rule ccontr) + assume "\ pdec1' e \ ?y" + then have "e - triangle ?y > ?y" + using pdec1'_def by simp + then have "?P (Suc ?y)" by simp + moreover have "\z. ?P z \ z \ e" + using max_triangle_bound by simp + ultimately have "Suc ?y \ ?y" + using Greatest_le_nat[of ?P "Suc ?y" e] by blast + then show False by simp + qed + then have "pdec1' e + pdec2' e = ?y" + using pdec1'_def pdec2'_def by simp + then have "prod_encode (pdec1' e, pdec2' e) = triangle ?y + pdec1' e" + by (simp add: prod_encode_def) + then show ?thesis using pdec1'_def triangle_greatest_le by simp +qed + +lemma pdec': + "pdec1' e = pdec1 e" + "pdec2' e = pdec2 e" + using prod_encode_pdec' prod_encode_inverse by (metis fst_conv, metis snd_conv) + +definition "r_pdec1 \ Cn 1 r_sub [Id 1 0, Cn 1 r_triangle [r_maxlt]]" + +lemma r_pdec1_prim [simp]: "prim_recfn 1 r_pdec1" + unfolding r_pdec1_def using r_triangle_prim r_maxlt_prim by simp + +lemma r_pdec1 [simp]: "eval r_pdec1 [e] \= pdec1 e" + unfolding r_pdec1_def using r_triangle_prim r_maxlt_prim pdec' pdec1'_def + by (simp add: r_maxlt) + +definition "r_pdec2 \ Cn 1 r_sub [r_maxlt, r_pdec1]" + +lemma r_pdec2_prim [simp]: "prim_recfn 1 r_pdec2" + unfolding r_pdec2_def using r_maxlt_prim by simp + +lemma r_pdec2 [simp]: "eval r_pdec2 [e] \= pdec2 e" + unfolding r_pdec2_def using r_maxlt_prim r_maxlt pdec' pdec2'_def by simp + +abbreviation "pdec12 i \ pdec1 (pdec2 i)" +abbreviation "pdec22 i \ pdec2 (pdec2 i)" +abbreviation "pdec122 i \ pdec1 (pdec22 i)" +abbreviation "pdec222 i \ pdec2 (pdec22 i)" + +definition "r_pdec12 \ Cn 1 r_pdec1 [r_pdec2]" + +lemma r_pdec12_prim [simp]: "prim_recfn 1 r_pdec12" + unfolding r_pdec12_def by simp + +lemma r_pdec12 [simp]: "eval r_pdec12 [e] \= pdec12 e" + unfolding r_pdec12_def by simp + +definition "r_pdec22 \ Cn 1 r_pdec2 [r_pdec2]" + +lemma r_pdec22_prim [simp]: "prim_recfn 1 r_pdec22" + unfolding r_pdec22_def by simp + +lemma r_pdec22 [simp]: "eval r_pdec22 [e] \= pdec22 e" + unfolding r_pdec22_def by simp + +definition "r_pdec122 \ Cn 1 r_pdec1 [r_pdec22]" + +lemma r_pdec122_prim [simp]: "prim_recfn 1 r_pdec122" + unfolding r_pdec122_def by simp + +lemma r_pdec122 [simp]: "eval r_pdec122 [e] \= pdec122 e" + unfolding r_pdec122_def by simp + +definition "r_pdec222 \ Cn 1 r_pdec2 [r_pdec22]" + +lemma r_pdec222_prim [simp]: "prim_recfn 1 r_pdec222" + unfolding r_pdec222_def by simp + +lemma r_pdec222 [simp]: "eval r_pdec222 [e] \= pdec222 e" + unfolding r_pdec222_def by simp + + +subsubsection \The Cantor tuple function\ + +text \The empty tuple gets no code, whereas singletons are encoded by their +only element and other tuples by recursively applying the pairing function. +This yields, for every $n$, the function @{term "tuple_encode n"}, which is a +bijection between the natural numbers and the lists of length $(n + 1)$.\ + +fun tuple_encode :: "nat \ nat list \ nat" where + "tuple_encode n [] = undefined" +| "tuple_encode 0 (x # xs) = x" +| "tuple_encode (Suc n) (x # xs) = prod_encode (x, tuple_encode n xs)" + +lemma tuple_encode_prod_encode: "tuple_encode 1 [x, y] = prod_encode (x, y)" + by simp + +fun tuple_decode where + "tuple_decode 0 i = [i]" +| "tuple_decode (Suc n) i = pdec1 i # tuple_decode n (pdec2 i)" + +lemma tuple_encode_decode [simp]: + "tuple_encode (length xs - 1) (tuple_decode (length xs - 1) i) = i" +proof (induction "length xs - 1" arbitrary: xs i) + case 0 + then show ?case by simp +next + case (Suc n) + then have "length xs - 1 > 0" by simp + with Suc have *: "tuple_encode n (tuple_decode n j) = j" for j + by (metis diff_Suc_1 length_tl) + from Suc have "tuple_decode (Suc n) i = pdec1 i # tuple_decode n (pdec2 i)" + using tuple_decode.simps(2) by blast + then have "tuple_encode (Suc n) (tuple_decode (Suc n) i) = + tuple_encode (Suc n) (pdec1 i # tuple_decode n (pdec2 i))" + using Suc by simp + also have "... = prod_encode (pdec1 i, tuple_encode n (tuple_decode n (pdec2 i)))" + by simp + also have "... = prod_encode (pdec1 i, pdec2 i)" + using Suc * by simp + also have "... = i" by simp + finally have "tuple_encode (Suc n) (tuple_decode (Suc n) i) = i" . + then show ?case by (simp add: Suc.hyps(2)) +qed + +lemma tuple_encode_decode' [simp]: "tuple_encode n (tuple_decode n i) = i" + using tuple_encode_decode by (metis Ex_list_of_length diff_Suc_1 length_Cons) + +lemma tuple_decode_encode: + assumes "length xs > 0" + shows "tuple_decode (length xs - 1) (tuple_encode (length xs - 1) xs) = xs" + using assms +proof (induction "length xs - 1" arbitrary: xs) + case 0 + moreover from this have "length xs = 1" by linarith + ultimately show ?case + by (metis One_nat_def length_0_conv length_Suc_conv tuple_decode.simps(1) + tuple_encode.simps(2)) +next + case (Suc n) + let ?t = "tl xs" + let ?i = "tuple_encode (Suc n) xs" + have "length ?t > 0" and "length ?t - 1 = n" + using Suc by simp_all + then have "tuple_decode n (tuple_encode n ?t) = ?t" + using Suc by blast + moreover have "?i = prod_encode (hd xs, tuple_encode n ?t)" + using Suc by (metis hd_Cons_tl length_greater_0_conv tuple_encode.simps(3)) + moreover have "tuple_decode (Suc n) ?i = pdec1 ?i # tuple_decode n (pdec2 ?i)" + using tuple_decode.simps(2) by blast + ultimately have "tuple_decode (Suc n) ?i = xs" + using Suc.prems by simp + then show ?case by (simp add: Suc.hyps(2)) +qed + +lemma tuple_decode_encode' [simp]: + assumes "length xs = Suc n" + shows "tuple_decode n (tuple_encode n xs) = xs" + using assms tuple_decode_encode by (metis diff_Suc_1 zero_less_Suc) + +lemma tuple_decode_length [simp]: "length (tuple_decode n i) = Suc n" + by (induction n arbitrary: i) simp_all + +lemma tuple_decode_nonzero: + assumes "n > 0" + shows "tuple_decode n i = pdec1 i # tuple_decode (n - 1) (pdec2 i)" + using assms by (metis One_nat_def Suc_pred tuple_decode.simps(2)) + +text \The tuple encoding functions are primitive recursive.\ + +fun r_tuple_encode :: "nat \ recf" where + "r_tuple_encode 0 = Id 1 0" +| "r_tuple_encode (Suc n) = + Cn (Suc (Suc n)) r_prod_encode [Id (Suc (Suc n)) 0, r_shift (r_tuple_encode n)]" + +lemma r_tuple_encode_prim [simp]: "prim_recfn (Suc n) (r_tuple_encode n)" + by (induction n) simp_all + +lemma r_tuple_encode: + assumes "length xs = Suc n" + shows "eval (r_tuple_encode n) xs \= tuple_encode n xs" + using assms +proof (induction n arbitrary: xs) + case 0 + then show ?case + by (metis One_nat_def eval_Id length_Suc_conv nth_Cons_0 + r_tuple_encode.simps(1) tuple_encode.simps(2) zero_less_one) +next + case (Suc n) + then obtain y ys where y_ys: "y # ys = xs" + by (metis length_Suc_conv) + with Suc have "eval (r_tuple_encode n) ys \= tuple_encode n ys" + by auto + with y_ys have "eval (r_shift (r_tuple_encode n)) xs \= tuple_encode n ys" + using Suc.prems r_shift_prim r_tuple_encode_prim by auto + moreover have "eval (Id (Suc (Suc n)) 0) xs \= y" + using y_ys Suc.prems by auto + ultimately have "eval (r_tuple_encode (Suc n)) xs \= prod_encode (y, tuple_encode n ys)" + using Suc.prems by simp + then show ?case using y_ys by auto +qed + + +subsubsection \Functions on encoded tuples\ + +text \The function for accessing the $n$-th element of a tuple returns +$0$ for out-of-bounds access.\ + +definition e_tuple_nth :: "nat \ nat \ nat \ nat" where + "e_tuple_nth a i n \ if n \ a then (tuple_decode a i) ! n else 0" + +lemma e_tuple_nth_le [simp]: "n \ a \ e_tuple_nth a i n = (tuple_decode a i) ! n" + using e_tuple_nth_def by simp + +lemma e_tuple_nth_gr [simp]: "n > a \ e_tuple_nth a i n = 0" + using e_tuple_nth_def by simp + +lemma tuple_decode_pdec2: "tuple_decode a (pdec2 es) = tl (tuple_decode (Suc a) es)" + by simp + +fun iterate :: "nat \ ('a \ 'a) \ ('a \ 'a)" where + "iterate 0 f = id" +| "iterate (Suc n) f = f \ (iterate n f)" + +lemma iterate_additive: + assumes "iterate t\<^sub>1 f x = y" and "iterate t\<^sub>2 f y = z" + shows "iterate (t\<^sub>1 + t\<^sub>2) f x = z" + using assms by (induction t\<^sub>2 arbitrary: z) auto + +lemma iterate_additive': "iterate (t\<^sub>1 + t\<^sub>2) f x = iterate t\<^sub>2 f (iterate t\<^sub>1 f x)" + using iterate_additive by metis + +lemma e_tuple_nth_elementary: + assumes "k \ a" + shows "e_tuple_nth a i k = (if a = k then (iterate k pdec2 i) else (pdec1 (iterate k pdec2 i)))" +proof - + have *: "tuple_decode (a - k) (iterate k pdec2 i) = drop k (tuple_decode a i)" + using assms + by (induction k) (simp, simp add: Suc_diff_Suc tuple_decode_pdec2 drop_Suc tl_drop) + show ?thesis + proof (cases "a = k") + case True + then have "tuple_decode 0 (iterate k pdec2 i) = drop k (tuple_decode a i)" + using assms * by simp + moreover from this have "drop k (tuple_decode a i) = [tuple_decode a i ! k]" + using assms True by (metis nth_via_drop tuple_decode.simps(1)) + ultimately show ?thesis using True by simp + next + case False + with assms have "a - k > 0" by simp + with * have "tuple_decode (a - k) (iterate k pdec2 i) = drop k (tuple_decode a i)" + by simp + then have "pdec1 (iterate k pdec2 i) = hd (drop k (tuple_decode a i))" + using tuple_decode_nonzero `a - k > 0` by (metis list.sel(1)) + with `a - k > 0` have "pdec1 (iterate k pdec2 i) = (tuple_decode a i) ! k" + by (simp add: hd_drop_conv_nth) + with False assms show ?thesis by simp + qed +qed + +definition "r_nth_inbounds \ + let r = Pr 1 (Id 1 0) (Cn 3 r_pdec2 [Id 3 1]) + in Cn 3 r_ifeq + [Id 3 0, + Id 3 2, + Cn 3 r [Id 3 2, Id 3 1], + Cn 3 r_pdec1 [Cn 3 r [Id 3 2, Id 3 1]]]" + +lemma r_nth_inbounds_prim: "prim_recfn 3 r_nth_inbounds" + unfolding r_nth_inbounds_def by (simp add: Let_def) + +lemma r_nth_inbounds: + "k \ a \ eval r_nth_inbounds [a, i, k] \= e_tuple_nth a i k" + "eval r_nth_inbounds [a, i, k] \" +proof - + let ?r = "Pr 1 (Id 1 0) (Cn 3 r_pdec2 [Id 3 1])" + let ?h = "Cn 3 ?r [Id 3 2, Id 3 1]" + have "eval ?r [k, i] \= iterate k pdec2 i" for k i + using r_pdec2_prim by (induction k) (simp_all) + then have "eval ?h [a, i, k] \= iterate k pdec2 i" + using r_pdec2_prim by simp + then have "eval r_nth_inbounds [a, i, k] \= + (if a = k then iterate k pdec2 i else pdec1 (iterate k pdec2 i))" + unfolding r_nth_inbounds_def by (simp add: Let_def) + then show "k \ a \ eval r_nth_inbounds [a, i, k] \= e_tuple_nth a i k" + and "eval r_nth_inbounds [a, i, k] \" + using e_tuple_nth_elementary by simp_all +qed + +definition "r_tuple_nth \ + Cn 3 r_ifle [Id 3 2, Id 3 0, r_nth_inbounds, r_constn 2 0]" + +lemma r_tuple_nth_prim: "prim_recfn 3 r_tuple_nth" + unfolding r_tuple_nth_def using r_nth_inbounds_prim by simp + +lemma r_tuple_nth [simp]: "eval r_tuple_nth [a, i, k] \= e_tuple_nth a i k" + unfolding r_tuple_nth_def using r_nth_inbounds_prim r_nth_inbounds by simp + + +subsection \Lists\ + + +subsubsection \Encoding and decoding\ + +text \Lists are encoded by pairing the length of the list with the code +for the tuple made up of the list's elements. Then all these codes are +incremented in order to make room for the empty list +(cf.~Rogers~\cite[p.~71]{Rogers87}).\ + +fun list_encode :: "nat list \ nat" where + "list_encode [] = 0" +| "list_encode (x # xs) = Suc (prod_encode (length xs, tuple_encode (length xs) (x # xs)))" + +lemma list_encode_0 [simp]: "list_encode xs = 0 \ xs = []" + using list_encode.elims by blast + +lemma list_encode_1: "list_encode [0] = 1" + by (simp add: prod_encode_def) + +fun list_decode :: "nat \ nat list" where + "list_decode 0 = []" +| "list_decode (Suc n) = tuple_decode (pdec1 n) (pdec2 n)" + +lemma list_encode_decode [simp]: "list_encode (list_decode n) = n" +proof (cases n) + case 0 + then show ?thesis by simp +next + case (Suc k) + then have *: "list_decode n = tuple_decode (pdec1 k) (pdec2 k)" (is "_ = ?t") + by simp + then obtain x xs where xxs: "x # xs = ?t" + by (metis tuple_decode.elims) + then have "list_encode ?t = list_encode (x # xs)" by simp + then have 1: "list_encode ?t = Suc (prod_encode (length xs, tuple_encode (length xs) (x # xs)))" + by simp + have 2: "length xs = length ?t - 1" + using xxs by (metis length_tl list.sel(3)) + then have 3: "length xs = pdec1 k" + using * by simp + then have "tuple_encode (length ?t - 1) ?t = pdec2 k" + using 2 tuple_encode_decode by metis + then have "list_encode ?t = Suc (prod_encode (pdec1 k, pdec2 k))" + using 1 2 3 xxs by simp + with * Suc show ?thesis by simp +qed + +lemma list_decode_encode [simp]: "list_decode (list_encode xs) = xs" +proof (cases xs) + case Nil + then show ?thesis by simp +next + case (Cons y ys) + then have "list_encode xs = + Suc (prod_encode (length ys, tuple_encode (length ys) xs))" + (is "_ = Suc ?i") + by simp + then have "list_decode (Suc ?i) = tuple_decode (pdec1 ?i) (pdec2 ?i)" by simp + moreover have "pdec1 ?i = length ys" by simp + moreover have "pdec2 ?i = tuple_encode (length ys) xs" by simp + ultimately have "list_decode (Suc ?i) = + tuple_decode (length ys) (tuple_encode (length ys) xs)" + by simp + moreover have "length ys = length xs - 1" + using Cons by simp + ultimately have "list_decode (Suc ?i) = + tuple_decode (length xs - 1) (tuple_encode (length xs - 1) xs)" + by simp + then show ?thesis using Cons by simp +qed + +abbreviation singleton_encode :: "nat \ nat" where + "singleton_encode x \ list_encode [x]" + +lemma list_decode_singleton: "list_decode (singleton_encode x) = [x]" + by simp + +definition "r_singleton_encode \ Cn 1 S [Cn 1 r_prod_encode [Z, Id 1 0]]" + +lemma r_singleton_encode_prim [simp]: "prim_recfn 1 r_singleton_encode" + unfolding r_singleton_encode_def by simp + +lemma r_singleton_encode [simp]: "eval r_singleton_encode [x] \= singleton_encode x" + unfolding r_singleton_encode_def by simp + +definition r_list_encode :: "nat \ recf" where + "r_list_encode n \ Cn (Suc n) S [Cn (Suc n) r_prod_encode [r_constn n n, r_tuple_encode n]]" + +lemma r_list_encode_prim [simp]: "prim_recfn (Suc n) (r_list_encode n)" + unfolding r_list_encode_def by simp + +lemma r_list_encode: + assumes "length xs = Suc n" + shows "eval (r_list_encode n) xs \= list_encode xs" +proof - + have "eval (r_tuple_encode n) xs \" + by (simp add: assms r_tuple_encode) + then have "eval (Cn (Suc n) r_prod_encode [r_constn n n, r_tuple_encode n]) xs \" + using assms by simp + then have "eval (r_list_encode n) xs = + eval S [the (eval (Cn (Suc n) r_prod_encode [r_constn n n, r_tuple_encode n]) xs)]" + unfolding r_list_encode_def using assms r_tuple_encode by simp + moreover from assms obtain y ys where "xs = y # ys" + by (meson length_Suc_conv) + ultimately show ?thesis + unfolding r_list_encode_def using assms r_tuple_encode by simp +qed + + +subsubsection \Functions on encoded lists\ + +text \The functions in this section mimic those on type @{typ "nat +list"}. Their names are prefixed by @{text e_} and the names of the +corresponding @{typ recf}s by @{text r_}.\ + +abbreviation e_tl :: "nat \ nat" where + "e_tl e \ list_encode (tl (list_decode e))" + +text \In order to turn @{term e_tl} into a partial recursive function +we first represent it in a more elementary way.\ + +lemma e_tl_elementary: + "e_tl e = + (if e = 0 then 0 + else if pdec1 (e - 1) = 0 then 0 + else Suc (prod_encode (pdec1 (e - 1) - 1, pdec22 (e - 1))))" +proof (cases e) + case 0 + then show ?thesis by simp +next + case Suc_d: (Suc d) + then show ?thesis + proof (cases "pdec1 d") + case 0 + then show ?thesis using Suc_d by simp + next + case (Suc a) + have *: "list_decode e = tuple_decode (pdec1 d) (pdec2 d)" + using Suc_d by simp + with Suc obtain x xs where xxs: "list_decode e = x # xs" by simp + then have **: "e_tl e = list_encode xs" by simp + have "list_decode (Suc (prod_encode (pdec1 (e - 1) - 1, pdec22 (e - 1)))) = + tuple_decode (pdec1 (e - 1) - 1) (pdec22 (e - 1))" + (is "?lhs = _") + by simp + also have "... = tuple_decode a (pdec22 (e - 1))" + using Suc Suc_d by simp + also have "... = tl (tuple_decode (Suc a) (pdec2 (e - 1)))" + using tuple_decode_pdec2 Suc by presburger + also have "... = tl (tuple_decode (pdec1 (e - 1)) (pdec2 (e - 1)))" + using Suc Suc_d by auto + also have "... = tl (list_decode e)" + using * Suc_d by simp + also have "... = xs" + using xxs by simp + finally have "?lhs = xs" . + then have "list_encode ?lhs = list_encode xs" by simp + then have "Suc (prod_encode (pdec1 (e - 1) - 1, pdec22 (e - 1))) = list_encode xs" + using list_encode_decode by metis + then show ?thesis using ** Suc_d Suc by simp + qed +qed + +definition "r_tl \ + let r = Cn 1 r_pdec1 [r_dec] + in Cn 1 r_ifz + [Id 1 0, + Z, + Cn 1 r_ifz + [r, Z, Cn 1 S [Cn 1 r_prod_encode [Cn 1 r_dec [r], Cn 1 r_pdec22 [r_dec]]]]]" + +lemma r_tl_prim [simp]: "prim_recfn 1 r_tl" + unfolding r_tl_def by (simp add: Let_def) + +lemma r_tl [simp]: "eval r_tl [e] \= e_tl e" + unfolding r_tl_def using e_tl_elementary by (simp add: Let_def) + +text \We define the head of the empty encoded list to be zero.\ + +definition e_hd :: "nat \ nat" where + "e_hd e \ if e = 0 then 0 else hd (list_decode e)" + +lemma e_hd [simp]: + assumes "list_decode e = x # xs" + shows "e_hd e = x" + using e_hd_def assms by auto + +lemma e_hd_0 [simp]: "e_hd 0 = 0" + using e_hd_def by simp + +lemma e_hd_neq_0 [simp]: + assumes "e \ 0" + shows "e_hd e = hd (list_decode e)" + using e_hd_def assms by simp + +definition "r_hd \ + Cn 1 r_ifz [Cn 1 r_pdec1 [r_dec], Cn 1 r_pdec2 [r_dec], Cn 1 r_pdec12 [r_dec]]" + +lemma r_hd_prim [simp]: "prim_recfn 1 r_hd" + unfolding r_hd_def by simp + +lemma r_hd [simp]: "eval r_hd [e] \= e_hd e" +proof - + have "e_hd e = (if pdec1 (e - 1) = 0 then pdec2 (e - 1) else pdec12 (e - 1))" + proof (cases e) + case 0 + then show ?thesis using pdec1_zero pdec2_le by auto + next + case (Suc d) + then show ?thesis by (cases "pdec1 d") (simp_all add: pdec1_zero) + qed + then show ?thesis unfolding r_hd_def by simp +qed + +abbreviation e_length :: "nat \ nat" where + "e_length e \ length (list_decode e)" + +lemma e_length_0: "e_length e = 0 \ e = 0" + by (metis list_encode.simps(1) length_0_conv list_encode_decode) + +definition "r_length \ Cn 1 r_ifz [Id 1 0, Z, Cn 1 S [Cn 1 r_pdec1 [r_dec]]]" + +lemma r_length_prim [simp]: "prim_recfn 1 r_length" + unfolding r_length_def by simp + +lemma r_length [simp]: "eval r_length [e] \= e_length e" + unfolding r_length_def by (cases e) simp_all + +text \Accessing an encoded list out of bounds yields zero.\ + +definition e_nth :: "nat \ nat \ nat" where + "e_nth e n \ if e = 0 then 0 else e_tuple_nth (pdec1 (e - 1)) (pdec2 (e - 1)) n" + +lemma e_nth [simp]: + "e_nth e n = (if n < e_length e then (list_decode e) ! n else 0)" + by (cases e) (simp_all add: e_nth_def e_tuple_nth_def) + +lemma e_hd_nth0: "e_hd e = e_nth e 0" + by (simp add: e_hd_def e_length_0 hd_conv_nth) + +definition "r_nth \ + Cn 2 r_ifz + [Id 2 0, + r_constn 1 0, + Cn 2 r_tuple_nth + [Cn 2 r_pdec1 [r_dummy 1 r_dec], Cn 2 r_pdec2 [r_dummy 1 r_dec], Id 2 1]]" + +lemma r_nth_prim [simp]: "prim_recfn 2 r_nth" + unfolding r_nth_def using r_tuple_nth_prim by simp + +lemma r_nth [simp]: "eval r_nth [e, n] \= e_nth e n" + unfolding r_nth_def e_nth_def using r_tuple_nth_prim by simp + +definition "r_rev_aux \ + Pr 1 r_hd (Cn 3 r_prod_encode [Cn 3 r_nth [Id 3 2, Cn 3 S [Id 3 0]], Id 3 1])" + +lemma r_rev_aux_prim: "prim_recfn 2 r_rev_aux" + unfolding r_rev_aux_def by simp + +lemma r_rev_aux: + assumes "list_decode e = xs" and "length xs > 0" and "i < length xs" + shows "eval r_rev_aux [i, e] \= tuple_encode i (rev (take (Suc i) xs))" + using assms(3) +proof (induction i) + case 0 + then show ?case + unfolding r_rev_aux_def using assms e_hd_def r_hd by (auto simp add: take_Suc) +next + case (Suc i) + let ?g = "Cn 3 r_prod_encode [Cn 3 r_nth [Id 3 2, Cn 3 S [Id 3 0]], Id 3 1]" + from Suc have "eval r_rev_aux [Suc i, e] = eval ?g [i, the (eval r_rev_aux [i, e]), e]" + unfolding r_rev_aux_def by simp + also have "... \= prod_encode (xs ! (Suc i), tuple_encode i (rev (take (Suc i) xs)))" + using Suc by (simp add: assms(1)) + finally show ?case by (simp add: Suc.prems take_Suc_conv_app_nth) +qed + +corollary r_rev_aux_full: + assumes "list_decode e = xs" and "length xs > 0" + shows "eval r_rev_aux [length xs - 1, e] \= tuple_encode (length xs - 1) (rev xs)" + using r_rev_aux assms by simp + +lemma r_rev_aux_total: "eval r_rev_aux [i, e] \" + using r_rev_aux_prim totalE by fastforce + +definition "r_rev \ + Cn 1 r_ifz + [Id 1 0, + Z, + Cn 1 S + [Cn 1 r_prod_encode + [Cn 1 r_dec [r_length], Cn 1 r_rev_aux [Cn 1 r_dec [r_length], Id 1 0]]]]" + +lemma r_rev_prim [simp]: "prim_recfn 1 r_rev" + unfolding r_rev_def using r_rev_aux_prim by simp + +lemma r_rev [simp]: "eval r_rev [e] \= list_encode (rev (list_decode e))" +proof - + let ?d = "Cn 1 r_dec [r_length]" + let ?a = "Cn 1 r_rev_aux [?d, Id 1 0]" + let ?p = "Cn 1 r_prod_encode [?d, ?a]" + let ?s = "Cn 1 S [?p]" + have eval_a: "eval ?a [e] = eval r_rev_aux [e_length e - 1, e]" + using r_rev_aux_prim by simp + then have "eval ?s [e] \" + using r_rev_aux_prim by (simp add: r_rev_aux_total) + then have *: "eval r_rev [e] \= (if e = 0 then 0 else the (eval ?s [e]))" + using r_rev_aux_prim by (simp add: r_rev_def) + show ?thesis + proof (cases "e = 0") + case True + then show ?thesis using * by simp + next + case False + then obtain xs where xs: "xs = list_decode e" "length xs > 0" + using e_length_0 by auto + then have len: "length xs = e_length e" by simp + with eval_a have "eval ?a [e] = eval r_rev_aux [length xs - 1, e]" + by simp + then have "eval ?a [e] \= tuple_encode (length xs - 1) (rev xs)" + using xs r_rev_aux_full by simp + then have "eval ?s [e] \= + Suc (prod_encode (length xs - 1, tuple_encode (length xs - 1) (rev xs)))" + using len r_rev_aux_prim by simp + then have "eval ?s [e] \= + Suc (prod_encode + (length (rev xs) - 1, tuple_encode (length (rev xs) - 1) (rev xs)))" + by simp + moreover have "length (rev xs) > 0" + using xs by simp + ultimately have "eval ?s [e] \= list_encode (rev xs)" + by (metis list_encode.elims diff_Suc_1 length_Cons length_greater_0_conv) + then show ?thesis using xs * by simp + qed +qed + +abbreviation e_cons :: "nat \ nat \ nat" where + "e_cons e es \ list_encode (e # list_decode es)" + +lemma e_cons_elementary: + "e_cons e es = + (if es = 0 then Suc (prod_encode (0, e)) + else Suc (prod_encode (e_length es, prod_encode (e, pdec2 (es - 1)))))" +proof (cases "es = 0") + case True + then show ?thesis by simp +next + case False + then have "e_length es = Suc (pdec1 (es - 1))" + by (metis list_decode.elims diff_Suc_1 tuple_decode_length) + moreover have "es = e_tl (list_encode (e # list_decode es))" + by (metis list.sel(3) list_decode_encode list_encode_decode) + ultimately show ?thesis + using False e_tl_elementary + by (metis list_decode.simps(2) diff_Suc_1 list_encode_decode prod.sel(1) + prod_encode_inverse snd_conv tuple_decode.simps(2)) +qed + +definition "r_cons_else \ + Cn 2 S + [Cn 2 r_prod_encode + [Cn 2 r_length + [Id 2 1], Cn 2 r_prod_encode [Id 2 0, Cn 2 r_pdec2 [Cn 2 r_dec [Id 2 1]]]]]" + +lemma r_cons_else_prim: "prim_recfn 2 r_cons_else" + unfolding r_cons_else_def by simp + +lemma r_cons_else: + "eval r_cons_else [e, es] \= + Suc (prod_encode (e_length es, prod_encode (e, pdec2 (es - 1))))" + unfolding r_cons_else_def by simp + +definition "r_cons \ + Cn 2 r_ifz + [Id 2 1, Cn 2 S [Cn 2 r_prod_encode [r_constn 1 0, Id 2 0]], r_cons_else]" + +lemma r_cons_prim [simp]: "prim_recfn 2 r_cons" + unfolding r_cons_def using r_cons_else_prim by simp + +lemma r_cons [simp]: "eval r_cons [e, es] \= e_cons e es" + unfolding r_cons_def using r_cons_else_prim r_cons_else e_cons_elementary by simp + +abbreviation e_snoc :: "nat \ nat \ nat" where + "e_snoc es e \ list_encode (list_decode es @ [e])" + +lemma e_nth_snoc_small [simp]: + assumes "n < e_length b" + shows "e_nth (e_snoc b z) n = e_nth b n" + using assms by (simp add: nth_append) + +lemma e_hd_snoc [simp]: + assumes "e_length b > 0" + shows "e_hd (e_snoc b x) = e_hd b" +proof - + from assms have "b \ 0" + using less_imp_neq by force + then have hd: "e_hd b = hd (list_decode b)" by simp + have "e_length (e_snoc b x) > 0" by simp + then have "e_snoc b x \ 0" + using not_gr_zero by fastforce + then have "e_hd (e_snoc b x) = hd (list_decode (e_snoc b x))" by simp + with assms hd show ?thesis by simp +qed + +definition "r_snoc \ Cn 2 r_rev [Cn 2 r_cons [Id 2 1, Cn 2 r_rev [Id 2 0]]]" + +lemma r_snoc_prim [simp]: "prim_recfn 2 r_snoc" + unfolding r_snoc_def by simp + +lemma r_snoc [simp]: "eval r_snoc [es, e] \= e_snoc es e" + unfolding r_snoc_def by simp + +abbreviation e_butlast :: "nat \ nat" where + "e_butlast e \ list_encode (butlast (list_decode e))" + +abbreviation e_take :: "nat \ nat \ nat" where + "e_take n x \ list_encode (take n (list_decode x))" + +definition "r_take \ + Cn 2 r_ifle + [Id 2 0, Cn 2 r_length [Id 2 1], + Pr 1 Z (Cn 3 r_snoc [Id 3 1, Cn 3 r_nth [Id 3 2, Id 3 0]]), + Id 2 1]" + +lemma r_take_prim [simp]: "prim_recfn 2 r_take" + unfolding r_take_def by simp_all + +lemma r_take: + assumes "x = list_encode es" + shows "eval r_take [n, x] \= list_encode (take n es)" +proof - + let ?g = "Cn 3 r_snoc [Id 3 1, Cn 3 r_nth [Id 3 2, Id 3 0]]" + let ?h = "Pr 1 Z ?g" + have "total ?h" using Mn_free_imp_total by simp + have "m \ length es \ eval ?h [m, x] \= list_encode (take m es)" for m + proof (induction m) + case 0 + then show ?case using assms r_take_def by (simp add: r_take_def) + next + case (Suc m) + then have "m < length es" by simp + then have "eval ?h [Suc m, x] = eval ?g [m, the (eval ?h [m, x]), x]" + using Suc r_take_def by simp + also have "... = eval ?g [m, list_encode (take m es), x]" + using Suc by simp + also have "... \= e_snoc (list_encode (take m es)) (es ! m)" + by (simp add: \m < length es\ assms) + also have "... \= list_encode ((take m es) @ [es ! m])" + using list_decode_encode by simp + also have "... \= list_encode (take (Suc m) es)" + by (simp add: \m < length es\ take_Suc_conv_app_nth) + finally show ?case . + qed + moreover have "eval (Id 2 1) [m, x] \= list_encode (take m es)" if "m > length es" for m + using that assms by simp + moreover have "eval r_take [m, x] \= + (if m \ e_length x then the (eval ?h [m, x]) else the (eval (Id 2 1) [m, x]))" + for m + unfolding r_take_def using `total ?h` by simp + ultimately show ?thesis unfolding r_take_def by fastforce +qed + +corollary r_take' [simp]: "eval r_take [n, x] \= e_take n x" + by (simp add: r_take) + +definition "r_last \ Cn 1 r_hd [r_rev]" + +lemma r_last_prim [simp]: "prim_recfn 1 r_last" + unfolding r_last_def by simp + +lemma r_last [simp]: + assumes "e = list_encode xs" and "length xs > 0" + shows "eval r_last [e] \= last xs" +proof - + from assms(2) have "length (rev xs) > 0" by simp + then have "list_encode (rev xs) > 0" + by (metis gr0I list.size(3) list_encode_0) + moreover have "eval r_last [e] = eval r_hd [the (eval r_rev [e])]" + unfolding r_last_def by simp + ultimately show ?thesis using assms hd_rev by auto +qed + +definition "r_update_aux \ + let + f = r_constn 2 0; + g = Cn 5 r_snoc + [Id 5 1, Cn 5 r_ifeq [Id 5 0, Id 5 3, Id 5 4, Cn 5 r_nth [Id 5 2, Id 5 0]]] + in Pr 3 f g" + +lemma r_update_aux_recfn: "recfn 4 r_update_aux" + unfolding r_update_aux_def by simp + +lemma r_update_aux: + assumes "n \ e_length b" + shows "eval r_update_aux [n, b, j, v] \= list_encode ((take n (list_decode b))[j:=v])" + using assms +proof (induction n) + case 0 + then show ?case unfolding r_update_aux_def by simp +next + case (Suc n) + then have n: "n < e_length b" + by simp + let ?a = "Cn 5 r_nth [Id 5 2, Id 5 0]" + let ?b = "Cn 5 r_ifeq [Id 5 0, Id 5 3, Id 5 4, ?a]" + define g where "g \ Cn 5 r_snoc [Id 5 1, ?b]" + then have g: "eval g [n, r, b, j, v] \= e_snoc r (if n = j then v else e_nth b n)" for r + by simp + + have "Pr 3 (r_constn 2 0) g = r_update_aux" + using r_update_aux_def g_def by simp + then have "eval r_update_aux [Suc n, b, j, v] = + eval g [n, the (eval r_update_aux [n, b, j, v]), b, j, v]" + using r_update_aux_recfn Suc n eval_Pr_converg_Suc + by (metis arity.simps(5) length_Cons list.size(3) nat_less_le + numeral_3_eq_3 option.simps(3)) + then have *: "eval r_update_aux [Suc n, b, j, v] \= e_snoc + (list_encode ((take n (list_decode b))[j:=v])) + (if n = j then v else e_nth b n)" + using g Suc by simp + + consider (j_eq_n) "j = n" | (j_less_n) "j < n" | (j_gt_n) "j > n" + by linarith + then show ?case + proof (cases) + case j_eq_n + moreover from this have "(take (Suc n) (list_decode b))[j:=v] = + (take n (list_decode b))[j:=v] @ [v]" + using n + by (metis length_list_update nth_list_update_eq take_Suc_conv_app_nth take_update_swap) + ultimately show ?thesis using * by simp + next + case j_less_n + moreover from this have "(take (Suc n) (list_decode b))[j:=v] = + (take n (list_decode b))[j:=v] @ [(list_decode b) ! n]" + using n + by (simp add: le_eq_less_or_eq list_update_append min_absorb2 take_Suc_conv_app_nth) + ultimately show ?thesis using * by auto + next + case j_gt_n + moreover from this have "(take (Suc n) (list_decode b))[j:=v] = + (take n (list_decode b))[j:=v] @ [(list_decode b) ! n]" + using n take_Suc_conv_app_nth by auto + ultimately show ?thesis using * by auto + qed +qed + +abbreviation e_update :: "nat \ nat \ nat \ nat" where + "e_update b j v \ list_encode ((list_decode b)[j:=v])" + +definition "r_update \ + Cn 3 r_update_aux [Cn 3 r_length [Id 3 0], Id 3 0, Id 3 1, Id 3 2]" + +lemma r_update_recfn [simp]: "recfn 3 r_update" + unfolding r_update_def using r_update_aux_recfn by simp + +lemma r_update [simp]: "eval r_update [b, j, v] \= e_update b j v" + unfolding r_update_def using r_update_aux r_update_aux_recfn by simp + +lemma e_length_update [simp]: "e_length (e_update b k v) = e_length b" + by simp + +definition e_append :: "nat \ nat \ nat" where + "e_append xs ys \ list_encode (list_decode xs @ list_decode ys)" + +lemma e_length_append: "e_length (e_append xs ys) = e_length xs + e_length ys" + using e_append_def by simp + +lemma e_nth_append_small: + assumes "n < e_length xs" + shows "e_nth (e_append xs ys) n = e_nth xs n" + using e_append_def assms by (simp add: nth_append) + +lemma e_nth_append_big: + assumes "n \ e_length xs" + shows "e_nth (e_append xs ys) n = e_nth ys (n - e_length xs)" + using e_append_def assms e_nth by (simp add: less_diff_conv2 nth_append) + +definition "r_append \ + let + f = Id 2 0; + g = Cn 4 r_snoc [Id 4 1, Cn 4 r_nth [Id 4 3, Id 4 0]] + in Cn 2 (Pr 2 f g) [Cn 2 r_length [Id 2 1], Id 2 0, Id 2 1]" + +lemma r_append_prim [simp]: "prim_recfn 2 r_append" + unfolding r_append_def by simp + +lemma r_append [simp]: "eval r_append [a, b] \= e_append a b" +proof - + define g where "g = Cn 4 r_snoc [Id 4 1, Cn 4 r_nth [Id 4 3, Id 4 0]]" + then have g: "eval g [j, r, a, b] \= e_snoc r (e_nth b j)" for j r + by simp + let ?h = "Pr 2 (Id 2 0) g" + have "eval ?h [n, a, b] \= list_encode (list_decode a @ (take n (list_decode b)))" + if "n \ e_length b" for n + using that g g_def by (induction n) (simp_all add: take_Suc_conv_app_nth) + then show ?thesis + unfolding r_append_def g_def e_append_def by simp +qed + +definition e_append_zeros :: "nat \ nat \ nat" where + "e_append_zeros b z \ e_append b (list_encode (replicate z 0))" + +lemma e_append_zeros_length: "e_length (e_append_zeros b z) = e_length b + z" + using e_append_def e_append_zeros_def by simp + +lemma e_nth_append_zeros: "e_nth (e_append_zeros b z) i = e_nth b i" + using e_append_zeros_def e_nth_append_small e_nth_append_big by auto + +lemma e_nth_append_zeros_big: + assumes "i \ e_length b" + shows "e_nth (e_append_zeros b z) i = 0" + unfolding e_append_zeros_def + using e_nth_append_big[of b i "list_encode (replicate z 0)", OF assms(1)] + by simp + +definition "r_append_zeros \ + r_swap (Pr 1 (Id 1 0) (Cn 3 r_snoc [Id 3 1, r_constn 2 0]))" + +lemma r_append_zeros_prim [simp]: "prim_recfn 2 r_append_zeros" + unfolding r_append_zeros_def by simp + +lemma r_append_zeros: "eval r_append_zeros [b, z] \= e_append_zeros b z" +proof - + let ?r = "Pr 1 (Id 1 0) (Cn 3 r_snoc [Id 3 1, r_constn 2 0])" + have "eval ?r [z, b] \= e_append_zeros b z" + using e_append_zeros_def e_append_def + by (induction z) (simp_all add: replicate_append_same) + then show ?thesis by (simp add: r_append_zeros_def) +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/R1_BC.thy b/thys/Inductive_Inference/R1_BC.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/R1_BC.thy @@ -0,0 +1,534 @@ +section \@{term "\"} is not in BC\label{s:r1_bc}\ + +theory R1_BC + imports Lemma_R + CP_FIN_NUM (* for V0 *) +begin + +text \We show that @{term "U\<^sub>0 \ V\<^sub>0"} is not in BC, +which implies @{term "\ \ BC"}. + +The proof is by contradiction. Assume there is a strategy $S$ learning @{term +"U\<^sub>0 \ V\<^sub>0"} behaviorally correct in the limit with respect to our +standard Gödel numbering $\varphi$. Thanks to Lemma~R for BC we can assume +$S$ to be total. Then we construct a function in @{term "U\<^sub>0 \ V\<^sub>0"} for +which $S$ fails. + +As usual, there is a computable process building prefixes of functions +$\psi_j$. For every $j$ it starts with the singleton prefix $b = [j]$ and +computes the next prefix from a given prefix $b$ as follows: + +\begin{enumerate} +\item Simulate $\varphi_{S(b0^k)}(|b| + k)$ for increasing $k$ for an + increasing number of steps. +\item Once a $k$ with $\varphi_{S(b0^k)}(|b| + k) = 0$ is found, extend the + prefix by $0^k1$. +\end{enumerate} + +There is always such a $k$ because by assumption $S$ learns $b0^\infty \in +U_0$ and thus outputs a hypothesis for $b0^\infty$ on almost all of its +prefixes. Therefore for almost all prefixes of the form $b0^k$, we have +$\varphi_{S(b0^k)} = b0^\infty$ and hence $\varphi_{S(b0^k)}(|b| + k) = 0$. +But Step~2 constructs $\psi_j$ such that $\psi_j(|b| + k) = 1$. Therefore $S$ +does not hypothesize $\psi_j$ on the prefix $b0^k$ of $\psi_j$. And since the +process runs forever, $S$ outputs infinitely many incorrect hypotheses for +$\psi_j$ and thus does not learn $\psi_j$. + +Applying Kleene's fixed-point theorem to @{term "\ \ \\<^sup>2"} +yields a $j$ with $\varphi_j = \psi_j$ and thus $\psi_j \in V_0$. But $S$ +does not learn any $\psi_j$, contradicting our assumption. + +The result @{prop "\ \ BC"} can be obtained more directly by +running the process with the empty prefix, thereby constructing only one +function instead of a numbering. This function is in @{term R1}, and $S$ +fails to learn it by the same reasoning as above. The stronger statement +about @{term "U\<^sub>0 \ V\<^sub>0"} will be exploited in +Section~\ref{s:union}. + +In the following locale the assumption that $S$ learns @{term "U\<^sub>0"} +suffices for analyzing the process. However, in order to arrive at the +desired contradiction this assumption is too weak because the functions built +by the process are not in @{term "U\<^sub>0"}.\ + +locale r1_bc = + fixes s :: partial1 + assumes s_in_R1: "s \ \" and s_learn_U0: "learn_bc \ U\<^sub>0 s" +begin + +lemma s_learn_prenum: "\b. learn_bc \ {prenum b} s" + using s_learn_U0 U0_altdef learn_bc_closed_subseteq by blast + +text \A @{typ recf} for the strategy:\ + +definition r_s :: recf where + "r_s \ SOME rs. recfn 1 rs \ total rs \ s = (\x. eval rs [x])" + +lemma r_s_recfn [simp]: "recfn 1 r_s" + and r_s_total: "\x. eval r_s [x] \" + and eval_r_s: "\x. s x = eval r_s [x]" + using r_s_def R1_SOME[OF s_in_R1, of r_s] by simp_all + +text \We begin with the function that finds the $k$ from Step~1 of the +construction of $\psi$.\ + +definition "r_find_k \ + let k = Cn 2 r_pdec1 [Id 2 0]; + r = Cn 2 r_result1 + [Cn 2 r_pdec2 [Id 2 0], + Cn 2 r_s [Cn 2 r_append_zeros [Id 2 1, k]], + Cn 2 r_add [Cn 2 r_length [Id 2 1], k]] + in Cn 1 r_pdec1 [Mn 1 (Cn 2 r_eq [r, r_constn 1 1])]" + +lemma r_find_k_recfn [simp]: "recfn 1 r_find_k" + unfolding r_find_k_def by (simp add: Let_def) + +text \There is always a suitable $k$, since the strategy learns +$b0^\infty$ for all $b$.\ + +lemma learn_bc_prenum_eventually_zero: + "\k. \ (the (s (e_append_zeros b k))) (e_length b + k) \= 0" +proof - + let ?f = "prenum b" + have "\n\e_length b. \ (the (s (?f \ n))) = ?f" + using learn_bcE s_learn_prenum by (meson le_cases singletonI) + then obtain n where n: "n \ e_length b" "\ (the (s (?f \ n))) = ?f" + by auto + define k where "k = Suc n - e_length b" + let ?e = "e_append_zeros b k" + have len: "e_length ?e = Suc n" + using k_def n e_append_zeros_length by simp + have "?f \ n = ?e" + proof - + have "e_length ?e > 0" + using len n(1) by simp + moreover have "?f x \= e_nth ?e x" for x + proof (cases "x < e_length b") + case True + then show ?thesis using e_nth_append_zeros by simp + next + case False + then have "?f x \= 0" by simp + moreover from False have "e_nth ?e x = 0" + using e_nth_append_zeros_big by simp + ultimately show ?thesis by simp + qed + ultimately show ?thesis using initI[of "?e"] len by simp + qed + with n(2) have "\ (the (s ?e)) = ?f" by simp + then have "\ (the (s ?e)) (e_length ?e) \= 0" + using len n(1) by auto + then show ?thesis using e_append_zeros_length by auto +qed + +lemma if_eq_eq: "(if v = 1 then (0 :: nat) else 1) = 0 \ v = 1" + by presburger + +lemma r_find_k: + shows "eval r_find_k [b] \" + and "let k = the (eval r_find_k [b]) + in \ (the (s (e_append_zeros b k))) (e_length b + k) \= 0" +proof - + let ?k = "Cn 2 r_pdec1 [Id 2 0]" + let ?argt = "Cn 2 r_pdec2 [Id 2 0]" + let ?argi = "Cn 2 r_s [Cn 2 r_append_zeros [Id 2 1, ?k]]" + let ?argx = "Cn 2 r_add [Cn 2 r_length [Id 2 1], ?k]" + let ?r = "Cn 2 r_result1 [?argt, ?argi, ?argx]" + define f where "f \ + let k = Cn 2 r_pdec1 [Id 2 0]; + r = Cn 2 r_result1 + [Cn 2 r_pdec2 [Id 2 0], + Cn 2 r_s [Cn 2 r_append_zeros [Id 2 1, k]], + Cn 2 r_add [Cn 2 r_length [Id 2 1], k]] + in Cn 2 r_eq [r, r_constn 1 1]" + then have "recfn 2 f" by (simp add: Let_def) + have "total r_s" + by (simp add: r_s_total totalI1) + then have "total f" + unfolding f_def using Cn_total Mn_free_imp_total by (simp add: Let_def) + + have "eval ?argi [z, b] = s (e_append_zeros b (pdec1 z))" for z + using r_append_zeros \recfn 2 f\ eval_r_s by auto + then have "eval ?argi [z, b] \= the (s (e_append_zeros b (pdec1 z)))" for z + using eval_r_s r_s_total by simp + moreover have "recfn 2 ?r" using \recfn 2 f\ by auto + ultimately have r: "eval ?r [z, b] = + eval r_result1 [pdec2 z, the (s (e_append_zeros b (pdec1 z))), e_length b + pdec1 z]" + for z + by simp + then have f: "eval f [z, b] \= (if the (eval ?r [z, b]) = 1 then 0 else 1)" for z + using f_def `recfn 2 f` prim_recfn_total by (auto simp add: Let_def) + + have "\k. \ (the (s (e_append_zeros b k))) (e_length b + k) \= 0" + using s_learn_prenum learn_bc_prenum_eventually_zero by auto + then obtain k where "\ (the (s (e_append_zeros b k))) (e_length b + k) \= 0" + by auto + then obtain t where "eval r_result1 [t, the (s (e_append_zeros b k)), e_length b + k] \= Suc 0" + using r_result1_converg_phi(1) by blast + then have t: "eval r_result1 [t, the (s (e_append_zeros b k)), e_length b + k] \= Suc 0" + by simp + + let ?z = "prod_encode (k, t)" + have "eval ?r [?z, b] \= Suc 0" + using t r by (metis fst_conv prod_encode_inverse snd_conv) + with f have fzb: "eval f [?z, b] \= 0" by simp + moreover have "eval (Mn 1 f) [b] = + (if (\z. eval f ([z, b]) \= 0) + then Some (LEAST z. eval f [z, b] \= 0) + else None)" + using eval_Mn_total[of 1 f "[b]"] `total f` `recfn 2 f` by simp + ultimately have mn1f: "eval (Mn 1 f) [b] \= (LEAST z. eval f [z, b] \= 0)" + by auto + with fzb have "eval f [the (eval (Mn 1 f) [b]), b] \= 0" (is "eval f [?zz, b] \= 0") + using \total f\ \recfn 2 f\ LeastI_ex[of "%z. eval f [z, b] \= 0"] by auto + moreover have "eval f [?zz, b] \= (if the (eval ?r [?zz, b]) = 1 then 0 else 1)" + using f by simp + ultimately have "(if the (eval ?r [?zz, b]) = 1 then (0 :: nat) else 1) = 0" by auto + then have "the (eval ?r [?zz, b]) = 1" + using if_eq_eq[of "the (eval ?r [?zz, b])"] by simp + then have + "eval r_result1 + [pdec2 ?zz, the (s (e_append_zeros b (pdec1 ?zz))), e_length b + pdec1 ?zz] \= + 1" + using r r_result1_total r_result1_prim totalE + by (metis length_Cons list.size(3) numeral_3_eq_3 option.collapse) + then have *: "\ (the (s (e_append_zeros b (pdec1 ?zz)))) (e_length b + pdec1 ?zz) \= 0" + by (simp add: r_result1_some_phi) + + define Mn1f where "Mn1f = Mn 1 f" + then have "eval Mn1f [b] \= ?zz" + using mn1f by auto + moreover have "recfn 1 (Cn 1 r_pdec1 [Mn1f])" + using `recfn 2 f` Mn1f_def by simp + ultimately have "eval (Cn 1 r_pdec1 [Mn1f]) [b] = eval r_pdec1 [the (eval (Mn1f) [b])]" + by auto + then have "eval (Cn 1 r_pdec1 [Mn1f]) [b] = eval r_pdec1 [?zz]" + using Mn1f_def by blast + then have 1: "eval (Cn 1 r_pdec1 [Mn1f]) [b] \= pdec1 ?zz" + by simp + moreover have "recfn 1 (Cn 1 S [Cn 1 r_pdec1 [Mn1f]])" + using `recfn 2 f` Mn1f_def by simp + ultimately have "eval (Cn 1 S [Cn 1 r_pdec1 [Mn1f]]) [b] = + eval S [the (eval (Cn 1 r_pdec1 [Mn1f]) [b])]" + by simp + then have "eval (Cn 1 S [Cn 1 r_pdec1 [Mn1f]]) [b] = eval S [pdec1 ?zz]" + using 1 by simp + then have "eval (Cn 1 S [Cn 1 r_pdec1 [Mn1f]]) [b] \= Suc (pdec1 ?zz)" + by simp + moreover have "eval r_find_k [b] = eval (Cn 1 r_pdec1 [Mn1f]) [b]" + unfolding r_find_k_def Mn1f_def f_def by metis + ultimately have r_find_ksb: "eval r_find_k [b] \= pdec1 ?zz" + using 1 by simp + then show "eval r_find_k [b] \" by simp_all + + from r_find_ksb have "the (eval r_find_k [b]) = pdec1 ?zz" + by simp + moreover have "\ (the (s (e_append_zeros b (pdec1 ?zz)))) (e_length b + pdec1 ?zz) \= 0" + using * by simp + ultimately show "let k = the (eval r_find_k [b]) + in \ (the (s (e_append_zeros b k))) (e_length b + k) \= 0" + by simp +qed + +lemma r_find_k_total: "total r_find_k" + by (simp add: s_learn_prenum r_find_k(1) totalI1) + +text \The following function represents one iteration of the +process.\ + +abbreviation "r_next \ + Cn 3 r_snoc [Cn 3 r_append_zeros [Id 3 1, Cn 3 r_find_k [Id 3 1]], r_constn 2 1]" + +text \Using @{term r_next} we define the function @{term r_prefixes} +that computes the prefix after every iteration of the process.\ + +definition r_prefixes :: recf where + "r_prefixes \ Pr 1 r_singleton_encode r_next" + +lemma r_prefixes_recfn: "recfn 2 r_prefixes" + unfolding r_prefixes_def by simp + +lemma r_prefixes_total: "total r_prefixes" +proof - + have "recfn 3 r_next" by simp + then have "total r_next" + using `recfn 3 r_next` r_find_k_total Cn_total Mn_free_imp_total by auto + then show ?thesis + by (simp add: Mn_free_imp_total Pr_total r_prefixes_def) +qed + +lemma r_prefixes_0: "eval r_prefixes [0, j] \= list_encode [j]" + unfolding r_prefixes_def by simp + +lemma r_prefixes_Suc: + "eval r_prefixes [Suc n, j] \= + (let b = the (eval r_prefixes [n, j]) + in e_snoc (e_append_zeros b (the (eval r_find_k [b]))) 1)" +proof - + have "recfn 3 r_next" by simp + then have "total r_next" + using `recfn 3 r_next` r_find_k_total Cn_total Mn_free_imp_total by auto + have eval_next: "eval r_next [t, v, j] \= + e_snoc (e_append_zeros v (the (eval r_find_k [v]))) 1" + for t v j + using r_find_k_total `recfn 3 r_next` r_append_zeros by simp + then have "eval r_prefixes [Suc n, j] = eval r_next [n, the (eval r_prefixes [n, j]), j]" + using r_prefixes_total by (simp add: r_prefixes_def) + then show "eval r_prefixes [Suc n, j] \= + (let b = the (eval r_prefixes [n, j]) + in e_snoc (e_append_zeros b (the (eval r_find_k [b]))) 1)" + using eval_next by metis +qed + +text \Since @{term r_prefixes} is total, we can get away with +introducing a total function.\ + +definition prefixes :: "nat \ nat \ nat" where + "prefixes j t \ the (eval r_prefixes [t, j])" + +lemma prefixes_Suc: + "prefixes j (Suc t) = + e_snoc (e_append_zeros (prefixes j t) (the (eval r_find_k [prefixes j t]))) 1" + unfolding prefixes_def using r_prefixes_Suc by (simp_all add: Let_def) + +lemma prefixes_Suc_length: + "e_length (prefixes j (Suc t)) = + Suc (e_length (prefixes j t) + the (eval r_find_k [prefixes j t]))" + using e_append_zeros_length prefixes_Suc by simp + +lemma prefixes_length_mono: "e_length (prefixes j t) < e_length (prefixes j (Suc t))" + using prefixes_Suc_length by simp + +lemma prefixes_length_mono': "e_length (prefixes j t) \ e_length (prefixes j (t + d))" +proof (induction d) + case 0 + then show ?case by simp +next + case (Suc d) + then show ?case using prefixes_length_mono le_less_trans by fastforce +qed + +lemma prefixes_length_lower_bound: "e_length (prefixes j t) \ Suc t" +proof (induction t) + case 0 + then show ?case by (simp add: prefixes_def r_prefixes_0) +next + case (Suc t) + moreover have "Suc (e_length (prefixes j t)) \ e_length (prefixes j (Suc t))" + using prefixes_length_mono by (simp add: Suc_leI) + ultimately show ?case by simp +qed + +lemma prefixes_Suc_nth: + assumes "x < e_length (prefixes j t)" + shows "e_nth (prefixes j t) x = e_nth (prefixes j (Suc t)) x" +proof - + define k where "k = the (eval r_find_k [prefixes j t])" + let ?u = "e_append_zeros (prefixes j t) k" + have "prefixes j (Suc t) = + e_snoc (e_append_zeros (prefixes j t) (the (eval r_find_k [prefixes j t]))) 1" + using prefixes_Suc by simp + with k_def have "prefixes j (Suc t) = e_snoc ?u 1" + by simp + then have "e_nth (prefixes j (Suc t)) x = e_nth (e_snoc ?u 1) x" + by simp + moreover have "x < e_length ?u" + using assms e_append_zeros_length by auto + ultimately have "e_nth (prefixes j (Suc t)) x = e_nth ?u x" + using e_nth_snoc_small by simp + moreover have "e_nth ?u x = e_nth (prefixes j t) x" + using assms e_nth_append_zeros by simp + ultimately show "e_nth (prefixes j t) x = e_nth (prefixes j (Suc t)) x" + by simp +qed + +lemma prefixes_Suc_last: "e_nth (prefixes j (Suc t)) (e_length (prefixes j (Suc t)) - 1) = 1" + using prefixes_Suc by simp + +lemma prefixes_le_nth: + assumes "x < e_length (prefixes j t)" + shows "e_nth (prefixes j t) x = e_nth (prefixes j (t + d)) x" +proof (induction d) + case 0 + then show ?case by simp +next + case (Suc d) + have "x < e_length (prefixes j (t + d))" + using s_learn_prenum assms prefixes_length_mono' + by (simp add: less_eq_Suc_le order_trans_rules(23)) + then have "e_nth (prefixes j (t + d)) x = e_nth (prefixes j (t + Suc d)) x" + using prefixes_Suc_nth by simp + with Suc show ?case by simp +qed + +text \The numbering $\psi$ is defined via @{term[names_short] prefixes}.\ + +definition psi :: partial2 ("\") where + "\ j x \ Some (e_nth (prefixes j (Suc x)) x)" + +lemma psi_in_R2: "\ \ \\<^sup>2" +proof + define r where "r \ Cn 2 r_nth [Cn 2 r_prefixes [Cn 2 S [Id 2 1], Id 2 0], Id 2 1]" + then have "recfn 2 r" + using r_prefixes_recfn by simp + then have "eval r [j, x] \= e_nth (prefixes j (Suc x)) x" for j x + unfolding r_def prefixes_def using r_prefixes_total r_prefixes_recfn e_nth by simp + then have "eval r [j, x] = \ j x" for j x + unfolding psi_def by simp + then show "\ \ \

\<^sup>2" + using `recfn 2 r` by auto + show "total2 \" + unfolding psi_def by auto +qed + +lemma psi_eq_nth_prefixes: + assumes "x < e_length (prefixes j t)" + shows "\ j x \= e_nth (prefixes j t) x" +proof (cases "Suc x < t") + case True + have "x \ e_length (prefixes j x)" + using prefixes_length_lower_bound by (simp add: Suc_leD) + also have "... < e_length (prefixes j (Suc x))" + using prefixes_length_mono s_learn_prenum by simp + finally have "x < e_length (prefixes j (Suc x))" . + with True have "e_nth (prefixes j (Suc x)) x = e_nth (prefixes j t) x" + using prefixes_le_nth[of x j "Suc x" "t - Suc x"] by simp + then show ?thesis using psi_def by simp +next + case False + then have "e_nth (prefixes j (Suc x)) x = e_nth (prefixes j t) x" + using prefixes_le_nth[of x j t "Suc x - t"] assms by simp + then show ?thesis using psi_def by simp +qed + +lemma psi_at_0: "\ j 0 \= j" + using psi_eq_nth_prefixes[of 0 j 0] prefixes_length_lower_bound[of 0 j] + by (simp add: prefixes_def r_prefixes_0) + +text \The prefixes output by the process @{term[names_short] "prefixes j"} are +indeed prefixes of $\psi_j$.\ + +lemma prefixes_init_psi: "\ j \ (e_length (prefixes j (Suc t)) - 1) = prefixes j (Suc t)" +proof (rule initI[of "prefixes j (Suc t)"]) + let ?e = "prefixes j (Suc t)" + show "e_length ?e > 0" + using prefixes_length_lower_bound[of "Suc t" j] by auto + show "\x. x < e_length ?e \ \ j x \= e_nth ?e x" + using prefixes_Suc_nth psi_eq_nth_prefixes by simp +qed + +text \Every prefix of $\psi_j$ generated by the process +@{term[names_short] "prefixes j"} (except for the initial one) is of the form +$b0^k1$. But $k$ is chosen such that $\varphi_{S(b0^k)}(|b|+k) = 0 \neq 1 = +b0^k1_{|b|+k}$. Therefore the hypothesis $S(b0^k)$ is incorrect for +$\psi_j$.\ + +lemma hyp_wrong_at_last: + "\ (the (s (e_butlast (prefixes j (Suc t))))) (e_length (prefixes j (Suc t)) - 1) \ + \ j (e_length (prefixes j (Suc t)) - 1)" + (is "?lhs \ ?rhs") +proof - + let ?b = "prefixes j t" + let ?k = "the (eval r_find_k [?b])" + let ?x = "e_length (prefixes j (Suc t)) - 1" + have "e_butlast (prefixes j (Suc t)) = e_append_zeros ?b ?k" + using s_learn_prenum prefixes_Suc by simp + then have "?lhs = \ (the (s (e_append_zeros ?b ?k))) ?x" + by simp + moreover have "?x = e_length ?b + ?k" + using prefixes_Suc_length by simp + ultimately have "?lhs = \ (the (s (e_append_zeros ?b ?k))) (e_length ?b + ?k)" + by simp + then have "?lhs \= 0" + using r_find_k(2) r_s_total s_learn_prenum by metis + moreover have "?x < e_length (prefixes j (Suc t))" + using prefixes_length_lower_bound le_less_trans linorder_not_le s_learn_prenum + by fastforce + ultimately have "?rhs \= e_nth (prefixes j (Suc t)) ?x" + using psi_eq_nth_prefixes[of ?x j "Suc t"] by simp + moreover have "e_nth (prefixes j (Suc t)) ?x = 1" + using prefixes_Suc prefixes_Suc_last by simp + ultimately have "?rhs \= 1" by simp + with `?lhs \= 0` show ?thesis by simp +qed + +corollary hyp_wrong: "\ (the (s (e_butlast (prefixes j (Suc t))))) \ \ j" + using hyp_wrong_at_last[of j t] by auto + +text \For all $j$, the strategy $S$ outputs infinitely many wrong hypotheses for +$\psi_j$\ + +lemma infinite_hyp_wrong: "\m>n. \ (the (s (\ j \ m))) \ \ j" +proof - + let ?b = "prefixes j (Suc (Suc n))" + let ?bb = "e_butlast ?b" + have len_b: "e_length ?b > Suc (Suc n)" + using prefixes_length_lower_bound by (simp add: Suc_le_lessD) + then have len_bb: "e_length ?bb > Suc n" by simp + define m where "m = e_length ?bb - 1" + with len_bb have "m > n" by simp + have "\ j \ m = ?bb" + proof - + have "\ j \ (e_length ?b - 1) = ?b" + using prefixes_init_psi by simp + then have "\ j \ (e_length ?b - 2) = ?bb" + using init_butlast_init psi_in_R2 R2_proj_R1 R1_imp_total1 len_bb length_init + by (metis Suc_1 diff_diff_left length_butlast length_greater_0_conv + list.size(3) list_decode_encode not_less0 plus_1_eq_Suc) + then show ?thesis by (metis diff_Suc_1 length_init m_def) + qed + moreover have "\ (the (s ?bb)) \ \ j" + using hyp_wrong by simp + ultimately have "\ (the (s (\ j \ m))) \ \ j" + by simp + with `m > n` show ?thesis by auto +qed + +lemma U0_V0_not_learn_bc: "\ learn_bc \ (U\<^sub>0 \ V\<^sub>0) s" +proof - + obtain j where j: "\ j = \ j" + using R2_imp_P2 kleene_fixed_point psi_in_R2 by blast + moreover have "\m>n. \ (the (s ((\ j) \ m))) \ \ j" for n + using infinite_hyp_wrong[of _ j] by simp + ultimately have "\ learn_bc \ {\ j} s" + using infinite_hyp_wrong_not_BC by simp + moreover have "\ j \ V\<^sub>0" + proof - + have "\ j \ \" (is "?f \ \") + using psi_in_R2 by simp + moreover have "\ (the (?f 0)) = ?f" + using j psi_at_0[of j] by simp + ultimately show ?thesis by (simp add: V0_def) + qed + ultimately show "\ learn_bc \ (U\<^sub>0 \ V\<^sub>0) s" + using learn_bc_closed_subseteq by auto +qed + +end + +lemma U0_V0_not_in_BC: "U\<^sub>0 \ V\<^sub>0 \ BC" +proof + assume in_BC: "U\<^sub>0 \ V\<^sub>0 \ BC" + then have "U\<^sub>0 \ V\<^sub>0 \ BC_wrt \" + using BC_wrt_phi_eq_BC by simp + then obtain s where "learn_bc \ (U\<^sub>0 \ V\<^sub>0) s" + using BC_wrt_def by auto + then obtain s' where s': "s' \ \" "learn_bc \ (U\<^sub>0 \ V\<^sub>0) s'" + using lemma_R_for_BC_simple by blast + then have learn_U0: "learn_bc \ U\<^sub>0 s'" + using learn_bc_closed_subseteq[of \ "U\<^sub>0 \ V\<^sub>0" "s'"] by simp + then interpret r1_bc s' + by (simp add: r1_bc_def s'(1)) + have "\ learn_bc \ (U\<^sub>0 \ V\<^sub>0) s'" + using learn_bc_closed_subseteq U0_V0_not_learn_bc by simp + with s'(2) show False by simp +qed + +theorem R1_not_in_BC: "\ \ BC" +proof - + have "U\<^sub>0 \ V\<^sub>0 \ \" + using V0_def U0_in_NUM by auto + then show ?thesis + using U0_V0_not_in_BC BC_closed_subseteq by auto +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/ROOT b/thys/Inductive_Inference/ROOT new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/ROOT @@ -0,0 +1,21 @@ +chapter AFP + +session Inductive_Inference (AFP) = HOL + + options [timeout = 600] + sessions + "HOL-Library" + theories + Partial_Recursive + Universal + Standard_Results + Inductive_Inference_Basics + CP_FIN_NUM + CONS_LIM + Lemma_R + LIM_BC + TOTAL_CONS + R1_BC + Union + document_files + "root.tex" + "root.bib" diff --git a/thys/Inductive_Inference/Standard_Results.thy b/thys/Inductive_Inference/Standard_Results.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Standard_Results.thy @@ -0,0 +1,1594 @@ +theory Standard_Results + imports Universal +begin + +section \Kleene normal form and the number of $\mu$-operations\ + +text \Kleene's original normal form theorem~\cite{Kleene43} states that +every partial recursive $f$ can be expressed as $f(x) = u(\mu y[t(i, x, y) = +0]$ for some $i$, where $u$ and $t$ are specially crafted primitive recursive +functions tied to Kleene's definition of partial recursive functions. +Rogers~\cite[p.~29f.]{Rogers87} relaxes the theorem by allowing $u$ and $t$ +to be any primitive recursive functions of arity one and three, respectively. +Both versions require a separate $t$-predicate for every arity. We will show +a unified version for all arities by treating $x$ as an encoded list of +arguments. + +Our universal function @{thm[display,names_short] "r_univ_def"} can represent +all partial recursive functions (see theorem @{thm[source] r_univ}). Moreover +@{term "r_result"}, @{term "r_dec"}, and @{term "r_not"} are primitive +recursive. As such @{term r_univ} could almost serve as the right-hand side +$u(\mu y[t(i, x, y) = 0]$. Its only flaw is that the outer function, the +composition of @{term r_dec} and @{term r_result}, is ternary rather than +unary.\ + +lemma r_univ_almost_kleene_nf: + "r_univ \ + (let u = Cn 3 r_dec [r_result]; + t = Cn 3 r_not [r_result] + in Cn 2 u [Mn 2 t, Id 2 0, Id 2 1])" + unfolding r_univ_def by (rule exteqI) simp_all + +text \We can remedy the wrong arity with some encoding and +projecting.\ + +definition r_nf_t :: recf where + "r_nf_t \ Cn 3 r_and + [Cn 3 r_eq [Cn 3 r_pdec2 [Id 3 0], Cn 3 r_prod_encode [Id 3 1, Id 3 2]], + Cn 3 r_not + [Cn 3 r_result + [Cn 3 r_pdec1 [Id 3 0], + Cn 3 r_pdec12 [Id 3 0], + Cn 3 r_pdec22 [Id 3 0]]]]" + +lemma r_nf_t_prim: "prim_recfn 3 r_nf_t" + unfolding r_nf_t_def by simp + +definition r_nf_u :: recf where + "r_nf_u \ Cn 1 r_dec [Cn 1 r_result [r_pdec1, r_pdec12, r_pdec22]]" + +lemma r_nf_u_prim: "prim_recfn 1 r_nf_u" + unfolding r_nf_u_def by simp + +lemma r_nf_t_0: + assumes "eval r_result [pdec1 y, pdec12 y, pdec22 y] \\ 0" + and "pdec2 y = prod_encode (i, x)" + shows "eval r_nf_t [y, i, x] \= 0" + unfolding r_nf_t_def using assms by auto + +lemma r_nf_t_1: + assumes "eval r_result [pdec1 y, pdec12 y, pdec22 y] \= 0 \ pdec2 y \ prod_encode (i, x)" + shows "eval r_nf_t [y, i, x] \= 1" + unfolding r_nf_t_def using assms r_result_total by auto + +text \The next function is just as universal as @{term r_univ}, but +satisfies the conditions of the Kleene normal form theorem because the +outer funtion @{term r_nf_u} is unary.\ + +definition "r_normal_form \ Cn 2 r_nf_u [Mn 2 r_nf_t]" + +lemma r_normal_form_recfn: "recfn 2 r_normal_form" + unfolding r_normal_form_def using r_nf_u_prim r_nf_t_prim by simp + +lemma r_univ_exteq_r_normal_form: "r_univ \ r_normal_form" +proof (rule exteqI) + show arity: "arity r_univ = arity r_normal_form" + using r_normal_form_recfn by simp + show "eval r_univ xs = eval r_normal_form xs" if "length xs = arity r_univ" for xs + proof - + have "length xs = 2" + using that by simp + then obtain i x where ix: "[i, x] = xs" + by (metis length_0_conv length_Suc_conv numeral_2_eq_2) + have "eval r_univ [i, x] = eval r_normal_form [i, x]" + proof (cases "\t. eval r_result [t, i, x] \= 0") + case True + then have "eval r_univ [i, x] \" + unfolding r_univ_def by simp + moreover have "eval r_normal_form [i, x] \" + proof - + have "eval r_nf_t [y, i, x] \= 1" for y + using True r_nf_t_1[of y i x] by fastforce + then show ?thesis + unfolding r_normal_form_def using r_nf_u_prim r_nf_t_prim by simp + qed + ultimately show ?thesis by simp + next + case False + then have "\t. eval r_result [t, i, x] \\ 0" + by (simp add: r_result_total) + then obtain t where "eval r_result [t, i, x] \\ 0" + by auto + then have "eval r_nf_t [triple_encode t i x, i, x] \= 0" + using r_nf_t_0 by simp + then obtain y where y: "eval (Mn 2 r_nf_t) [i, x] \= y" + using r_nf_t_prim Mn_free_imp_total by fastforce + then have "eval r_nf_t [y, i, x] \= 0" + using r_nf_t_prim Mn_free_imp_total eval_Mn_convergE(2)[of 2 r_nf_t "[i, x]" y] + by simp + then have r_result: "eval r_result [pdec1 y, pdec12 y, pdec22 y] \\ 0" + and pdec2: "pdec2 y = prod_encode (i, x)" + using r_nf_t_0[of y i x] r_nf_t_1[of y i x] r_result_total by auto + then have "eval r_result [pdec1 y, i, x] \\ 0" + by simp + then obtain v where v: + "eval r_univ [pdec12 y, pdec22 y] \= v" + "eval r_result [pdec1 y, pdec12 y, pdec22 y] \= Suc v" + using r_result r_result_bivalent'[of "pdec12 y" "pdec22 y" _ "pdec1 y"] + r_result_diverg'[of "pdec12 y" "pdec22 y" "pdec1 y"] + by auto + + have "eval r_normal_form [i, x] = eval r_nf_u [y]" + unfolding r_normal_form_def using y r_nf_t_prim r_nf_u_prim by simp + also have "... = eval r_dec [the (eval (Cn 1 r_result [r_pdec1, r_pdec12, r_pdec22]) [y])]" + unfolding r_nf_u_def using r_result by simp + also have "... = eval r_dec [Suc v]" + using v by simp + also have "... \= v" + by simp + finally have "eval r_normal_form [i, x] \= v" . + moreover have "eval r_univ [i, x] \= v" + using v(1) pdec2 by simp + ultimately show ?thesis by simp + qed + with ix show ?thesis by simp + qed +qed + +theorem normal_form: + assumes "recfn n f" + obtains i where "\x. e_length x = n \ eval r_normal_form [i, x] = eval f (list_decode x)" +proof - + have "eval r_normal_form [encode f, x] = eval f (list_decode x)" if "e_length x = n" for x + using r_univ_exteq_r_normal_form assms that exteq_def r_univ' by auto + then show ?thesis using that by auto +qed + +text \As a consequence of the normal form theorem every partial +recursive function can be represented with exactly one application of the +$\mu$-operator.\ + +fun count_Mn :: "recf \ nat" where + "count_Mn Z = 0" +| "count_Mn S = 0" +| "count_Mn (Id m n) = 0" +| "count_Mn (Cn n f gs) = count_Mn f + sum_list (map count_Mn gs)" +| "count_Mn (Pr n f g) = count_Mn f + count_Mn g" +| "count_Mn (Mn n f) = Suc (count_Mn f)" + +lemma count_Mn_zero_iff_prim: "count_Mn f = 0 \ Mn_free f" + by (induction f) auto + +text \The normal form has only one $\mu$-recursion.\ + +lemma count_Mn_normal_form: "count_Mn r_normal_form = 1" + unfolding r_normal_form_def r_nf_u_def r_nf_t_def using count_Mn_zero_iff_prim by simp + +lemma one_Mn_suffices: + assumes "recfn n f" + shows "\g. count_Mn g = 1 \ g \ f" +proof - + have "n > 0" + using assms wellf_arity_nonzero by auto + obtain i where i: + "\x. e_length x = n \ eval r_normal_form [i, x] = eval f (list_decode x)" + using normal_form[OF assms(1)] by auto + define g where "g \ Cn n r_normal_form [r_constn (n - 1) i, r_list_encode (n - 1)]" + then have "recfn n g" + using r_normal_form_recfn `n > 0` by simp + then have "g \ f" + using g_def r_list_encode i assms by (intro exteqI) simp_all + moreover have "count_Mn g = 1" + unfolding g_def using count_Mn_normal_form count_Mn_zero_iff_prim by simp + ultimately show ?thesis by auto +qed + +text \The previous lemma could have been obtained without @{term +"r_normal_form"} directly from @{term "r_univ"}.\ + + +section \The $s$-$m$-$n$ theorem\ + +text \For all $m, n > 0$ there is an $(m + 1)$-ary primitive recursive +function $s^m_n$ with +\[ + \varphi_p^{(m + n)}(c_1, \dots,c_m, x_1, \dots, x_n) = + \varphi_{s^m_n(p, c_1, \dots,c_m)}^{(n)}(x_1, \dots, x_n) +\] +for all $p, c_1, \ldots, c_m, x_1, \ldots, x_n$. Here, $\varphi^{(n)}$ is a +function universal for $n$-ary partial recursive functions, which we will +represent by @{term "r_universal n"}\ + +text \The $s^m_n$ functions compute codes of functions. We start simple: +computing codes of the unary constant functions.\ + +fun code_const1 :: "nat \ nat" where + "code_const1 0 = 0" +| "code_const1 (Suc c) = quad_encode 3 1 1 (singleton_encode (code_const1 c))" + +lemma code_const1: "code_const1 c = encode (r_const c)" + by (induction c) simp_all + +definition "r_code_const1_aux \ + Cn 3 r_prod_encode + [r_constn 2 3, + Cn 3 r_prod_encode + [r_constn 2 1, + Cn 3 r_prod_encode + [r_constn 2 1, Cn 3 r_singleton_encode [Id 3 1]]]]" + +lemma r_code_const1_aux_prim: "prim_recfn 3 r_code_const1_aux" + by (simp_all add: r_code_const1_aux_def) + +lemma r_code_const1_aux: + "eval r_code_const1_aux [i, r, c] \= quad_encode 3 1 1 (singleton_encode r)" + by (simp add: r_code_const1_aux_def) + +definition "r_code_const1 \ r_shrink (Pr 1 Z r_code_const1_aux)" + +lemma r_code_const1_prim: "prim_recfn 1 r_code_const1" + by (simp_all add: r_code_const1_def r_code_const1_aux_prim) + +lemma r_code_const1: "eval r_code_const1 [c] \= code_const1 c" +proof - + let ?h = "Pr 1 Z r_code_const1_aux" + have "eval ?h [c, x] \= code_const1 c" for x + using r_code_const1_aux r_code_const1_def + by (induction c) (simp_all add: r_code_const1_aux_prim) + then show ?thesis by (simp add: r_code_const1_def r_code_const1_aux_prim) +qed + +text \Functions that compute codes of higher-arity constant functions:\ + +definition code_constn :: "nat \ nat \ nat" where + "code_constn n c \ + if n = 1 then code_const1 c + else quad_encode 3 n (code_const1 c) (singleton_encode (triple_encode 2 n 0))" + +lemma code_constn: "code_constn (Suc n) c = encode (r_constn n c)" + unfolding code_constn_def using code_const1 r_constn_def + by (cases "n = 0") simp_all + +definition r_code_constn :: "nat \ recf" where + "r_code_constn n \ + if n = 1 then r_code_const1 + else + Cn 1 r_prod_encode + [r_const 3, + Cn 1 r_prod_encode + [r_const n, + Cn 1 r_prod_encode + [r_code_const1, + Cn 1 r_singleton_encode + [Cn 1 r_prod_encode + [r_const 2, Cn 1 r_prod_encode [r_const n, Z]]]]]]" + +lemma r_code_constn_prim: "prim_recfn 1 (r_code_constn n)" + by (simp_all add: r_code_constn_def r_code_const1_prim) + +lemma r_code_constn: "eval (r_code_constn n) [c] \= code_constn n c" + by (auto simp add: r_code_constn_def r_code_const1 code_constn_def r_code_const1_prim) + +text \Computing codes of $m$-ary projections:\ + +definition code_id :: "nat \ nat \ nat" where + "code_id m n \ triple_encode 2 m n" + +lemma code_id: "encode (Id m n) = code_id m n" + unfolding code_id_def by simp + +text \The functions $s^m_n$ are represented by the following function. +The value $m$ corresponds to the length of @{term "cs"}.\ + +definition smn :: "nat \ nat \ nat list \ nat" where + "smn n p cs \ quad_encode + 3 + n + (encode (r_universal (n + length cs))) + (list_encode (code_constn n p # map (code_constn n) cs @ map (code_id n) [0.. 0" + shows "smn n p cs = encode + (Cn n + (r_universal (n + length cs)) + (r_constn (n - 1) p # map (r_constn (n - 1)) cs @ (map (Id n) [0..The next function is to help us define @{typ recf}s corresponding +to the $s^m_n$ functions. It maps $m + 1$ arguments $p, c_1, \ldots, c_m$ to +an encoded list of length $m + n + 1$. The list comprises the $m + 1$ codes +of the $n$-ary constants $p, c_1, \ldots, c_m$ and the $n$ codes for all +$n$-ary projections.\ + +definition r_smn_aux :: "nat \ nat \ recf" where + "r_smn_aux n m \ + Cn (Suc m) + (r_list_encode (m + n)) + (map (\i. Cn (Suc m) (r_code_constn n) [Id (Suc m) i]) [0..i. r_constn m (code_id n i)) [0.. 0 \ prim_recfn (Suc m) (r_smn_aux n m)" + by (auto simp add: r_smn_aux_def r_code_constn_prim) + +lemma r_smn_aux: + assumes "n > 0" and "length cs = m" + shows "eval (r_smn_aux n m) (p # cs) \= + list_encode (map (code_constn n) (p # cs) @ map (code_id n) [0..g. eval g (p # cs)) ?xs = map Some (map (code_constn n) (p # cs))" + proof (intro nth_equalityI) + show len: "length (map (\g. eval g (p # cs)) ?xs) = + length (map Some (map (code_constn n) (p # cs)))" + by (simp add: assms(2)) + + have "map (\g. eval g (p # cs)) ?xs ! i = map Some (map (code_constn n) (p # cs)) ! i" + if "i < Suc m" for i + proof - + have "map (\g. eval g (p # cs)) ?xs ! i = (\g. eval g (p # cs)) (?xs ! i)" + using len_xs that by (metis nth_map) + also have "... = eval (Cn (Suc m) (r_code_constn n) [Id (Suc m) i]) (p # cs)" + using that len_xs + by (metis (no_types, lifting) add.left_neutral length_map nth_map nth_upt) + also have "... = eval (r_code_constn n) [the (eval (Id (Suc m) i) (p # cs))]" + using r_code_constn_prim assms(2) that by simp + also have "... = eval (r_code_constn n) [(p # cs) ! i]" + using len that by simp + finally have "map (\g. eval g (p # cs)) ?xs ! i \= code_constn n ((p # cs) ! i)" + using r_code_constn by simp + then show ?thesis + using len_xs len that by (metis length_map nth_map) + qed + moreover have "length (map (\g. eval g (p # cs)) ?xs) = Suc m" by simp + ultimately show "\i. i < length (map (\g. eval g (p # cs)) ?xs) \ + map (\g. eval g (p # cs)) ?xs ! i = + map Some (map (code_constn n) (p # cs)) ! i" + by simp + qed + moreover have "map (\g. eval g (p # cs)) ?ys = map Some (map (code_id n) [0..g. eval g (p # cs)) (?xs @ ?ys) = + map Some (map (code_constn n) (p # cs) @ map (code_id n) [0..x. the (eval x (p # cs))) (?xs @ ?ys) = + map the (map (\x. eval x (p # cs)) (?xs @ ?ys))" + by simp + ultimately have *: "map (\g. the (eval g (p # cs))) (?xs @ ?ys) = + (map (code_constn n) (p # cs) @ map (code_id n) [0..ig. eval g (p # cs)) ?xs ! i" + by (metis nth_map) + then have + "\ii" + using assms map_xs by (metis length_map nth_map option.simps(3)) + then have xs_converg: "\z\set ?xs. eval z (p # cs) \" + by (metis in_set_conv_nth) + + have "\ix. eval x (p # cs)) ?ys ! i" + by simp + then have + "\ii" + by simp + then have "\z\set (?xs @ ?ys). eval z (p # cs) \" + using xs_converg by auto + moreover have "recfn (length (p # cs)) (Cn (Suc m) (r_list_encode (m + n)) (?xs @ ?ys))" + using assms r_code_constn_prim by auto + ultimately have "eval (r_smn_aux n m) (p # cs) = + eval (r_list_encode (m + n)) (map (\g. the (eval g (p # cs))) (?xs @ ?ys))" + unfolding r_smn_aux_def using assms by simp + then have "eval (r_smn_aux n m) (p # cs) = + eval (r_list_encode (m + n)) (map (code_constn n) (p # cs) @ map (code_id n) [0..For all $m, n > 0$, the @{typ recf} corresponding to $s^m_n$ is +given by the next function.\ + +definition r_smn :: "nat \ nat \ recf" where + "r_smn n m \ + Cn (Suc m) r_prod_encode + [r_constn m 3, + Cn (Suc m) r_prod_encode + [r_constn m n, + Cn (Suc m) r_prod_encode + [r_constn m (encode (r_universal (n + m))), r_smn_aux n m]]]" + +lemma r_smn_prim [simp]: "n > 0 \ prim_recfn (Suc m) (r_smn n m)" + by (simp_all add: r_smn_def r_smn_aux_prim) + +lemma r_smn: + assumes "n > 0" and "length cs = m" + shows "eval (r_smn n m) (p # cs) \= smn n p cs" + using assms r_smn_def r_smn_aux smn_def r_smn_aux_prim by simp + +lemma map_eval_Some_the: + assumes "map (\g. eval g xs) gs = map Some ys" + shows "map (\g. the (eval g xs)) gs = ys" + using assms + by (metis (no_types, lifting) length_map nth_equalityI nth_map option.sel) + +text \The essential part of the $s$-$m$-$n$ theorem: For all $m, n > 0$ +the function $s^m_n$ satisfies +\[ + \varphi_p^{(m + n)}(c_1, \dots,c_m, x_1, \dots, x_n) = + \varphi_{s^m_n(p, c_1, \dots,c_m)}^{(n)}(x_1, \dots, x_n) +\] for all $p, c_i, x_j$.\ + +lemma smn_lemma: + assumes "n > 0" and len_cs: "length cs = m" and len_xs: "length xs = n" + shows "eval (r_universal (m + n)) (p # cs @ xs) = + eval (r_universal n) ((the (eval (r_smn n m) (p # cs))) # xs)" +proof - + let ?s = "r_smn n m" + let ?f = "Cn n + (r_universal (n + length cs)) + (r_constn (n - 1) p # map (r_constn (n - 1)) cs @ (map (Id n) [0..= smn n p cs" + using assms r_smn by simp + then have eval_s: "eval ?s (p # cs) \= encode ?f" + by (simp add: assms(1) smn) + + have "recfn n ?f" + using len_cs assms by auto + then have *: "eval (r_universal n) ((encode ?f) # xs) = eval ?f xs" + using r_universal[of ?f n, OF _ len_xs] by simp + + let ?gs = "r_constn (n - 1) p # map (r_constn (n - 1)) cs @ map (Id n) [0..g\set ?gs. eval g xs \" + using len_cs len_xs assms by auto + then have "eval ?f xs = + eval (r_universal (n + length cs)) (map (\g. the (eval g xs)) ?gs)" + using len_cs len_xs assms `recfn n ?f` by simp + then have "eval ?f xs = eval (r_universal (m + n)) (map (\g. the (eval g xs)) ?gs)" + by (simp add: len_cs add.commute) + then have "eval (r_universal n) ((the (eval ?s (p # cs))) # xs) = + eval (r_universal (m + n)) (map (\g. the (eval g xs)) ?gs)" + using eval_s * by simp + moreover have "map (\g. the (eval g xs)) ?gs = p # cs @ xs" + proof (intro nth_equalityI) + show "length (map (\g. the (eval g xs)) ?gs) = length (p # cs @ xs)" + by (simp add: len_xs) + have len: "length (map (\g. the (eval g xs)) ?gs) = Suc (m + n)" + by (simp add: len_cs) + moreover have "map (\g. the (eval g xs)) ?gs ! i = (p # cs @ xs) ! i" + if "i < Suc (m + n)" for i + proof - + from that consider "i = 0" | "i > 0 \ i < Suc m" | "Suc m \ i \ i < Suc (m + n)" + using not_le_imp_less by auto + then show ?thesis + proof (cases) + case 1 + then show ?thesis using assms(1) len_xs by simp + next + case 2 + then have "?gs ! i = (map (r_constn (n - 1)) cs) ! (i - 1)" + using len_cs + by (metis One_nat_def Suc_less_eq Suc_pred length_map + less_numeral_extra(3) nth_Cons' nth_append) + then have "map (\g. the (eval g xs)) ?gs ! i = + (\g. the (eval g xs)) ((map (r_constn (n - 1)) cs) ! (i - 1))" + using len by (metis length_map nth_map that) + also have "... = the (eval ((r_constn (n - 1) (cs ! (i - 1)))) xs)" + using 2 len_cs by auto + also have "... = cs ! (i - 1)" + using r_constn len_xs assms(1) by simp + also have "... = (p # cs @ xs) ! i" + using 2 len_cs + by (metis diff_Suc_1 less_Suc_eq_0_disj less_numeral_extra(3) nth_Cons' nth_append) + finally show ?thesis . + next + case 3 + then have "?gs ! i = (map (Id n) [0..g. the (eval g xs)) ?gs ! i = + (\g. the (eval g xs)) ((map (Id n) [0..g. the (eval g xs)) ?gs ! i = (p # cs @ xs) ! i" + if "i < length (map (\g. the (eval g xs)) ?gs)" for i + using that by simp + qed + ultimately show ?thesis by simp +qed + +theorem smn_theorem: + assumes "n > 0" + shows "\s. prim_recfn (Suc m) s \ + (\p cs xs. length cs = m \ length xs = n \ + eval (r_universal (m + n)) (p # cs @ xs) = + eval (r_universal n) ((the (eval s (p # cs))) # xs))" + using smn_lemma exI[of _ "r_smn n m"] assms by simp + +text \For every numbering, that is, binary partial recursive function, +$\psi$ there is a total recursive function $c$ that translates $\psi$-indices +into $\varphi$-indices.\ + +lemma numbering_translation: + assumes "recfn 2 psi" + obtains c where + "recfn 1 c" + "total c" + "\i x. eval psi [i, x] = eval r_phi [the (eval c [i]), x]" +proof - + let ?p = "encode psi" + define c where "c = Cn 1 (r_smn 1 1) [r_const ?p, Id 1 0]" + then have "prim_recfn 1 c" by simp + moreover from this have "total c" + by auto + moreover have "eval r_phi [the (eval c [i]), x] = eval psi [i, x]" for i x + proof - + have "eval c [i] = eval (r_smn 1 1) [?p, i]" + using c_def by simp + then have "eval (r_universal 1) [the (eval c [i]), x] = + eval (r_universal 1) [the (eval (r_smn 1 1) [?p, i]), x]" + by simp + also have "... = eval (r_universal (1 + 1)) (?p # [i] @ [x])" + using smn_lemma[of 1 "[i]" 1 "[x]" ?p] by simp + also have "... = eval (r_universal 2) [?p, i, x]" + by (metis append_eq_Cons_conv nat_1_add_1) + also have "... = eval psi [i, x]" + using r_universal[OF assms, of "[i, x]"] by simp + finally have "eval (r_universal 1) [the (eval c [i]), x] = eval psi [i, x]" . + then show ?thesis using r_phi_def by simp + qed + ultimately show ?thesis using that by auto +qed + + +section \Fixed-point theorems\ + +text \Fixed-point theorems (also known as recursion theorems) come in +many shapes. We prove the minimum we need for Chapter~\ref{c:iirf}.\ + + +subsection \Rogers's fixed-point theorem\ + +text \In this section we prove a theorem that Rogers~\cite{Rogers87} +credits to Kleene, but admits that it is a special case and not the original +formulation. We follow Wikipedia~\cite{wiki-krt} and call it the Rogers's +fixed-point theorem.\ + +lemma s11_inj: "inj (\x. smn 1 p [x])" +proof + fix x\<^sub>1 x\<^sub>2 :: nat + assume "smn 1 p [x\<^sub>1] = smn 1 p [x\<^sub>2]" + then have "list_encode [code_constn 1 p, code_constn 1 x\<^sub>1, code_id 1 0] = + list_encode [code_constn 1 p, code_constn 1 x\<^sub>2, code_id 1 0]" + using smn_def by (simp add: prod_encode_eq) + then have "[code_constn 1 p, code_constn 1 x\<^sub>1, code_id 1 0] = + [code_constn 1 p, code_constn 1 x\<^sub>2, code_id 1 0]" + using list_decode_encode by metis + then have "code_constn 1 x\<^sub>1 = code_constn 1 x\<^sub>2" by simp + then show "x\<^sub>1 = x\<^sub>2" + using code_const1 code_constn code_constn_def encode_injective r_constn + by (metis One_nat_def length_Cons list.size(3) option.simps(1)) +qed + +definition "r_univuniv \ Cn 2 r_phi [Cn 2 r_phi [Id 2 0, Id 2 0], Id 2 1]" + +lemma r_univuniv_recfn: "recfn 2 r_univuniv" + by (simp add: r_univuniv_def) + +lemma r_univuniv_converg: + assumes "eval r_phi [x, x] \" + shows "eval r_univuniv [x, y] = eval r_phi [the (eval r_phi [x, x]), y]" + unfolding r_univuniv_def using assms r_univuniv_recfn r_phi_recfn by simp + +text \Strictly speaking this is a generalization of Rogers's theorem in +that it shows the existence of infinitely many fixed-points. In conventional +terms it says that for every total recursive $f$ and $k \in \mathbb{N}$ there is +an $n \geq k$ with $\varphi_n = \varphi_{f(n)}$.\ + +theorem rogers_fixed_point_theorem: + fixes k :: nat + assumes "recfn 1 f" and "total f" + shows "\n\k. \x. eval r_phi [n, x] = eval r_phi [the (eval f [n]), x]" +proof - + let ?p = "encode r_univuniv" + define h where "h = Cn 1 (r_smn 1 1) [r_const ?p, Id 1 0]" + then have "prim_recfn 1 h" + by simp + then have "total h" + by blast + have "eval h [x] = eval (Cn 1 (r_smn 1 1) [r_const ?p, Id 1 0]) [x]" for x + unfolding h_def by simp + then have h: "the (eval h [x]) = smn 1 ?p [x]" for x + by (simp add: r_smn) + + have "eval r_phi [the (eval h [x]), y] = eval r_univuniv [x, y]" for x y + proof - + have "eval r_phi [the (eval h [x]), y] = eval r_phi [smn 1 ?p [x], y]" + using h by simp + also have "... = eval r_phi [the (eval (r_smn 1 1) [?p, x]), y]" + by (simp add: r_smn) + also have "... = eval (r_universal 2) [?p, x, y]" + using r_phi_def smn_lemma[of 1 "[x]" 1 "[y]" ?p] + by (metis Cons_eq_append_conv One_nat_def Suc_1 length_Cons + less_numeral_extra(1) list.size(3) plus_1_eq_Suc) + finally show "eval r_phi [the (eval h [x]), y] = eval r_univuniv [x, y]" + using r_universal r_univuniv_recfn by simp + qed + then have *: "eval r_phi [the (eval h [x]), y] = eval r_phi [the (eval r_phi [x, x]), y]" + if "eval r_phi [x, x] \" for x y + using r_univuniv_converg that by simp + + let ?fh = "Cn 1 f [h]" + have "recfn 1 ?fh" + using `prim_recfn 1 h` assms by simp + then have "infinite {r. recfn 1 r \ r \ ?fh}" + using exteq_infinite[of ?fh 1] by simp + then have "infinite (encode ` {r. recfn 1 r \ r \ ?fh})" (is "infinite ?E") + using encode_injective by (meson finite_imageD inj_onI) + then have "infinite ((\x. smn 1 ?p [x]) ` ?E)" + using s11_inj[of ?p] by (simp add: finite_image_iff inj_on_subset) + moreover have "(\x. smn 1 ?p [x]) ` ?E = {smn 1 ?p [encode r] |r. recfn 1 r \ r \ ?fh}" + by auto + ultimately have "infinite {smn 1 ?p [encode r] |r. recfn 1 r \ r \ ?fh}" + by simp + then obtain n where "n \ k" "n \ {smn 1 ?p [encode r] |r. recfn 1 r \ r \ ?fh}" + by (meson finite_nat_set_iff_bounded_le le_cases) + then obtain r where r: "recfn 1 r" "n = smn 1 ?p [encode r]" "recfn 1 r \ r \ ?fh" + by auto + then have eval_r: "eval r [encode r] = eval ?fh [encode r]" + by (simp add: exteq_def) + then have eval_r': "eval r [encode r] = eval f [the (eval h [encode r])]" + using assms `total h` `prim_recfn 1 h` by simp + then have "eval r [encode r] \" + using `prim_recfn 1 h` assms(1,2) by simp + then have "eval r_phi [encode r, encode r] \" + by (simp add: \recfn 1 r\ r_phi) + then have "eval r_phi [the (eval h [encode r]), y] = + eval r_phi [(the (eval r_phi [encode r, encode r])), y]" + for y + using * by simp + then have "eval r_phi [the (eval h [encode r]), y] = + eval r_phi [(the (eval r [encode r])), y]" + for y + by (simp add: \recfn 1 r\ r_phi) + moreover have "n = the (eval h [encode r])" by (simp add: h r(2)) + ultimately have "eval r_phi [n, y] = eval r_phi [the (eval r [encode r]), y]" for y + by simp + then have "eval r_phi [n, y] = eval r_phi [the (eval ?fh [encode r]), y]" for y + using r by (simp add: eval_r) + moreover have "eval ?fh [encode r] = eval f [n]" + using eval_r eval_r' \n = the (eval h [encode r])\ by auto + ultimately have "eval r_phi [n, y] = eval r_phi [the (eval f [n]), y]" for y + by simp + with `n \ k` show ?thesis by auto +qed + + +subsection \Kleene's fixed-point theorem\ + +text \The next theorem is what Rogers~\cite[p.~214]{Rogers87} calls +Kleene's version of what we call Rogers's fixed-point theorem. More precisely +this would be Kleene's \emph{second} fixed-point theorem, but since we do not +cover the first one, we leave out the number.\ + +theorem kleene_fixed_point_theorem: + fixes k :: nat + assumes "recfn 2 psi" + shows "\n\k. \x. eval r_phi [n, x] = eval psi [n, x]" +proof - + from numbering_translation[OF assms] obtain c where c: + "recfn 1 c" + "total c" + "\i x. eval psi [i, x] = eval r_phi [the (eval c [i]), x]" + by auto + then obtain n where "n \ k" and "\x. eval r_phi [n, x] = eval r_phi [the (eval c [n]), x]" + using rogers_fixed_point_theorem by blast + with c(3) have "\x. eval r_phi [n, x] = eval psi [n, x]" + by simp + with `n \ k` show ?thesis by auto +qed + +text \Kleene's fixed-point theorem can be generalized to arbitrary +arities. But we need to generalize it only to binary functions in order to +show Smullyan's double fixed-point theorem in +Section~\ref{s:smullyan}.\ + +definition "r_univuniv2 \ + Cn 3 r_phi [Cn 3 (r_universal 2) [Id 3 0, Id 3 0, Id 3 1], Id 3 2]" + +lemma r_univuniv2_recfn: "recfn 3 r_univuniv2" + by (simp add: r_univuniv2_def) + +lemma r_univuniv2_converg: + assumes "eval (r_universal 2) [u, u, x] \" + shows "eval r_univuniv2 [u, x, y] = eval r_phi [the (eval (r_universal 2) [u, u, x]), y]" + unfolding r_univuniv2_def using assms r_univuniv2_recfn by simp + +theorem kleene_fixed_point_theorem_2: + assumes "recfn 2 f" and "total f" + shows "\n. + recfn 1 n \ + total n \ + (\x y. eval r_phi [(the (eval n [x])), y] = eval r_phi [(the (eval f [the (eval n [x]), x])), y])" +proof - + let ?p = "encode r_univuniv2" + let ?s = "r_smn 1 2" + define h where "h = Cn 2 ?s [r_dummy 1 (r_const ?p), Id 2 0, Id 2 1]" + then have [simp]: "prim_recfn 2 h" by simp + { + fix u x y + have "eval h [u, x] = eval (Cn 2 ?s [r_dummy 1 (r_const ?p), Id 2 0, Id 2 1]) [u, x]" + using h_def by simp + then have "the (eval h [u, x]) = smn 1 ?p [u, x]" + by (simp add: r_smn) + then have "eval r_phi [the (eval h [u, x]), y] = eval r_phi [smn 1 ?p [u, x], y]" + by simp + also have "... = + eval r_phi + [encode (Cn 1 (r_universal 3) (r_constn 0 ?p # r_constn 0 u # r_constn 0 x # [Id 1 0])), + y]" + using smn[of 1 ?p "[u, x]"] by (simp add: numeral_3_eq_3) + also have "... = + eval r_phi + [encode (Cn 1 (r_universal 3) (r_const ?p # r_const u # r_const x # [Id 1 0])), y]" + (is "_ = eval r_phi [encode ?f, y]") + by (simp add: r_constn_def) + also have "... = eval ?f [y]" + using r_phi'[of ?f] by auto + also have "... = eval (r_universal 3) [?p, u, x, y]" + using r_univuniv2_recfn r_universal r_phi by auto + also have "... = eval r_univuniv2 [u, x, y]" + using r_universal by (simp add: r_univuniv2_recfn) + finally have "eval r_phi [the (eval h [u, x]), y] = eval r_univuniv2 [u, x, y]" . + } + then have *: "eval r_phi [the (eval h [u, x]), y] = + eval r_phi [the (eval (r_universal 2) [u, u, x]), y]" + if "eval (r_universal 2) [u, u, x] \" for u x y + using r_univuniv2_converg that by simp + + let ?fh = "Cn 2 f [h, Id 2 1]" + let ?e = "encode ?fh" + have "recfn 2 ?fh" + using assms by simp + have "total h" + by auto + then have "total ?fh" + using assms Cn_total totalI2[of ?fh] by fastforce + + let ?n = "Cn 1 h [r_const ?e, Id 1 0]" + have "recfn 1 ?n" + using assms by simp + moreover have "total ?n" + using `total h` totalI1[of ?n] by simp + moreover { + fix x y + have "eval r_phi [(the (eval ?n [x])), y] = eval r_phi [(the (eval h [?e, x])), y]" + by simp + also have "... = eval r_phi [the (eval (r_universal 2) [?e, ?e, x]), y]" + using * r_universal[of _ 2] totalE[of ?fh 2] \total ?fh\ \recfn 2 ?fh\ + by (metis length_Cons list.size(3) numeral_2_eq_2) + also have "... = eval r_phi [the (eval f [the (eval h [?e, x]), x]), y]" + proof - + have "eval (r_universal 2) [?e, ?e, x] \" + using totalE[OF `total ?fh`] `recfn 2 ?fh` r_universal + by (metis length_Cons list.size(3) numeral_2_eq_2) + moreover have "eval (r_universal 2) [?e, ?e, x] = eval ?fh [?e, x]" + by (metis \recfn 2 ?fh\ length_Cons list.size(3) numeral_2_eq_2 r_universal) + then show ?thesis using assms `total h` by simp + qed + also have "... = eval r_phi [(the (eval f [the (eval ?n [x]), x])), y]" + by simp + finally have "eval r_phi [(the (eval ?n [x])), y] = + eval r_phi [(the (eval f [the (eval ?n [x]), x])), y]" . + } + ultimately show ?thesis by blast +qed + + +subsection \Smullyan's double fixed-point theorem\label{s:smullyan}\ + +theorem smullyan_double_fixed_point_theorem: + assumes "recfn 2 g" and "total g" and "recfn 2 h" and "total h" + shows "\m n. + (\x. eval r_phi [m, x] = eval r_phi [the (eval g [m, n]), x]) \ + (\x. eval r_phi [n, x] = eval r_phi [the (eval h [m, n]), x])" +proof - + obtain m where + "recfn 1 m" and + "total m" and + m: "\x y. eval r_phi [the (eval m [x]), y] = + eval r_phi [the (eval g [the (eval m [x]), x]), y]" + using kleene_fixed_point_theorem_2[of g] assms(1,2) by auto + define k where "k = Cn 1 h [m, Id 1 0]" + then have "recfn 1 k" + using `recfn 1 m` assms(3) by simp + have "total (Id 1 0)" + by (simp add: Mn_free_imp_total) + then have "total k" + using `total m` assms(4) Cn_total k_def `recfn 1 k` by simp + obtain n where n: "\x. eval r_phi [n, x] = eval r_phi [the (eval k [n]), x]" + using rogers_fixed_point_theorem[of k] `recfn 1 k` `total k` by blast + obtain mm where mm: "eval m [n] \= mm" + using `total m` `recfn 1 m` by fastforce + then have "\x. eval r_phi [mm, x] = eval r_phi [the (eval g [mm, n]), x]" + by (metis m option.sel) + moreover have "\x. eval r_phi [n, x] = eval r_phi [the (eval h [mm, n]), x]" + using k_def assms(3) `total m` `recfn 1 m` mm n by simp + ultimately show ?thesis by blast +qed + + +section \Decidable and recursively enumerable sets\label{s:decidable}\ + +text \We defined @{term decidable} already back in +Section~\ref{s:halting}: @{thm[display] decidable_def}\ + +text \The next theorem is adapted from @{thm[source] +halting_problem_undecidable}.\ + +theorem halting_problem_phi_undecidable: "\ decidable {x. eval r_phi [x, x] \}" + (is "\ decidable ?K") +proof + assume "decidable ?K" + then obtain f where "recfn 1 f" and f: "\x. eval f [x] \= (if x \ ?K then 1 else 0)" + using decidable_def by auto + define g where "g \ Cn 1 r_ifeq_else_diverg [f, Z, Z]" + then have "recfn 1 g" + using `recfn 1 f` r_ifeq_else_diverg_recfn by simp + then obtain i where i: "eval r_phi [i, x] = eval g [x]" for x + using r_phi' by auto + from g_def have "eval g [x] = (if x \ ?K then Some 0 else None)" for x + using r_ifeq_else_diverg_recfn `recfn 1 f` f by simp + then have "eval g [i] \ \ i \ ?K" by simp + also have "... \ eval r_phi [i, i] \" by simp + also have "... \ eval g [i] \" + using i by simp + finally have "eval g [i] \ \ eval g [i] \" . + then show False by auto +qed + +lemma decidable_complement: "decidable X \ decidable (- X)" +proof - + assume "decidable X" + then obtain f where f: "recfn 1 f" "\x. eval f [x] \= (if x \ X then 1 else 0)" + using decidable_def by auto + define g where "g = Cn 1 r_not [f]" + then have "recfn 1 g" + by (simp add: f(1)) + moreover have "eval g [x] \= (if x \ X then 0 else 1)" for x + by (simp add: g_def f) + ultimately show ?thesis using decidable_def by auto +qed + +text \Finite sets are decidable.\ + +fun r_contains :: "nat list \ recf" where + "r_contains [] = Z" +| "r_contains (x # xs) = Cn 1 r_ifeq [Id 1 0, r_const x, r_const 1, r_contains xs]" + +lemma r_contains_prim: "prim_recfn 1 (r_contains xs)" + by (induction xs) auto + +lemma r_contains: "eval (r_contains xs) [x] \= (if x \ set xs then 1 else 0)" +proof (induction xs arbitrary: x) + case Nil + then show ?case by simp +next + case (Cons a xs) + have "eval (r_contains (a # xs)) [x] = eval r_ifeq [x, a, 1, the (eval (r_contains xs) [x])]" + using r_contains_prim prim_recfn_total by simp + also have "... \= (if x = a then 1 else if x \ set xs then 1 else 0)" + using Cons.IH by simp + also have "... \= (if x = a \ x \ set xs then 1 else 0)" + by simp + finally show ?case by simp +qed + +lemma finite_set_decidable: "finite X \ decidable X" +proof - + fix X :: "nat set" + assume "finite X" + then obtain xs where "X = set xs" + using finite_list by auto + then have "\x. eval (r_contains xs) [x] \= (if x \ X then 1 else 0)" + using r_contains by simp + then show "decidable X" + using decidable_def r_contains_prim by blast +qed + +definition semidecidable :: "nat set \ bool" where + "semidecidable X \ (\f. recfn 1 f \ (\x. eval f [x] = (if x \ X then Some 1 else None)))" + +text \The semidecidable sets are the domains of partial recursive functions.\ + +lemma semidecidable_iff_domain: + "semidecidable X \ (\f. recfn 1 f \ (\x. eval f [x] \ \ x \ X))" +proof + show "semidecidable X \ \f. recfn 1 f \ (\x. (eval f [x] \) = (x \ X))" + using semidecidable_def by (metis option.distinct(1)) + show "semidecidable X" if "\f. recfn 1 f \ (\x. (eval f [x] \) = (x \ X))" for X + proof - + from that obtain f where f: "recfn 1 f" "\x. (eval f [x] \) = (x \ X)" + by auto + let ?g = "Cn 1 (r_const 1) [f]" + have "recfn 1 ?g" + using f(1) by simp + moreover have "\x. eval ?g [x] = (if x \ X then Some 1 else None)" + using f by simp + ultimately show "semidecidable X" + using semidecidable_def by blast + qed +qed + +lemma decidable_imp_semidecidable: "decidable X \ semidecidable X" +proof - + assume "decidable X" + then obtain f where f: "recfn 1 f" "\x. eval f [x] \= (if x \ X then 1 else 0)" + using decidable_def by auto + define g where "g = Cn 1 r_ifeq_else_diverg [f, r_const 1, r_const 1]" + then have "recfn 1 g" + by (simp add: f(1)) + have "eval g [x] = eval r_ifeq_else_diverg [if x \ X then 1 else 0, 1, 1]" for x + by (simp add: g_def f) + then have "\x. x \ X \ eval g [x] \= 1" and "\x. x \ X \ eval g [x] \" + by simp_all + then show ?thesis + using `recfn 1 g` semidecidable_def by auto +qed + +text \A set is recursively enumerable if it is empty or the image of a +total recursive function.\ + +definition recursively_enumerable :: "nat set \ bool" where + "recursively_enumerable X \ + X = {} \ (\f. recfn 1 f \ total f \ X = {the (eval f [x]) |x. x \ UNIV})" + +theorem recursively_enumerable_iff_semidecidable: + "recursively_enumerable X \ semidecidable X" +proof + show "semidecidable X" if "recursively_enumerable X" for X + proof (cases) + assume "X = {}" + then show ?thesis + using finite_set_decidable decidable_imp_semidecidable + recursively_enumerable_def semidecidable_def + by blast + next + assume "X \ {}" + with that obtain f where f: "recfn 1 f" "total f" "X = {the (eval f [x]) |x. x \ UNIV}" + using recursively_enumerable_def by blast + define h where "h = Cn 2 r_eq [Cn 2 f [Id 2 0], Id 2 1]" + then have "recfn 2 h" + using f(1) by simp + from h_def have h: "eval h [x, y] \= 0 \ the (eval f [x]) = y" for x y + using f(1,2) by simp + from h_def `recfn 2 h` totalI2 f(2) have "total h" by simp + define g where "g = Mn 1 h" + then have "recfn 1 g" + using h_def f(1) by simp + then have "eval g [y] = + (if (\x. eval h [x, y] \= 0 \ (\x')) + then Some (LEAST x. eval h [x, y] \= 0) + else None)" for y + using g_def `total h` f(2) by simp + then have "eval g [y] = + (if \x. eval h [x, y] \= 0 + then Some (LEAST x. eval h [x, y] \= 0) + else None)" for y + using `total h` `recfn 2 h` by simp + then have "eval g [y] \ \ (\x. eval h [x, y] \= 0)" for y + by simp + with h have "eval g [y] \ \ (\x. the (eval f [x]) = y)" for y + by simp + with f(3) have "eval g [y] \ \ y \ X" for y + by auto + with `recfn 1 g` semidecidable_iff_domain show ?thesis by auto + qed + + show "recursively_enumerable X" if "semidecidable X" for X + proof (cases) + assume "X = {}" + then show ?thesis using recursively_enumerable_def by simp + next + assume "X \ {}" + then obtain x\<^sub>0 where "x\<^sub>0 \ X" by auto + from that semidecidable_iff_domain obtain f where f: "recfn 1 f" "\x. eval f [x] \ \ x \ X" + by auto + let ?i = "encode f" + have i: "\x. eval f [x] = eval r_phi [?i, x]" + using r_phi' f(1) by simp + with `x\<^sub>0 \ X` f(2) have "eval r_phi [?i, x\<^sub>0] \" by simp + then obtain g where g: "recfn 1 g" "total g" "\x. eval r_phi [?i, x] \ = (\y. eval g [y] \= x)" + using f(1) nonempty_domain_enumerable by blast + with f(2) i have "\x. x \ X = (\y. eval g [y] \= x)" + by simp + then have "\x. x \ X = (\y. the (eval g [y]) = x)" + using totalE[OF g(2) g(1)] + by (metis One_nat_def length_Cons list.size(3) option.collapse option.sel) + then have "X = {the (eval g [y]) |y. y \ UNIV}" + by auto + with g(1,2) show ?thesis using recursively_enumerable_def by auto + qed +qed + +text \The next goal is to show that a set is decidable iff. it and its +complement are semidecidable. For this we use the concurrent evaluation +function.\ + +lemma semidecidable_decidable: + assumes "semidecidable X" and "semidecidable (- X)" + shows "decidable X" +proof - + obtain f where f: "recfn 1 f \ (\x. eval f [x] \ \ x \ X)" + using assms(1) semidecidable_iff_domain by auto + let ?i = "encode f" + obtain g where g: "recfn 1 g \ (\x. eval g [x] \ \ x \ (- X))" + using assms(2) semidecidable_iff_domain by auto + let ?j = "encode g" + define d where "d = Cn 1 r_pdec1 [Cn 1 r_parallel [r_const ?j, r_const ?i, Id 1 0]]" + then have "recfn 1 d" + by (simp add: d_def) + have *: "\x. eval r_phi [?i, x] = eval f [x]" "\x. eval r_phi [?j, x] = eval g [x]" + using f g r_phi' by simp_all + have "eval d [x] \= 1" if "x \ X" for x + proof - + have "eval f [x] \" + using f that by simp + moreover have "eval g [x] \" + using g that by blast + ultimately have "eval r_parallel [?j, ?i, x] \= prod_encode (1, the (eval f [x]))" + using * r_parallel(3) by simp + with d_def show ?thesis by simp + qed + moreover have "eval d [x] \= 0" if "x \ X" for x + proof - + have "eval g [x] \" + using g that by simp + moreover have "eval f [x] \" + using f that by blast + ultimately have "eval r_parallel [?j, ?i, x] \= prod_encode (0, the (eval g [x]))" + using * r_parallel(2) by blast + with d_def show ?thesis by simp + qed + ultimately show ?thesis + using decidable_def `recfn 1 d` by auto +qed + +theorem decidable_iff_semidecidable_complement: + "decidable X \ semidecidable X \ semidecidable (- X)" + using semidecidable_decidable decidable_imp_semidecidable decidable_complement + by blast + + +section \Rice's theorem\ + +definition index_set :: "nat set \ bool" where + "index_set I \ \i j. i \ I \ (\x. eval r_phi [i, x] = eval r_phi [j, x]) \ j \ I" + +lemma index_set_closed_in: + assumes "index_set I" and "i \ I" and "\x. eval r_phi [i, x] = eval r_phi [j, x]" + shows "j \ I" + using index_set_def assms by simp + +lemma index_set_closed_not_in: + assumes "index_set I" and "i \ I" and "\x. eval r_phi [i, x] = eval r_phi [j, x]" + shows "j \ I" + using index_set_def assms by metis + +theorem rice_theorem: + assumes "index_set I" and "I \ UNIV" and "I \ {}" + shows "\ decidable I" +proof + assume "decidable I" + then obtain d where d: "recfn 1 d" "\i. eval d [i] \= (if i \ I then 1 else 0)" + using decidable_def by auto + obtain j\<^sub>1 j\<^sub>2 where "j\<^sub>1 \ I" and "j\<^sub>2 \ I" + using assms(2,3) by auto + let ?if = "Cn 2 r_ifz [Cn 2 d [Id 2 0], r_dummy 1 (r_const j\<^sub>2), r_dummy 1 (r_const j\<^sub>1)]" + define psi where "psi = Cn 2 r_phi [?if, Id 2 1] " + then have "recfn 2 psi" + by (simp add: d) + have "eval ?if [x, y] = Some (if x \ I then j\<^sub>1 else j\<^sub>2)" for x y + by (simp add: d) + moreover have "eval psi [x, y] = eval (Cn 2 r_phi [?if, Id 2 1]) [x, y]" for x y + using psi_def by simp + ultimately have psi: "eval psi [x, y] = eval r_phi [if x \ I then j\<^sub>1 else j\<^sub>2, y]" for x y + by (simp add: d) + then have in_I: "eval psi [x, y] = eval r_phi [j\<^sub>1, y]" if "x \ I" for x y + by (simp add: that) + have not_in_I: "eval psi [x, y] = eval r_phi [j\<^sub>2, y]" if "x \ I" for x y + by (simp add: psi that) + obtain n where n: "\x. eval r_phi [n, x] = eval psi [n, x]" + using kleene_fixed_point_theorem[OF `recfn 2 psi`] by auto + show False + proof cases + assume "n \ I" + then have "\x. eval r_phi [n, x] = eval r_phi [j\<^sub>1, x]" + using n in_I by simp + then have "n \ I" + using `j\<^sub>1 \ I` index_set_closed_not_in[OF assms(1)] by simp + with `n \ I` show False by simp + next + assume "n \ I" + then have "\x. eval r_phi [n, x] = eval r_phi [j\<^sub>2, x]" + using n not_in_I by simp + then have "n \ I" + using `j\<^sub>2 \ I` index_set_closed_in[OF assms(1)] by simp + with `n \ I` show False by simp + qed +qed + + +section \Partial recursive functions as actual functions\label{s:alternative}\ + +text \A well-formed @{typ recf} describes an algorithm. Usually, +however, partial recursive functions are considered to be partial functions, +that is, right-unique binary relations. This distinction did not matter much +until now, because we were mostly concerned with the \emph{existence} of +partial recursive functions, which is equivalent to the existence of +algorithms. Whenever it did matter, we could use the extensional equivalence +@{term "exteq"}. In Chapter~\ref{c:iirf}, however, we will deal with sets of +functions and sets of sets of functions. + +For illustration consider the singleton set containing only the unary zero +function. It could be expressed by @{term "{Z}"}, but this would not contain +@{term[names_short] "Cn 1 (Id 1 0) [Z]"}, which computes the same function. +The alternative representation as @{term "{f. f \ Z}"} is not a +singleton set. Another alternative would be to identify partial recursive +functions with the equivalence classes of @{term "exteq"}. This would work +for all arities. But since we will only need unary and binary functions, we +can go for the less general but simpler alternative of regarding partial +recursive functions as certain functions of types @{typ "nat \ +nat option"} and @{typ "nat \ nat \ nat option"}. +With this notation we can represent the aforementioned set by @{term +"{\_. Some (0::nat)}"} and express that the function @{term "\_. +Some (0::nat)"} is total recursive. + +In addition terms get shorter, for instance, @{term "eval r_func [i, x]"} +becomes @{term "func i x"}.\ + + +subsection \The definitions\ + +type_synonym partial1 = "nat \ nat option" + +type_synonym partial2 = "nat \ nat \ nat option" + +definition total1 :: "partial1 \ bool" where + "total1 f \ \x. f x \" + +definition total2 :: "partial2 \ bool" where + "total2 f \ \x y. f x y \" + +lemma total1I [intro]: "(\x. f x \) \ total1 f" + using total1_def by simp + +lemma total2I [intro]: "(\x y. f x y \) \ total2 f" + using total2_def by simp + +lemma total1E [dest, simp]: "total1 f \ f x \" + using total1_def by simp + +lemma total2E [dest, simp]: "total2 f \ f x y \" + using total2_def by simp + +definition P1 :: "partial1 set" ("\

") where + "\

\ {\x. eval r [x] |r. recfn 1 r}" + +definition P2 :: "partial2 set" ("\

\<^sup>2") where + "\

\<^sup>2 \ {\x y. eval r [x, y] |r. recfn 2 r}" + +definition R1 :: "partial1 set" ("\") where + "\ \ {\x. eval r [x] |r. recfn 1 r \ total r}" + +definition R2 :: "partial2 set" ("\\<^sup>2") where + "\\<^sup>2 \ {\x y. eval r [x, y] |r. recfn 2 r \ total r}" + +definition Prim1 :: "partial1 set" where + "Prim1 \ {\x. eval r [x] |r. prim_recfn 1 r}" + +definition Prim2 :: "partial2 set" where + "Prim2 \ {\x y. eval r [x, y] |r. prim_recfn 2 r}" + +lemma R1_imp_P1 [simp, elim]: "f \ \ \ f \ \

" + using R1_def P1_def by auto + +lemma R2_imp_P2 [simp, elim]: "f \ \\<^sup>2 \ f \ \

\<^sup>2" + using R2_def P2_def by auto + +lemma Prim1_imp_R1 [simp, elim]: "f \ Prim1 \ f \ \" + unfolding Prim1_def R1_def by auto + +lemma Prim2_imp_R2 [simp, elim]: "f \ Prim2 \ f \ \\<^sup>2" + unfolding Prim2_def R2_def by auto + +lemma P1E [elim]: + assumes "f \ \

" + obtains r where "recfn 1 r" and "\x. eval r [x] = f x" + using assms P1_def by force + +lemma P2E [elim]: + assumes "f \ \

\<^sup>2" + obtains r where "recfn 2 r" and "\x y. eval r [x, y] = f x y" + using assms P2_def by force + +lemma P1I [intro]: + assumes "recfn 1 r" and "(\x. eval r [x]) = f" + shows "f \ \

" + using assms P1_def by auto + +lemma P2I [intro]: + assumes "recfn 2 r" and "\x y. eval r [x, y] = f x y" + shows "f \ \

\<^sup>2" +proof - + have "(\x y. eval r [x, y]) = f" + using assms(2) by simp + then show ?thesis + using assms(1) P2_def by auto +qed + +lemma R1I [intro]: + assumes "recfn 1 r" and "total r" and "\x. eval r [x] = f x" + shows "f \ \" + unfolding R1_def + using CollectI[of "\f. \r. f = (\x. eval r [x]) \ recfn 1 r \ total r" f] assms + by metis + +lemma R1E [elim]: + assumes "f \ \" + obtains r where "recfn 1 r" and "total r" and "f = (\x. eval r [x])" + using assms R1_def by auto + +lemma R2I [intro]: + assumes "recfn 2 r" and "total r" and "\x y. eval r [x, y] = f x y" + shows "f \ \\<^sup>2" + unfolding R2_def + using CollectI[of "\f. \r. f = (\x y. eval r [x, y]) \ recfn 2 r \ total r" f] assms + by metis + +lemma R1_SOME: + assumes "f \ \" + and "r = (SOME r'. recfn 1 r' \ total r' \ f = (\x. eval r' [x]))" + (is "r = (SOME r'. ?P r')") + shows "recfn 1 r" + and "\x. eval r [x] \" + and "\x. f x = eval r [x]" + and "f = (\x. eval r [x])" +proof - + obtain r' where "?P r'" + using R1E[OF assms(1)] by auto + then show "recfn 1 r" "\b. eval r [b] \" "\x. f x = eval r [x]" + using someI[of ?P r'] assms(2) totalE[of r] by (auto, metis) + then show "f = (\x. eval r [x])" by auto +qed + +lemma R2E [elim]: + assumes "f \ \\<^sup>2" + obtains r where "recfn 2 r" and "total r" and "f = (\x\<^sub>1 x\<^sub>2. eval r [x\<^sub>1, x\<^sub>2])" + using assms R2_def by auto + +lemma R1_imp_total1 [simp]: "f \ \ \ total1 f" + using total1I by fastforce + +lemma R2_imp_total2 [simp]: "f \ \\<^sup>2 \ total2 f" + using totalE by fastforce + +lemma Prim1I [intro]: + assumes "prim_recfn 1 r" and "\x. f x = eval r [x]" + shows "f \ Prim1" + using assms Prim1_def by blast + +lemma Prim2I [intro]: + assumes "prim_recfn 2 r" and "\x y. f x y = eval r [x, y]" + shows "f \ Prim2" + using assms Prim2_def by blast + +lemma P1_total_imp_R1 [intro]: + assumes "f \ \

" and "total1 f" + shows "f \ \" + using assms totalI1 by force + +lemma P2_total_imp_R2 [intro]: + assumes "f \ \

\<^sup>2 " and "total2 f" + shows "f \ \\<^sup>2" + using assms totalI2 by force + + +subsection \Some simple properties\ + +text \In order to show that a @{typ partial1} or @{typ partial2} +function is in @{term "\

"}, @{term "\

\<^sup>2"}, @{term "\"}, @{term +"\\<^sup>2"}, @{term "Prim1"}, or @{term "Prim2"} we will usually have to +find a suitable @{typ recf}. But for some simple or frequent cases this +section provides shortcuts.\ + +lemma identity_in_R1: "Some \ \" +proof - + have "\x. eval (Id 1 0) [x] \= x" by simp + moreover have "recfn 1 (Id 1 0)" by simp + moreover have "total (Id 1 0)" + by (simp add: totalI1) + ultimately show ?thesis by blast +qed + +lemma P2_proj_P1 [simp, elim]: + assumes "\ \ \

\<^sup>2" + shows "\ i \ \

" +proof - + from assms obtain u where u: "recfn 2 u" "(\x\<^sub>1 x\<^sub>2. eval u [x\<^sub>1, x\<^sub>2]) = \" + by auto + define v where "v \ Cn 1 u [r_const i, Id 1 0]" + then have "recfn 1 v" "(\x. eval v [x]) = \ i" + using u by auto + then show ?thesis by auto +qed + +lemma R2_proj_R1 [simp, elim]: + assumes "\ \ \\<^sup>2" + shows "\ i \ \" +proof - + from assms have "\ \ \

\<^sup>2" by simp + then have "\ i \ \

" by auto + moreover have "total1 (\ i)" + using assms by (simp add: total1I) + ultimately show ?thesis by auto +qed + +lemma const_in_Prim1: "(\_. Some c) \ Prim1" +proof - + define r where "r = r_const c" + then have "\x. eval r [x] = Some c" by simp + moreover have "recfn 1 r" "Mn_free r" + using r_def by simp_all + ultimately show ?thesis by auto +qed + +lemma concat_P1_P1: + assumes "f \ \

" and "g \ \

" + shows "(\x. if g x \ \ f (the (g x)) \ then Some (the (f (the (g x)))) else None) \ \

" + (is "?h \ \

") +proof - + obtain rf where rf: "recfn 1 rf" "\x. eval rf [x] = f x" + using assms(1) by auto + obtain rg where rg: "recfn 1 rg" "\x. eval rg [x] = g x" + using assms(2) by auto + let ?rh = "Cn 1 rf [rg]" + have "recfn 1 ?rh" + using rf(1) rg(1) by simp + moreover have "eval ?rh [x] = ?h x" for x + using rf rg by simp + ultimately show ?thesis by blast +qed + +lemma P1_update_P1: + assumes "f \ \

" + shows "f(x:=z) \ \

" +proof (cases z) + case None + define re where "re \ Mn 1 (r_constn 1 1)" + from assms obtain r where r: "recfn 1 r" "(\u. eval r [u]) = f" + by auto + define r' where "r' = Cn 1 (r_lifz re r) [Cn 1 r_eq [Id 1 0, r_const x], Id 1 0]" + have "recfn 1 r'" + using r(1) r'_def re_def by simp + then have "eval r' [u] = eval (r_lifz re r) [if u = x then 0 else 1, u]" for u + using r'_def by simp + with r(1) have "eval r' [u] = (if u = x then None else eval r [u])" for u + using re_def re_def by simp + with r(2) have "eval r' [u] = (f(x:=None)) u" for u + by auto + then have "(\u. eval r' [u]) = f(x:=None)" + by auto + with None `recfn 1 r'` show ?thesis by auto +next + case (Some y) + from assms obtain r where r: "recfn 1 r" "(\u. eval r [u]) = f" + by auto + define r' where + "r' \ Cn 1 (r_lifz (r_const y) r) [Cn 1 r_eq [Id 1 0, r_const x], Id 1 0]" + have "recfn 1 r'" + using r(1) r'_def by simp + then have "eval r' [u] = eval (r_lifz (r_const y) r) [if u = x then 0 else 1, u]" for u + using r'_def by simp + with r(1) have "eval r' [u] = (if u = x then Some y else eval r [u])" for u + by simp + with r(2) have "eval r' [u] = (f(x:=Some y)) u" for u + by auto + then have "(\u. eval r' [u]) = f(x:=Some y)" + by auto + with Some `recfn 1 r'` show ?thesis by auto +qed + +lemma swap_P2: + assumes "f \ \

\<^sup>2" + shows "(\x y. f y x) \ \

\<^sup>2" +proof - + obtain r where r: "recfn 2 r" "\x y. eval r [x, y] = f x y" + using assms by auto + then have "eval (r_swap r) [x, y] = f y x" for x y + by simp + moreover have "recfn 2 (r_swap r)" + using r_swap_recfn r(1) by simp + ultimately show ?thesis by auto +qed + +lemma swap_R2: + assumes "f \ \\<^sup>2" + shows "(\x y. f y x) \ \\<^sup>2" + using swap_P2[of f] assms + by (meson P2_total_imp_R2 R2_imp_P2 R2_imp_total2 total2E total2I) + +lemma skip_P1: + assumes "f \ \

" + shows "(\x. f (x + n)) \ \

" +proof - + obtain r where r: "recfn 1 r" "\x. eval r [x] = f x" + using assms by auto + let ?s = "Cn 1 r [Cn 1 r_add [Id 1 0, r_const n]]" + have "recfn 1 ?s" + using r by simp + have "eval ?s [x] = eval r [x + n]" for x + using r by simp + with r have "eval ?s [x] = f (x + n)" for x + by simp + with `recfn 1 ?s` show ?thesis by blast +qed + +lemma skip_R1: + assumes "f \ \" + shows "(\x. f (x + n)) \ \" + using assms skip_P1 R1_imp_total1 total1_def by auto + + +subsection \The Gödel numbering @{term \}\label{s:goedel_numbering}\ + +text \While the term \emph{Gödel numbering} is often used generically for +mappings between natural numbers and mathematical concepts, the inductive +inference literature uses it in a more specific sense. There it is equivalent +to the notion of acceptable numbering~\cite{Rogers87}: For every numbering +there is a recursive function mapping the numbering's indices to equivalent +ones of a Gödel numbering.\ + +definition goedel_numbering :: "partial2 \ bool" where + "goedel_numbering \ \ \ \ \

\<^sup>2 \ (\\\\

\<^sup>2. \c\\. \i. \ i = \ (the (c i)))" + +lemma goedel_numbering_P2: + assumes "goedel_numbering \" + shows "\ \ \

\<^sup>2" + using goedel_numbering_def assms by simp + +lemma goedel_numberingE: + assumes "goedel_numbering \" and "\ \ \

\<^sup>2" + obtains c where "c \ \" and "\i. \ i = \ (the (c i))" + using assms goedel_numbering_def by blast + +lemma goedel_numbering_universal: + assumes "goedel_numbering \" and "f \ \

" + shows "\i. \ i = f" +proof - + define \ :: partial2 where "\ = (\i. f)" + have "\ \ \

\<^sup>2" + proof - + obtain rf where rf: "recfn 1 rf" "\x. eval rf [x] = f x" + using assms(2) by auto + define r where "r = Cn 2 rf [Id 2 1]" + then have r: "recfn 2 r" "\i x. eval r [i, x] = eval rf [x]" + using rf(1) by simp_all + with rf(2) have "\i x. eval r [i, x] = f x" by simp + with r(1) show ?thesis using \_def by auto + qed + then obtain c where "c \ \" and "\i. \ i = \ (the (c i))" + using goedel_numbering_def assms(1) by auto + with \_def show ?thesis by auto +qed + +text \Our standard Gödel numbering is based on @{term r_phi}:\ + +definition phi :: partial2 ("\") where + "\ i x \ eval r_phi [i, x]" + +lemma phi_in_P2: "\ \ \

\<^sup>2" + unfolding phi_def using r_phi_recfn by blast + +text \Indices of any numbering can be translated into equivalent indices +of @{term phi}, which thus is a Gödel numbering.\ + +lemma numbering_translation_for_phi: + assumes "\ \ \

\<^sup>2" + shows "\c\\. \i. \ i = \ (the (c i))" +proof - + obtain psi where psi: "recfn 2 psi" "\i x. eval psi [i, x] = \ i x" + using assms by auto + with numbering_translation obtain b where + "recfn 1 b" "total b" "\i x. eval psi [i, x] = eval r_phi [the (eval b [i]), x]" + by blast + moreover from this obtain c where c: "c \ \" "\i. c i = eval b [i]" + by fast + ultimately have "\ i x = \ (the (c i)) x" for i x + using phi_def psi(2) by presburger + then have "\ i = \ (the (c i))" for i + by auto + then show ?thesis using c(1) by blast +qed + +corollary goedel_numbering_phi: "goedel_numbering \" + unfolding goedel_numbering_def using numbering_translation_for_phi phi_in_P2 by simp + +corollary phi_universal: + assumes "f \ \

" + obtains i where "\ i = f" + using goedel_numbering_universal[OF goedel_numbering_phi assms] by auto + + +subsection \Fixed-point theorems\ + +text \The fixed-point theorems look somewhat cleaner in the new +notation. We will only need the following ones in the next chapter.\ + +theorem kleene_fixed_point: + fixes k :: nat + assumes "\ \ \

\<^sup>2" + obtains i where "i \ k" and "\ i = \ i" +proof - + obtain r_psi where r_psi: "recfn 2 r_psi" "\i x. eval r_psi [i, x] = \ i x" + using assms by auto + then obtain i where i: "i \ k" "\x. eval r_phi [i, x] = eval r_psi [i, x]" + using kleene_fixed_point_theorem by blast + then have "\x. \ i x = \ i x" + using phi_def r_psi by simp + then show ?thesis using i that by blast +qed + +theorem smullyan_double_fixed_point: + assumes "g \ \\<^sup>2" and "h \ \\<^sup>2" + obtains m n where "\ m = \ (the (g m n))" and "\ n = \ (the (h m n))" +proof - + obtain rg where rg: "recfn 2 rg" "total rg" "g = (\x y. eval rg [x, y])" + using R2E[OF assms(1)] by auto + moreover obtain rh where rh: "recfn 2 rh" "total rh" "h = (\x y. eval rh [x, y])" + using R2E[OF assms(2)] by auto + ultimately obtain m n where + "\x. eval r_phi [m, x] = eval r_phi [the (eval rg [m, n]), x]" + "\x. eval r_phi [n, x] = eval r_phi [the (eval rh [m, n]), x]" + using smullyan_double_fixed_point_theorem[of rg rh] by blast + then have "\ m = \ (the (g m n))" and "\ n = \ (the (h m n))" + using phi_def rg rh by auto + then show ?thesis using that by simp +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/TOTAL_CONS.thy b/thys/Inductive_Inference/TOTAL_CONS.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/TOTAL_CONS.thy @@ -0,0 +1,1468 @@ +section \TOTAL is a proper subset of CONS\label{s:total_cons}\ + +theory TOTAL_CONS + imports Lemma_R (* for r_auxhyp *) + CP_FIN_NUM (* for r_consistent *) + CONS_LIM (* for rmge2, goedel_at *) +begin + +text \We first show that TOTAL is a subset of CONS. Then we present a +separating class.\ + + +subsection \TOTAL is a subset of CONS\ + +text \A TOTAL strategy hypothesizes only total functions, for which the +consistency with the input prefix is decidable. A CONS strategy can thus run +a TOTAL strategy and check if its hypothesis is consistent. If so, it +outputs this hypothesis, otherwise some arbitrary consistent one. Since the +TOTAL strategy converges to a correct hypothesis, which is consistent, the +CONS strategy will converge to the same hypothesis.\ + +text \Without loss of generality we can assume that learning takes place +with respect to our Gödel numbering $\varphi$. So we need to decide +consistency only for this numbering.\ + +abbreviation r_consist_phi where + "r_consist_phi \ r_consistent r_phi" + +lemma r_consist_phi_recfn [simp]: "recfn 2 r_consist_phi" + by simp + +lemma r_consist_phi: + assumes "\k i k \" + shows "eval r_consist_phi [i, e] \= + (if \k i k \= e_nth e k then 0 else 1)" +proof - + have "\k" + using assms phi_def by simp + moreover have "recfn 2 r_phi" by simp + ultimately have "eval (r_consistent r_phi) [i, e] \= + (if \k= e_nth e k then 0 else 1)" + using r_consistent_converg assms by simp + then show ?thesis using phi_def by simp +qed + +lemma r_consist_phi_init: + assumes "f \ \" and "\ i \ \" + shows "eval r_consist_phi [i, f \ n] \= (if \k\n. \ i k = f k then 0 else 1)" + using assms r_consist_phi R1_imp_total1 total1E by (simp add: r_consist_phi) + +lemma TOTAL_subseteq_CONS: "TOTAL \ CONS" +proof + fix U assume "U \ TOTAL" + then have "U \ TOTAL_wrt \" + using TOTAL_wrt_phi_eq_TOTAL by blast + then obtain t' where t': "learn_total \ U t'" + using TOTAL_wrt_def by auto + then obtain t where t: "recfn 1 t" "\x. eval t [x] = t' x" + using learn_totalE(1) P1E by blast + then have t_converg: "eval t [f \ n] \" if "f \ U" for f n + using t' learn_totalE(1) that by auto + + define s where "s \ Cn 1 r_ifz [Cn 1 r_consist_phi [t, Id 1 0], t, r_auxhyp]" + then have "recfn 1 s" + using r_consist_phi_recfn r_auxhyp_prim t(1) by simp + + have consist: "eval r_consist_phi [the (eval t [f \ n]), f \ n] \= + (if \k\n. \ (the (eval t [f \ n])) k = f k then 0 else 1)" + if "f \ U" for f n + proof - + have "eval r_consist_phi [the (eval t [f \ n]), f \ n] = + eval (Cn 1 r_consist_phi [t, Id 1 0]) [f \ n]" + using that t_converg t(1) by simp + also have "... \= (if \k\n. \ (the (eval t [f \ n])) k = f k then 0 else 1)" + proof - + from that have "f \ \" + using learn_totalE(1) t' by blast + moreover have "\ (the (eval t [f \ n])) \ \" + using t' t learn_totalE t_converg that by simp + ultimately show ?thesis + using r_consist_phi_init t_converg t(1) that by simp + qed + finally show ?thesis . + qed + + have s_eq_t: "eval s [f \ n] = eval t [f \ n]" + if "\k\n. \ (the (eval t [f \ n])) k = f k" and "f \ U" for f n + using that consist s_def t r_auxhyp_prim prim_recfn_total + by simp + + have s_eq_aux: "eval s [f \ n] = eval r_auxhyp [f \ n]" + if "\ (\k\n. \ (the (eval t [f \ n])) k = f k)" and "f \ U" for f n + proof - + from that have "eval r_consist_phi [the (eval t [f \ n]), f \ n] \= 1" + using consist by simp + moreover have "t' (f \ n) \" using t' learn_totalE(1) that(2) by blast + ultimately show ?thesis + using s_def t r_auxhyp_prim t' learn_totalE by simp + qed + + have "learn_cons \ U (\e. eval s [e])" + proof (rule learn_consI) + have "eval s [f \ n] \" if "f \ U" for f n + using that t_converg[OF that, of n] s_eq_t[of n f] prim_recfn_total[of r_auxhyp 1] + r_auxhyp_prim s_eq_aux[OF _ that, of n] totalE + by fastforce + then show "environment \ U (\e. eval s [e])" + using t' `recfn 1 s` learn_totalE(1) by blast + show "\i. \ i = f \ (\\<^sup>\n. eval s [f \ n] \= i)" if "f \ U" for f + proof - + from that t' t learn_totalE obtain i n\<^sub>0 where + i_n0: "\ i = f \ (\n\n\<^sub>0. eval t [f \ n] \= i)" + by metis + then have "\n. n \ n\<^sub>0 \ \k\n. \ (the (eval t [f \ n])) k = f k" + by simp + with s_eq_t have "\n. n \ n\<^sub>0 \ eval s [f \ n] = eval t [f \ n]" + using that by simp + with i_n0 have "\n. n \ n\<^sub>0 \ eval s [f \ n] \= i" + by auto + with i_n0 show ?thesis by auto + qed + show "\k\n. \ (the (eval s [f \ n])) k = f k" if "f \ U" for f n + proof (cases "\k\n. \ (the (eval t [f \ n])) k = f k") + case True + with that s_eq_t show ?thesis by simp + next + case False + then have "eval s [f \ n] = eval r_auxhyp [f \ n]" + using that s_eq_aux by simp + moreover have "f \ \" + using learn_totalE(1)[OF t'] that by auto + ultimately show ?thesis using r_auxhyp by simp + qed + qed + then show "U \ CONS" using CONS_def by auto +qed + + +subsection \The separating class\ + + +subsubsection \Definition of the class\ + +text \The class that will be shown to be in @{term "CONS - TOTAL"} is +the union of the following two classes.\ + +definition V_constotal_1 :: "partial1 set" where + "V_constotal_1 \ {f. \j p. f = [j] \ p \ j \ 2 \ p \ \\<^sub>0\<^sub>1 \ \ j = f}" + +definition V_constotal_2 :: "partial1 set" where + "V_constotal_2 \ + {f. \j a k. + f = j # a @ [k] \ 0\<^sup>\ \ + j \ 2 \ + (\i 1) \ + k \ 2 \ + \ j = j # a \ \\<^sup>\ \ + \ k = f}" + +definition V_constotal :: "partial1 set" where + "V_constotal \ V_constotal_1 \ V_constotal_2" + +lemma V_constotal_2I: + assumes "f = j # a @ [k] \ 0\<^sup>\" + and "j \ 2" + and "\i 1" + and "k \ 2" + and "\ j = j # a \ \\<^sup>\" + and "\ k = f" + shows "f \ V_constotal_2" + using assms V_constotal_2_def by blast + +lemma V_subseteq_R1: "V_constotal \ \" +proof + fix f assume "f \ V_constotal" + then have "f \ V_constotal_1 \ f \ V_constotal_2" + using V_constotal_def by auto + then show "f \ \" + proof + assume "f \ V_constotal_1" + then obtain j p where "f = [j] \ p" "p \ \\<^sub>0\<^sub>1" + using V_constotal_1_def by blast + then show ?thesis using prepend_in_R1 RPred1_subseteq_R1 by auto + next + assume "f \ V_constotal_2" + then obtain j a k where "f = j # a @ [k] \ 0\<^sup>\" + using V_constotal_2_def by blast + then show ?thesis using almost0_in_R1 by auto + qed +qed + + +subsubsection \The class is in CONS\ + +text \The class can be learned by the strategy @{term rmge2}, which +outputs the rightmost value greater or equal two in the input $f^n$. If $f$ +is from $V_1$ then the strategy is correct right from the start. If $f$ is +from $V_2$ the strategy outputs the consistent hypothesis $j$ until it +encounters the correct hypothesis $k$, to which it converges.\ + +lemma V_in_CONS: "learn_cons \ V_constotal rmge2" +proof (rule learn_consI) + show "environment \ V_constotal rmge2" + using V_subseteq_R1 rmge2_in_R1 R1_imp_total1 phi_in_P2 by simp + have "(\i. \ i = f \ (\\<^sup>\n. rmge2 (f \ n) \= i)) \ + (\n. \k\n. \ (the (rmge2 (f \ n))) k = f k)" + if "f \ V_constotal" for f + proof (cases "f \ V_constotal_1") + case True + then obtain j p where + f: "f = [j] \ p" and + j: "j \ 2" and + p: "p \ \\<^sub>0\<^sub>1" and + phi_j: "\ j = f" + using V_constotal_1_def by blast + then have "f 0 \= j" by (simp add: prepend_at_less) + then have f_at_0: "the (f 0) \ 2" by (simp add: j) + have f_at_gr0: "the (f x) \ 1" if "x > 0" for x + using that f p by (simp add: RPred1_altdef Suc_leI prepend_at_ge) + have "total1 f" + using V_subseteq_R1 that R1_imp_total1 total1_def by auto + have "rmge2 (f \ n) \= j" for n + proof - + let ?P = "\i. i < Suc n \ the (f i) \ 2" + have "Greatest ?P = 0" + proof (rule Greatest_equality) + show "0 < Suc n \ 2 \ the (f 0)" + using f_at_0 by simp + show "\y. y < Suc n \ 2 \ the (f y) \ y \ 0" + using f_at_gr0 by fastforce + qed + then have "rmge2 (f \ n) = f 0" + using f_at_0 rmge2_init_total[of f n, OF `total1 f`] by auto + then show "rmge2 (f \ n) \= j" + by (simp add: \f 0 \= j\) + qed + then show ?thesis using phi_j by auto + next + case False + then have "f \ V_constotal_2" + using V_constotal_def that by auto + then obtain j a k where jak: + "f = j # a @ [k] \ 0\<^sup>\" + "j \ 2" + "\i 1" + "k \ 2" + "\ j = j # a \ \\<^sup>\ " + "\ k = f" + using V_constotal_2_def by blast + then have f_at_0: "f 0 \= j" by simp + have f_eq_a: "f x \= a ! (x - 1)" if "0 < x \ x < Suc (length a)" for x + proof - + have "x - 1 < length a" + using that by auto + then show ?thesis + by (simp add: jak(1) less_SucI nth_append that) + qed + then have f_at_a: "the (f x) \ 1" if "0 < x \ x < Suc (length a)" for x + using jak(3) that by auto + from jak have f_k: "f (Suc (length a)) \= k" by auto + from jak have f_at_big: "f x \= 0" if "x > Suc (length a)" for x + using that by simp + let ?P = "\n i. i < Suc n \ the (f i) \ 2" + have rmge2: "rmge2 (f \ n) = f (Greatest (?P n))" for n + proof - + have "\ (\i 2 \ the (f 0)" + using that by (simp add: jak(2) f_at_0) + show "\y. y < Suc n \ 2 \ the (f y) \ y \ 0" + using that f_at_a + by (metis Suc_1 dual_order.strict_trans leI less_Suc_eq not_less_eq_eq) + qed + with rmge2 f_at_0 have rmge2_small: + "rmge2 (f \ n) \= j" if "n < Suc (length a)" for n + using that by simp + have "Greatest (?P n) = Suc (length a)" if "n \ Suc (length a)" for n + proof (rule Greatest_equality) + show "Suc (length a) < Suc n \ 2 \ the (f (Suc (length a)))" + using that f_k by (simp add: jak(4) less_Suc_eq_le) + show "\y. y < Suc n \ 2 \ the (f y) \ y \ Suc (length a)" + using that f_at_big by (metis leI le_SucI not_less_eq_eq numeral_2_eq_2 option.sel) + qed + with rmge2 f_at_big f_k have rmge2_big: + "rmge2 (f \ n) \= k" if "n \ Suc (length a)" for n + using that by simp + then have "\i n\<^sub>0. \ i = f \ (\n\n\<^sub>0. rmge2 (f \ n) \= i)" + using jak(6) by auto + moreover have "\k\n. \ (the (rmge2 (f \ n))) k = f k" for n + proof (cases "n < Suc (length a)") + case True + then have "rmge2 (f \ n) \= j" + using rmge2_small by simp + then have "\ (the (rmge2 (f \ n))) = \ j" by simp + with True show ?thesis + using rmge2_small f_at_0 f_eq_a jak(5) prepend_at_less + by (metis le_less_trans le_zero_eq length_Cons not_le_imp_less nth_Cons_0 nth_Cons_pos) + next + case False + then show ?thesis using rmge2_big jak by simp + qed + ultimately show ?thesis by simp + qed + then show "\f. f \ V_constotal \ \i. \ i = f \ (\\<^sup>\n. rmge2 (f \ n) \= i)" + and "\f n. f \ V_constotal \ \k\n. \ (the (rmge2 (f \ n))) k = f k" + by simp_all +qed + + +subsubsection \The class is not in TOTAL\ + +text \Recall that $V$ is the union of $V_1 = \{jp \mid j\geq2 \land p \in +\mathcal{R}_{01} \land \varphi_j = jp\}$ and $V_2 = \{jak0^\infty \mid j\geq 2 \land a +\in \{0, 1\}^* \land k\geq 2 \land \varphi_j = ja\uparrow^\infty \land\ +\varphi_k = jak0^\infty\}$.\ + +text \The proof is adapted from a proof of a stronger result by +Freivalds, Kinber, and Wiehagen~\cite[Theorem~27]{fkw-iisde-95} concerning an +inference type not defined here. + +The proof is by contradiction. If $V$ was in TOTAL, there would be +a strategy $S$ learning $V$ in our standard Gödel numbering $\varphi$. +By Lemma R for TOTAL we can assume $S$ to be total. + +In order to construct a function $f\in V$ for which $S$ fails we employ a +computable process iteratively building function prefixes. For every $j$ the +process builds a function $\psi_j$. The initial prefix is the singleton +$[j]$. Given a prefix $b$, the next prefix is determined as follows: +\begin{enumerate} +\item Search for a $y \geq |b|$ with $\varphi_{S(b)}(y) \downarrow= v$ for +some $v$. +\item Set the new prefix $b0^{y - |b|}\bar{v}$, where $\bar v = 1 - v$. +\end{enumerate} + +Step~1 can diverge, for example, if $\varphi_{S(b)}$ is the empty function. +In this case $\psi_j$ will only be defined for a finite prefix. If, however, +Step~2 is reached, the prefix $b$ is extended to a $b'$ such that +$\varphi_{S(b)}(y) \neq b'_y$, which implies $S(b)$ is a wrong hypothesis for +every function starting with $b'$, in particular for $\psi_j$. Since $\bar v +\in \{0, 1\}$, Step~2 only appends zeros and ones, which is important for +showing membership in $V$. + +This process defines a numbering $\psi \in \mathcal{P}^2$, and by Kleene's +fixed-point theorem there is a $j \geq 2$ with $\varphi_j = \psi_j$. For this +$j$ there are two cases: +\begin{enumerate} +\item[Case 1.] Step~1 always succeeds. Then $\psi_j$ is total and + $\psi_j \in V_1$. But $S$ outputs wrong hypotheses on infinitely many + prefixes of $\psi_j$ (namely every prefix constructed by the process). + +\item[Case 2.] Step~1 diverges at some iteration, say when the state is $b = ja$ + for some $a \in \{0, 1\}^*$. + Then $\psi_j$ has the form $ja\uparrow^\infty$. The numbering $\chi$ with $\chi_k = + jak0^\infty$ is in $\mathcal{P}^2$, and by Kleene's fixed-point theorem there is a + $k\geq 2$ with $\varphi_k = \chi_k = jak0^\infty$. This $jak0^\infty$ is in + $V_2$ and has the prefix $ja$. But Step~1 diverged on this prefix, which + means there is no $y \geq |ja|$ with $\varphi_{S(ja)}(y)\downarrow$. In + other words $S$ hypothesizes a non-total function. +\end{enumerate} + +Thus, in both cases there is a function in $V$ where $S$ does not behave like +a TOTAL strategy. This is the desired contradiction. + +The following locale formalizes this proof sketch.\ + +locale total_cons = + fixes s :: partial1 + assumes s_in_R1: "s \ \" +begin + +definition r_s :: recf where + "r_s \ SOME r_s. recfn 1 r_s \ total r_s \ s = (\x. eval r_s [x])" + +lemma rs_recfn [simp]: "recfn 1 r_s" + and rs_total [simp]: "\x. eval r_s [x] \" + and eval_rs: "\x. s x = eval r_s [x]" + using r_s_def R1_SOME[OF s_in_R1, of r_s] by simp_all + +text \Performing Step~1 means enumerating the domain of +$\varphi_{S(b)}$ until a $y \geq |b|$ is found. The next function enumerates +all domain values and checks the condition for them.\ + +definition "r_search_enum \ + Cn 2 r_le [Cn 2 r_length [Id 2 1], Cn 2 r_enumdom [Cn 2 r_s [Id 2 1], Id 2 0]]" + +lemma r_search_enum_recfn [simp]: "recfn 2 r_search_enum" + by (simp add: r_search_enum_def Let_def) + +abbreviation search_enum :: partial2 where + "search_enum x b \ eval r_search_enum [x, b]" + +abbreviation enumdom :: partial2 where + "enumdom i y \ eval r_enumdom [i, y]" + +lemma enumdom_empty_domain: + assumes "\x. \ i x \" + shows "\y. enumdom i y \" + using assms r_enumdom_empty_domain by (simp add: phi_def) + +lemma enumdom_nonempty_domain: + assumes "\ i x\<^sub>0 \" + shows "\y. enumdom i y \" + and "\x. \ i x \ \ (\y. enumdom i y \= x)" + using assms r_enumdom_nonempty_domain phi_def by metis+ + +text \Enumerating the empty domain yields the empty function.\ + +lemma search_enum_empty: + fixes b :: nat + assumes "s b \= i" and "\x. \ i x \" + shows "\x. search_enum x b \" + using assms r_search_enum_def enumdom_empty_domain eval_rs by simp + +text \Enumerating a non-empty domain yields a total function.\ + +lemma search_enum_nonempty: + fixes b y0 :: nat + assumes "s b \= i" and "\ i y\<^sub>0 \" and "e = the (enumdom i x)" + shows "search_enum x b \= (if e_length b \ e then 0 else 1)" +proof - + let ?e = "\x. the (enumdom i x)" + let ?y = "Cn 2 r_enumdom [Cn 2 r_s [Id 2 1], Id 2 0]" + have "recfn 2 ?y" using assms(1) by simp + moreover have "\x. eval ?y [x, b] = enumdom i x" + using assms(1,2) eval_rs by auto + moreover from this have "\x. eval ?y [x, b] \" + using enumdom_nonempty_domain(1)[OF assms(2)] by simp + ultimately have "eval (Cn 2 r_le [Cn 2 r_length [Id 2 1], ?y]) [x, b] \= + (if e_length b \ ?e x then 0 else 1)" + by simp + then show ?thesis using assms by (simp add: r_search_enum_def) +qed + +text \If there is a $y$ as desired, the enumeration will eventually return +zero (representing ``true'').\ + +lemma search_enum_nonempty_eq0: + fixes b y :: nat + assumes "s b \= i" and "\ i y \" and "y \ e_length b" + shows "\x. search_enum x b \= 0" +proof - + obtain x where x: "enumdom i x \= y" + using enumdom_nonempty_domain(2)[OF assms(2)] assms(2) by auto + from assms(2) have "\ i y \" by simp + with x have "search_enum x b \= 0" + using search_enum_nonempty[where ?e=y] assms by auto + then show ?thesis by auto +qed + +text \If there is no $y$ as desired, the enumeration will never return +zero.\ + +lemma search_enum_nonempty_neq0: + fixes b y0 :: nat + assumes "s b \= i" + and "\ i y\<^sub>0 \" + and "\ (\y. \ i y \ \ y \ e_length b)" + shows "\ (\x. search_enum x b \= 0)" +proof + assume "\x. search_enum x b \= 0" + then obtain x where x: "search_enum x b \= 0" + by auto + obtain y where y: "enumdom i x \= y" + using enumdom_nonempty_domain[OF assms(2)] by blast + then have "search_enum x b \= (if e_length b \ y then 0 else 1)" + using assms(1-2) search_enum_nonempty by simp + with x have "e_length b \ y" + using option.inject by fastforce + moreover have "\ i y \" + using assms(2) enumdom_nonempty_domain(2) y by blast + ultimately show False using assms(3) by force +qed + +text \The next function corresponds to Step~1. Given a prefix $b$ it +computes a $y \geq |b|$ with $\varphi_{S(b)}(y)\downarrow$ if such a $y$ +exists; otherwise it diverges.\ + +definition "r_search \ Cn 1 r_enumdom [r_s, Mn 1 r_search_enum]" + +lemma r_search_recfn [simp]: "recfn 1 r_search" + using r_search_def by simp + +abbreviation search :: partial1 where + "search b \ eval r_search [b]" + +text \If $\varphi_{S(b)}$ is the empty function, the search process +diverges because already the enumeration of the domain diverges.\ + +lemma search_empty: + assumes "s b \= i" and "\x. \ i x \" + shows "search b \" +proof - + have "\x. search_enum x b \" + using search_enum_empty[OF assms] by simp + then have "eval (Mn 1 r_search_enum) [b] \" by simp + then show "search b \" unfolding r_search_def by simp +qed + +text \If $\varphi_{S(b)}$ is non-empty, but there is no $y$ with the +desired properties, the search process diverges.\ + +lemma search_nonempty_neq0: + fixes b y0 :: nat + assumes "s b \= i" + and "\ i y\<^sub>0 \" + and "\ (\y. \ i y \ \ y \ e_length b)" + shows "search b \" +proof - + have "\ (\x. search_enum x b \= 0)" + using assms search_enum_nonempty_neq0 by simp + moreover have "recfn 1 (Mn 1 r_search_enum)" + by (simp add: assms(1)) + ultimately have "eval (Mn 1 r_search_enum) [b] \" by simp + then show ?thesis using r_search_def by auto +qed + +text \If there is a $y$ as desired, the search process will return +one such $y$.\ + +lemma search_nonempty_eq0: + fixes b y :: nat + assumes "s b \= i" and "\ i y \" and "y \ e_length b" + shows "search b \" + and "\ i (the (search b)) \" + and "the (search b) \ e_length b" +proof - + have "\x. search_enum x b \= 0" + using assms search_enum_nonempty_eq0 by simp + moreover have "\x. search_enum x b \" + using assms search_enum_nonempty by simp + moreover have "recfn 1 (Mn 1 r_search_enum)" + by simp + ultimately have + 1: "search_enum (the (eval (Mn 1 r_search_enum) [b])) b \= 0" and + 2: "eval (Mn 1 r_search_enum) [b] \" + using eval_Mn_diverg eval_Mn_convergE[of 1 "r_search_enum" "[b]"] + by (metis (no_types, lifting) One_nat_def length_Cons list.size(3) option.collapse, + metis (no_types, lifting) One_nat_def length_Cons list.size(3)) + let ?x = "the (eval (Mn 1 r_search_enum) [b])" + have "search b = eval (Cn 1 r_enumdom [r_s, Mn 1 r_search_enum]) [b]" + unfolding r_search_def by simp + then have 3: "search b = enumdom i ?x" + using assms 2 eval_rs by simp + then have "the (search b) = the (enumdom i ?x)" (is "?y = _") + by simp + then have 4: "search_enum ?x b \= (if e_length b \ ?y then 0 else 1)" + using search_enum_nonempty assms by simp + from 3 have "\ i ?y \" + using enumdom_nonempty_domain assms(2) by (metis option.collapse) + then show "\ i ?y \" + using phi_def by simp + then show "?y \ e_length b" + using assms 4 1 option.inject by fastforce + show "search b \" + using 3 assms(2) enumdom_nonempty_domain(1) by auto +qed + +text \The converse of the previous lemma states that whenever +the search process returns a value it will be one with the +desired properties.\ + +lemma search_converg: + assumes "s b \= i" and "search b \" (is "?y \") + shows "\ i (the ?y) \" + and "the ?y \ e_length b" +proof - + have "\y. \ i y \" + using assms search_empty by meson + then have "\y. y \ e_length b \ \ i y \" + using search_nonempty_neq0 assms by meson + then obtain y where y: "y \ e_length b \ \ i y \" by auto + then have "\ i y \" + using phi_def by simp + then show "\ i (the (search b)) \" + and "(the (search b)) \ e_length b" + using y assms search_nonempty_eq0[OF assms(1) `\ i y \`] by simp_all +qed + +text \Likewise, if the search diverges, there is no appropriate $y$.\ + +lemma search_diverg: + assumes "s b \= i" and "search b \" + shows "\ (\y. \ i y \ \ y \ e_length b)" +proof + assume "\y. \ i y \ \ y \ e_length b" + then obtain y where y: "\ i y \" "y \ e_length b" + by auto + from y(1) have "\ i y \" + by (simp add: phi_def) + with y(2) search_nonempty_eq0 have "search b \" + using assms by blast + with assms(2) show False by simp +qed + +text \Step~2 extends the prefix by a block of the shape $0^n\bar v$. +The next function constructs such a block for given $n$ and $v$.\ + +definition "r_badblock \ + let f = Cn 1 r_singleton_encode [r_not]; + g = Cn 3 r_cons [r_constn 2 0, Id 3 1] + in Pr 1 f g" + +lemma r_badblock_prim [simp]: "recfn 2 r_badblock" + unfolding r_badblock_def by simp + +lemma r_badblock: "eval r_badblock [n, v] \= list_encode (replicate n 0 @ [1 - v])" +proof (induction n) + case 0 + let ?f = "Cn 1 r_singleton_encode [r_not]" + have "eval r_badblock [0, v] = eval ?f [v]" + unfolding r_badblock_def by simp + also have "... = eval r_singleton_encode [the (eval r_not [v])]" + by simp + also have "... \= list_encode [1 - v]" + by simp + finally show ?case by simp +next + case (Suc n) + let ?g = "Cn 3 r_cons [r_constn 2 0, Id 3 1]" + have "recfn 3 ?g" by simp + have "eval r_badblock [(Suc n), v] = eval ?g [n, the (eval r_badblock [n , v]), v]" + using `recfn 3 ?g` Suc by (simp add: r_badblock_def) + also have "... = eval ?g [n, list_encode (replicate n 0 @ [1 - v]), v]" + using Suc by simp + also have "... = eval r_cons [0, list_encode (replicate n 0 @ [1 - v])]" + by simp + also have "... \= e_cons 0 (list_encode (replicate n 0 @ [1 - v]))" + by simp + also have "... \= list_encode (0 # (replicate n 0 @ [1 - v]))" + by simp + also have "... \= list_encode (replicate (Suc n) 0 @ [1 - v])" + by simp + finally show ?case by simp +qed + +lemma r_badblock_only_01: "e_nth (the (eval r_badblock [n, v])) i \ 1" + using r_badblock by (simp add: nth_append) + +lemma r_badblock_last: "e_nth (the (eval r_badblock [n, v])) n = 1 - v" + using r_badblock by (simp add: nth_append) + +text \The following function computes the next prefix from the current +one. In other words, it performs Steps~1 and~2.\ + +definition "r_next \ + Cn 1 r_append + [Id 1 0, + Cn 1 r_badblock + [Cn 1 r_sub [r_search, r_length], + Cn 1 r_phi [r_s, r_search]]]" + +lemma r_next_recfn [simp]: "recfn 1 r_next" + unfolding r_next_def by simp + +text \The name @{text next} is unavailable, so we go for @{term nxt}.\ + +abbreviation nxt :: partial1 where + "nxt b \ eval r_next [b]" + +lemma nxt_diverg: + assumes "search b \" + shows "nxt b \" + unfolding r_next_def using assms by (simp add: Let_def) + +lemma nxt_converg: + assumes "search b \= y" + shows "nxt b \= + e_append b (list_encode (replicate (y - e_length b) 0 @ [1 - the (\ (the (s b)) y)]))" + unfolding r_next_def using assms r_badblock search_converg phi_def eval_rs + by fastforce + +lemma nxt_search_diverg: + assumes "nxt b \" + shows "search b \" +proof (rule ccontr) + assume "search b \" + then obtain y where "search b \= y" by auto + then show False + using nxt_converg assms by simp +qed + +text \If Step~1 finds a $y$, the hypothesis $S(b)$ is incorrect for +the new prefix.\ + +lemma nxt_wrong_hyp: + assumes "nxt b \= b'" and "s b \= i" + shows "\y i y \\ e_nth b' y" +proof - + obtain y where y: "search b \= y" + using assms nxt_diverg by fastforce + then have y_len: "y \ e_length b" + using assms search_converg(2) by fastforce + then have b': "b' = + (e_append b (list_encode (replicate (y - e_length b) 0 @ [1 - the (\ i y)])))" + using y assms nxt_converg by simp + then have "e_nth b' y = 1 - the (\ i y)" + using y_len e_nth_append_big r_badblock r_badblock_last by auto + moreover have "\ i y \" + using search_converg y y_len assms(2) by fastforce + ultimately have "\ i y \\ e_nth b' y" + by (metis gr_zeroI less_numeral_extra(4) less_one option.sel zero_less_diff) + moreover have "e_length b' = Suc y" + using y_len e_length_append b' by auto + ultimately show ?thesis by auto +qed + +text \If Step~1 diverges, the hypothesis $S(b)$ refers to a non-total +function.\ + +lemma nxt_nontotal_hyp: + assumes "nxt b \" and "s b \= i" + shows "\x. \ i x \" + using nxt_search_diverg[OF assms(1)] search_diverg[OF assms(2)] by auto + +text \The process only ever extends the given prefix.\ + +lemma nxt_stable: + assumes "nxt b \= b'" + shows "\x= y" + using assms nxt_diverg by fastforce + then have "y \ e_length b" + using search_converg(2) eval_rs rs_total by fastforce + show ?thesis + proof (rule allI, rule impI) + fix x assume "x < e_length b" + let ?i = "the (s b)" + have b': "b' = + (e_append b (list_encode (replicate (y - e_length b) 0 @ [1 - the (\ ?i y)])))" + using assms nxt_converg[OF y] by auto + then show "e_nth b x = e_nth b' x" + using e_nth_append_small \x < e_length b\ by auto + qed +qed + +text \The following properties of @{term r_next} will be +used to show that some of the constructed functions are in the class +$V$.\ + +lemma nxt_append_01: + assumes "nxt b \= b'" + shows "\x. x \ e_length b \ x < e_length b' \ e_nth b' x = 0 \ e_nth b' x = 1" +proof - + obtain y where y: "search b \= y" + using assms nxt_diverg by fastforce + let ?i = "the (s b)" + have b': "b' = (e_append b (list_encode (replicate (y - e_length b) 0 @ [1 - the (\ ?i y)])))" + (is "b' = (e_append b ?z)") + using assms y nxt_converg prod_encode_eq by auto + show ?thesis + proof (rule allI, rule impI) + fix x assume x: "e_length b \ x \ x < e_length b'" + then have "e_nth b' x = e_nth ?z (x - e_length b)" + using b' e_nth_append_big by blast + then show "e_nth b' x = 0 \ e_nth b' x = 1" + by (metis less_one nat_less_le option.sel r_badblock r_badblock_only_01) + qed +qed + +lemma nxt_monotone: + assumes "nxt b \= b'" + shows "e_length b < e_length b'" +proof - + obtain y where y: "search b \= y" + using assms nxt_diverg by fastforce + let ?i = "the (s b)" + have b': "b' = + (e_append b (list_encode (replicate (y - e_length b) 0 @ [1 - the (\ ?i y)])))" + using assms y nxt_converg prod_encode_eq by auto + then show ?thesis using e_length_append by auto +qed + +text \The next function computes the prefixes after each iteration of +the process @{term r_next} when started with the list $[j]$.\ + +definition r_prefixes :: recf where + "r_prefixes \ Pr 1 r_singleton_encode (Cn 3 r_next [Id 3 1])" + +lemma r_prefixes_recfn [simp]: "recfn 2 r_prefixes" + unfolding r_prefixes_def by (simp add: Let_def) + +abbreviation prefixes :: partial2 where + "prefixes t j \ eval r_prefixes [t, j]" + +lemma prefixes_at_0: "prefixes 0 j \= list_encode [j]" + unfolding r_prefixes_def by simp + +lemma prefixes_at_Suc: + assumes "prefixes t j \" (is "?b \") + shows "prefixes (Suc t) j = nxt (the ?b)" + using r_prefixes_def assms by auto + +lemma prefixes_at_Suc': + assumes "prefixes t j \= b" + shows "prefixes (Suc t) j = nxt b" + using r_prefixes_def assms by auto + +lemma prefixes_prod_encode: + assumes "prefixes t j \" + obtains b where "prefixes t j \= b" + using assms surj_prod_encode by force + +lemma prefixes_converg_le: + assumes "prefixes t j \" and "t' \ t" + shows "prefixes t' j \" + using r_prefixes_def assms eval_Pr_converg_le[of 1 _ _ "[j]"] + by simp + +lemma prefixes_diverg_add: + assumes "prefixes t j \" + shows "prefixes (t + d) j \" + using r_prefixes_def assms eval_Pr_diverg_add[of 1 _ _ "[j]"] + by simp + +text \Many properties of @{term r_prefixes} can be derived from similar +properties of @{term r_next}.\ + +lemma prefixes_length: + assumes "prefixes t j \= b" + shows "e_length b > t" +proof (insert assms, induction t arbitrary: b) + case 0 + then show ?case using prefixes_at_0 prod_encode_eq by auto +next + case (Suc t) + then have "prefixes t j \" + using prefixes_converg_le Suc_n_not_le_n nat_le_linear by blast + then obtain b' where b': "prefixes t j \= b'" + using prefixes_prod_encode by blast + with Suc have "e_length b' > t" by simp + have "prefixes (Suc t) j = nxt b'" + using b' prefixes_at_Suc' by simp + with Suc have "nxt b' \= b" by simp + then have "e_length b' < e_length b" + using nxt_monotone by simp + then show ?case using `e_length b' > t` by simp +qed + +lemma prefixes_monotone: + assumes "prefixes t j \= b" and "prefixes (t + d) j \= b'" + shows "e_length b \ e_length b'" +proof (insert assms, induction d arbitrary: b') + case 0 + then show ?case using prod_encode_eq by simp +next + case (Suc d) + moreover have "t + d \ t + Suc d" by simp + ultimately have "prefixes (t + d) j \" + using prefixes_converg_le by blast + then obtain b'' where b'': "prefixes (t + d) j \= b''" + using prefixes_prod_encode by blast + with Suc have "prefixes (t + Suc d) j = nxt b''" + by (simp add: prefixes_at_Suc') + with Suc have "nxt b'' \= b'" by simp + then show ?case using nxt_monotone Suc b'' by fastforce +qed + +lemma prefixes_stable: + assumes "prefixes t j \= b" and "prefixes (t + d) j \= b'" + shows "\x t + Suc d" by simp + ultimately have "prefixes (t + d) j \" + using prefixes_converg_le by blast + then obtain b'' where b'': "prefixes (t + d) j \= b''" + using prefixes_prod_encode by blast + with Suc have "prefixes (t + Suc d) j = nxt b''" + by (simp add: prefixes_at_Suc') + with Suc have b': "nxt b'' \= b'" by simp + show "\x e_length b''" + using x prefixes_monotone b'' Suc by fastforce + ultimately show "e_nth b x = e_nth b' x" + using b'' nxt_stable Suc b' prefixes_monotone x + by (metis leD le_neq_implies_less) + qed +qed + +lemma prefixes_tl_only_01: + assumes "prefixes t j \= b" + shows "\x>0. e_nth b x = 0 \ e_nth b x = 1" +proof (insert assms, induction t arbitrary: b) + case 0 + then show ?case using prefixes_at_0 prod_encode_eq by auto +next + case (Suc t) + then have "prefixes t j \" + using prefixes_converg_le Suc_n_not_le_n nat_le_linear by blast + then obtain b' where b': "prefixes t j \= b'" + using prefixes_prod_encode by blast + show "\x>0. e_nth b x = 0 \ e_nth b x = 1" + proof (rule allI, rule impI) + fix x :: nat + assume x: "x > 0" + show "e_nth b x = 0 \ e_nth b x = 1" + proof (cases "x < e_length b'") + case True + then show ?thesis + using Suc b' prefixes_at_Suc' nxt_stable x by metis + next + case False + then show ?thesis + using Suc.prems b' prefixes_at_Suc' nxt_append_01 by auto + qed + qed +qed + +lemma prefixes_hd: + assumes "prefixes t j \= b" + shows "e_nth b 0 = j" +proof - + obtain b' where b': "prefixes 0 j \= b'" + by (simp add: prefixes_at_0) + then have "b' = list_encode [j]" + by (simp add: prod_encode_eq prefixes_at_0) + then have "e_nth b' 0 = j" by simp + then show "e_nth b 0 = j" + using assms prefixes_stable[OF b', of t b] prefixes_length[OF b'] by simp +qed + +lemma prefixes_nontotal_hyp: + assumes "prefixes t j \= b" + and "prefixes (Suc t) j \" + and "s b \= i" + shows "\x. \ i x \" + using nxt_nontotal_hyp[OF _ assms(3)] assms(2) prefixes_at_Suc'[OF assms(1)] by simp + +text \We now consider the two cases from the proof sketch.\ + +abbreviation "case_two j \ \t. prefixes t j \" + +abbreviation "case_one j \ \ case_two j" + +text \In Case~2 there is a maximum convergent iteration because +iteration 0 converges.\ + +lemma case_two: + assumes "case_two j" + shows "\t. (\t'\t. prefixes t' j \) \ (\t'>t. prefixes t' j \)" +proof - + let ?P = "\t. prefixes t j \" + define t\<^sub>0 where "t\<^sub>0 = Least ?P" + then have "?P t\<^sub>0" + using assms LeastI_ex[of ?P] by simp + then have diverg: "?P t" if "t \ t\<^sub>0" for t + using prefixes_converg_le that by blast + from t\<^sub>0_def have converg: "\ ?P t" if "t < t\<^sub>0" for t + using Least_le[of ?P] that not_less by blast + have "t\<^sub>0 > 0" + proof (rule ccontr) + assume "\ 0 < t\<^sub>0" + then have "t\<^sub>0 = 0" by simp + with `?P t\<^sub>0` prefixes_at_0 show False by simp + qed + let ?t = "t\<^sub>0 - 1" + have "\t'\?t. prefixes t' j \" + using converg \0 < t\<^sub>0\ by auto + moreover have "\t'>?t. prefixes t' j \" + using diverg by simp + ultimately show ?thesis by auto +qed + +text \Having completed the modelling of the process, we can now define +the functions $\psi_j$ it computes. The value $\psi_j(x)$ is computed by +running @{term r_prefixes} until the prefix is longer than $x$ and then +taking the $x$-th element of the prefix.\ + +definition "r_psi \ + let f = Cn 3 r_less [Id 3 2, Cn 3 r_length [Cn 3 r_prefixes [Id 3 0, Id 3 1]]] + in Cn 2 r_nth [Cn 2 r_prefixes [Mn 2 f, Id 2 0], Id 2 1]" + +lemma r_psi_recfn: "recfn 2 r_psi" + unfolding r_psi_def by simp + +abbreviation psi :: partial2 ("\") where + "\ j x \ eval r_psi [j, x]" + +lemma psi_in_P2: "\ \ \

\<^sup>2" + using r_psi_recfn by auto + +text \The values of @{term "\"} can be read off the prefixes.\ + +lemma psi_eq_nth_prefix: + assumes "prefixes t j \= b" and "e_length b > x" + shows "\ j x \= e_nth b x" +proof - + let ?f = "Cn 3 r_less [Id 3 2, Cn 3 r_length [Cn 3 r_prefixes [Id 3 0, Id 3 1]]]" + let ?P = "\t. prefixes t j \ \ e_length (the (prefixes t j)) > x" + from assms have ex_t: "\t. ?P t" by auto + define t\<^sub>0 where "t\<^sub>0 = Least ?P" + then have "?P t\<^sub>0" + using LeastI_ex[OF ex_t] by simp + from ex_t have not_P: "\ ?P t" if "t < t\<^sub>0" for t + using ex_t that Least_le[of ?P] not_le t\<^sub>0_def by auto + + have "?P t" using assms by simp + with not_P have "t\<^sub>0 \ t" using leI by blast + then obtain b\<^sub>0 where b0: "prefixes t\<^sub>0 j \= b\<^sub>0" + using assms(1) prefixes_converg_le by blast + + have "eval ?f [t\<^sub>0, j, x] \= 0" + proof - + have "eval (Cn 3 r_prefixes [Id 3 0, Id 3 1]) [t\<^sub>0, j, x] \= b\<^sub>0" + using b0 by simp + then show ?thesis using `?P t\<^sub>0` by simp + qed + moreover have "eval ?f [t, j, x] \\ 0" if "t < t\<^sub>0" for t + proof - + obtain bt where bt: "prefixes t j \= bt" + using prefixes_converg_le[of t\<^sub>0 j t] b0 `t < t\<^sub>0` by auto + moreover have "\ ?P t" + using that not_P by simp + ultimately have "e_length bt \ x" by simp + moreover have "eval (Cn 3 r_prefixes [Id 3 0, Id 3 1]) [t, j, x] \= bt" + using bt by simp + ultimately show ?thesis by simp + qed + ultimately have "eval (Mn 2 ?f) [j, x] \= t\<^sub>0" + using eval_Mn_convergI[of 2 ?f "[j, x]" t\<^sub>0] by simp + then have "\ j x \= e_nth b\<^sub>0 x" + unfolding r_psi_def using b0 by simp + then show ?thesis + using `t\<^sub>0 \ t` assms(1) prefixes_stable[of t\<^sub>0 j b\<^sub>0 "t - t\<^sub>0" b] b0 `?P t\<^sub>0` + by simp +qed + +lemma psi_converg_imp_prefix: + assumes "\ j x \" + shows "\t b. prefixes t j \= b \ e_length b > x" +proof - + let ?f = "Cn 3 r_less [Id 3 2, Cn 3 r_length [Cn 3 r_prefixes [Id 3 0, Id 3 1]]]" + have "eval (Mn 2 ?f) [j, x] \" + proof (rule ccontr) + assume "\ eval (Mn 2 ?f) [j, x] \" + then have "eval (Mn 2 ?f) [j, x] \" by simp + then have "\ j x \" + unfolding r_psi_def by simp + then show False + using assms by simp + qed + then obtain t where t: "eval (Mn 2 ?f) [j, x] \= t" + by blast + have "recfn 2 (Mn 2 ?f)" by simp + then have f_zero: "eval ?f [t, j, x] \= 0" + using eval_Mn_convergE[OF _ t] + by (metis (no_types, lifting) One_nat_def Suc_1 length_Cons list.size(3)) + have "prefixes t j \" + proof (rule ccontr) + assume "\ prefixes t j \" + then have "prefixes t j \" by simp + then have "eval ?f [t, j, x] \" by simp + with f_zero show False by simp + qed + then obtain b' where b': "prefixes t j \= b'" by auto + moreover have "e_length b' > x" + proof (rule ccontr) + assume "\ e_length b' > x" + then have "eval ?f [t, j, x] \= 1" + using b' by simp + with f_zero show False by simp + qed + ultimately show ?thesis by auto +qed + +lemma psi_converg_imp_prefix': + assumes "\ j x \" + shows "\t b. prefixes t j \= b \ e_length b > x \ \ j x \= e_nth b x" + using psi_converg_imp_prefix[OF assms] psi_eq_nth_prefix by blast + +text \In both Case~1 and~2, $\psi_j$ starts with $j$.\ + +lemma psi_at_0: "\ j 0 \= j" + using prefixes_hd prefixes_length psi_eq_nth_prefix prefixes_at_0 by fastforce + +text \In Case~1, $\psi_j$ is total and made up of $j$ followed by zeros +and ones, just as required by the definition of $V_1$.\ + +lemma case_one_psi_total: + assumes "case_one j" and "x > 0" + shows "\ j x \= 0 \ \ j x \= 1" +proof - + obtain b where b: "prefixes x j \= b" + using assms(1) by auto + then have "e_length b > x" + using prefixes_length by simp + then have "\ j x \= e_nth b x" + using b psi_eq_nth_prefix by simp + moreover have "e_nth b x = 0 \ e_nth b x = 1" + using prefixes_tl_only_01[OF b] assms(2) by simp + ultimately show "\ j x \= 0 \ \ j x \= 1" + by simp +qed + +text \In Case~2, $\psi_j$ is defined only for a prefix starting with +$j$ and continuing with zeros and ones. This prefix corresponds to $ja$ from +the definition of $V_2$.\ + +lemma case_two_psi_only_prefix: + assumes "case_two j" + shows "\y. (\x. 0 < x \ x < y \ \ j x \= 0 \ \ j x \= 1) \ + (\x \ y. \ j x \)" +proof - + obtain t where + t_le: "\t'\t. prefixes t' j \" and + t_gr: "\t'>t. prefixes t' j \" + using assms case_two by blast + then obtain b where b: "prefixes t j \= b" + by auto + let ?y = "e_length b" + have "\ j x \= 0 \ \ j x \= 1" if "x > 0 \ x < ?y" for x + using t_le b that by (metis prefixes_tl_only_01 psi_eq_nth_prefix) + moreover have "\ j x \" if "x \ ?y" for x + proof (rule ccontr) + assume "\ j x \" + then obtain t' b' where t': "prefixes t' j \= b'" and "e_length b' > x" + using psi_converg_imp_prefix by blast + then have "e_length b' > ?y" + using that by simp + with t' have "t' > t" + using prefixes_monotone b by (metis add_diff_inverse_nat leD) + with t' t_gr show False by simp + qed + ultimately show ?thesis by auto +qed + +definition longest_prefix :: "nat \ nat" where + "longest_prefix j \ THE y. (\x j x \) \ (\x\y. \ j x \)" + +lemma longest_prefix: + assumes "case_two j" and "z = longest_prefix j" + shows "(\x j x \) \ (\x\z. \ j x \)" +proof - + let ?P = "\z. (\x j x \) \ (\x\z. \ j x \)" + obtain y where y: + "\x. 0 < x \ x < y \ \ j x \= 0 \ \ j x \= 1" + "\x\y. \ j x \" + using case_two_psi_only_prefix[OF assms(1)] by auto + have "?P (THE z. ?P z)" + proof (rule theI[of ?P y]) + show "?P y" + proof + show "\x j x \" + proof (rule allI, rule impI) + fix x assume "x < y" + show "\ j x \" + proof (cases "x = 0") + case True + then show ?thesis using psi_at_0 by simp + next + case False + then show ?thesis using y(1) `x < y` by auto + qed + qed + show "\x\y. \ j x \" using y(2) by simp + qed + show "z = y" if "?P z" for z + proof (rule ccontr, cases "z < y") + case True + moreover assume "z \ y" + ultimately show False + using that `?P y` by auto + next + case False + moreover assume "z \ y" + then show False + using that `?P y` y(2) by (meson linorder_cases order_refl) + qed + qed + then have "(\x<(THE z. ?P z). \ j x \) \ (\x\(THE z. ?P z). \ j x \)" + by blast + moreover have "longest_prefix j = (THE z. ?P z)" + unfolding longest_prefix_def by simp + ultimately show ?thesis using assms(2) by metis +qed + +lemma case_two_psi_longest_prefix: + assumes "case_two j" and "y = longest_prefix j" + shows "(\x. 0 < x \ x < y \ \ j x \= 0 \ \ j x \= 1) \ + (\x \ y. \ j x \)" + using assms longest_prefix case_two_psi_only_prefix + by (metis prefixes_tl_only_01 psi_converg_imp_prefix') + +text \The prefix cannot be empty because the process starts with prefix $[j]$.\ + +lemma longest_prefix_gr_0: + assumes "case_two j" + shows "longest_prefix j > 0" + using assms case_two_psi_longest_prefix psi_at_0 by force + +lemma psi_not_divergent_init: + assumes "prefixes t j \= b" + shows "(\ j) \ (e_length b - 1) = b" +proof (intro initI) + show "0 < e_length b" + using assms prefixes_length by fastforce + show "\ j x \= e_nth b x" if "x < e_length b" for x + using that assms psi_eq_nth_prefix by simp +qed + +text \In Case~2, the strategy $S$ outputs a non-total hypothesis on +some prefix of $\psi_j$.\ + +lemma case_two_nontotal_hyp: + assumes "case_two j" + shows "\n total1 (\ (the (s ((\ j) \ n))))" +proof - + obtain t where "\t'\t. prefixes t' j \" and t_gr: "\t'>t. prefixes t' j \" + using assms case_two by blast + then obtain b where b: "prefixes t j \= b" + by auto + moreover obtain i where i: "s b \= i" + using eval_rs by fastforce + moreover have div: "prefixes (Suc t) j \" + using t_gr by simp + ultimately have "\x. \ i x \" + using prefixes_nontotal_hyp by simp + then obtain x where "\ i x \" by auto + moreover have init: "\ j \ (e_length b - 1) = b" (is "_ \ ?n = b") + using psi_not_divergent_init[OF b] by simp + ultimately have "\ (the (s (\ j \ ?n))) x \" + using i by simp + then have "\ total1 (\ (the (s (\ j \ ?n))))" + by auto + moreover have "?n < longest_prefix j" + using case_two_psi_longest_prefix init b div psi_eq_nth_prefix + by (metis length_init lessI not_le_imp_less option.simps(3)) + ultimately show ?thesis by auto +qed + +text \Consequently, in Case~2 the strategy does not TOTAL-learn +any function starting with the longest prefix of $\psi_j$.\ + +lemma case_two_not_learn: + assumes "case_two j" + and "f \ \" + and "\x. x < longest_prefix j \ f x = \ j x" + shows "\ learn_total \ {f} s" +proof - + obtain n where n: + "n < longest_prefix j" + "\ total1 (\ (the (s (\ j \ n))))" + using case_two_nontotal_hyp[OF assms(1)] by auto + have "f \ n = \ j \ n" + using assms(3) n(1) by (intro init_eqI) auto + with n(2) show ?thesis by (metis R1_imp_total1 learn_totalE(3) singletonI) +qed + +text \In Case~1 the strategy outputs a wrong hypothesis +on infinitely many prefixes of $\psi_j$ and thus does not +learn $\psi_j$ in the limit, much less in the sense of TOTAL.\ + +lemma case_one_wrong_hyp: + assumes "case_one j" + shows "\n>k. \ (the (s ((\ j) \ n))) \ \ j" +proof - + have all_t: "\t. prefixes t j \" + using assms by simp + then obtain b where b: "prefixes (Suc k) j \= b" + by auto + then have length: "e_length b > Suc k" + using prefixes_length by simp + then have init: "\ j \ (e_length b - 1) = b" + using psi_not_divergent_init b by simp + obtain i where i: "s b \= i" + using eval_rs by fastforce + from all_t obtain b' where b': "prefixes (Suc (Suc k)) j \= b'" + by auto + then have "\ j \ (e_length b' - 1) = b'" + using psi_not_divergent_init by simp + moreover have "\y i y \\ e_nth b' y" + using nxt_wrong_hyp b b' i prefixes_at_Suc by auto + ultimately have "\y i y \ \ j y" + using b' psi_eq_nth_prefix by auto + then have "\ i \ \ j" by auto + then show ?thesis + using init length i by (metis Suc_less_eq length_init option.sel) +qed + +lemma case_one_not_learn: + assumes "case_one j" + shows "\ learn_lim \ {\ j} s" +proof (rule infinite_hyp_wrong_not_Lim[of "\ j"]) + show "\ j \ {\ j}" by simp + show "\n. \m>n. \ (the (s (\ j \ m))) \ \ j" + using case_one_wrong_hyp[OF assms] by simp +qed + +lemma case_one_not_learn_V: + assumes "case_one j" and "j \ 2" and "\ j = \ j" + shows "\ learn_lim \ V_constotal s" +proof - + have "\ j \ V_constotal_1" + proof - + define p where "p = (\x. (\ j) (x + 1))" + have "p \ \\<^sub>0\<^sub>1" + proof - + from p_def have "p \ \

" + using skip_P1[of "\ j" 1] psi_in_P2 P2_proj_P1 by blast + moreover have "p x \= 0 \ p x \= 1" for x + using p_def assms(1) case_one_psi_total by auto + moreover from this have "total1 p" by fast + ultimately show ?thesis using RPred1_def by auto + qed + moreover have "\ j = [j] \ p" + by (intro prepend_eqI, simp add: psi_at_0, simp add: p_def) + ultimately show ?thesis using assms(2,3) V_constotal_1_def by blast + qed + then have "\ j \ V_constotal" using V_constotal_def by auto + moreover have "\ learn_lim \ {\ j} s" + using case_one_not_learn assms(1) by simp + ultimately show ?thesis using learn_lim_closed_subseteq by auto +qed + +text \The next lemma embodies the construction of $\chi$ followed by +the application of Kleene's fixed-point theorem as described in the +proof sketch.\ + +lemma goedel_after_prefixes: + fixes vs :: "nat list" and m :: nat + shows "\n\m. \ n = vs @ [n] \ 0\<^sup>\" +proof - + define f :: partial1 where "f \ vs \ 0\<^sup>\" + then have "f \ \" + using almost0_in_R1 by auto + then obtain n where n: + "n \ m" + "\ n = (\x. if x = length vs then Some n else f x)" + using goedel_at[of f m "length vs"] by auto + moreover have "\ n x = (vs @ [n] \ 0\<^sup>\) x" for x + proof - + consider "x < length vs" | "x = length vs" | "x > length vs" + by linarith + then show ?thesis + using n f_def by (cases) (auto simp add: prepend_associative) + qed + ultimately show ?thesis by blast +qed + +text \If Case~2 holds for a $j\geq 2$ with $\varphi_j = \psi_j$, that +is, if $\psi_j\in V_1$, then there is a function in $V$, namely $\psi_j$, on +which $S$ fails. Therefore $S$ does not learn $V$.\ + +lemma case_two_not_learn_V: + assumes "case_two j" and "j \ 2" and "\ j = \ j" + shows "\ learn_total \ V_constotal s" +proof - + define z where "z = longest_prefix j" + then have "z > 0" + using longest_prefix_gr_0[OF assms(1)] by simp + define vs where "vs = prefix (\ j) (z - 1)" + then have "vs ! 0 = j" + using psi_at_0 `z > 0` by simp + define a where "a = tl vs" + then have vs: "vs = j # a" + using vs_def `vs ! 0 = j` + by (metis length_Suc_conv length_prefix list.sel(3) nth_Cons_0) + obtain k where k: "k \ 2" and phi_k: "\ k = j # a @ [k] \ 0\<^sup>\" + using goedel_after_prefixes[of 2 "j # a"] by auto + have phi_j: "\ j = j # a \ \\<^sup>\ " + proof (rule prepend_eqI) + show "\x. x < length (j # a) \ \ j x \= (j # a) ! x" + using assms(1,3) vs vs_def \0 < z\ + length_prefix[of "\ j" "z - 1"] + prefix_nth[of _ _ "\ j"] + psi_at_0[of j] + case_two_psi_longest_prefix[OF _ z_def] + longest_prefix[OF _ z_def] + by (metis One_nat_def Suc_pred option.collapse) + show "\x. \ j (length (j # a) + x) \" + using assms(3) vs_def + by (simp add: vs assms(1) case_two_psi_longest_prefix z_def) + qed + moreover have "\ k \ V_constotal_2" + proof (intro V_constotal_2I[of _ j a k]) + show "\ k = j # a @ [k] \ 0\<^sup>\" + using phi_k . + show "2 \ j" + using `2 \ j` . + show "2 \ k" + using `2 \ k` . + show "\i 1" + proof (rule allI, rule impI) + fix i assume i: "i < length a" + then have "Suc i < z" + using z_def vs_def length_prefix \0 < z\ vs + by (metis One_nat_def Suc_mono Suc_pred length_Cons) + have "a ! i = vs ! (Suc i)" + using vs by simp + also have "... = the (\ j (Suc i))" + using vs_def vs i length_Cons length_prefix prefix_nth + by (metis Suc_mono) + finally show "a ! i \ 1" + using case_two_psi_longest_prefix `Suc i < z` z_def + by (metis assms(1) less_or_eq_imp_le not_le_imp_less not_one_less_zero + option.sel zero_less_Suc) + qed + qed (auto simp add: phi_j) + then have "\ k \ V_constotal" + using V_constotal_def by auto + moreover have "\ learn_total \ {\ k} s" + proof - + have "\ k \ \" + by (simp add: phi_k almost0_in_R1) + moreover have "\x. x < longest_prefix j \ \ k x = \ j x" + using phi_k vs_def z_def length_prefix phi_j prepend_associative prepend_at_less + by (metis One_nat_def Suc_pred \0 < z\ \vs = j # a\ append_Cons assms(3)) + ultimately show ?thesis + using case_two_not_learn[OF assms(1)] by simp + qed + ultimately show "\ learn_total \ V_constotal s" + using learn_total_closed_subseteq by auto +qed + +text \The strategy $S$ does not learn $V$ in either case.\ + +lemma not_learn_total_V: "\ learn_total \ V_constotal s" +proof - + obtain j where "j \ 2" "\ j = \ j" + using kleene_fixed_point psi_in_P2 by auto + then show ?thesis + using case_one_not_learn_V learn_total_def case_two_not_learn_V + by (cases "case_two j") auto +qed + +end + + +lemma V_not_in_TOTAL: "V_constotal \ TOTAL" +proof (rule ccontr) + assume "\ V_constotal \ TOTAL" + then have "V_constotal \ TOTAL" by simp + then have "V_constotal \ TOTAL_wrt \" + by (simp add: TOTAL_wrt_phi_eq_TOTAL) + then obtain s where "learn_total \ V_constotal s" + using TOTAL_wrt_def by auto + then obtain s' where s': "s' \ \" "learn_total \ V_constotal s'" + using lemma_R_for_TOTAL_simple by blast + then interpret total_cons s' + by (simp add: total_cons_def) + have "\ learn_total \ V_constotal s'" + by (simp add: not_learn_total_V) + with s'(2) show False by simp +qed + +lemma TOTAL_neq_CONS: "TOTAL \ CONS" + using V_not_in_TOTAL V_in_CONS CONS_def by auto + +text \The main result of this section:\ + +theorem TOTAL_subset_CONS: "TOTAL \ CONS" + using TOTAL_subseteq_CONS TOTAL_neq_CONS by simp + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/Union.thy b/thys/Inductive_Inference/Union.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Union.thy @@ -0,0 +1,283 @@ +section \The union of classes\label{s:union}\ + +theory Union + imports R1_BC TOTAL_CONS +begin + +text \None of the inference types introduced in this chapter are closed +under union of classes. For all inference types except FIN this follows from +@{thm[source] "U0_V0_not_in_BC"}.\ + +lemma not_closed_under_union: + "\\\{CP, TOTAL, CONS, LIM, BC}. U\<^sub>0 \ \ \ V\<^sub>0 \ \ \ U\<^sub>0 \ V\<^sub>0 \ \" + using U0_in_CP U0_in_NUM V0_in_FIN + FIN_subseteq_CP + NUM_subseteq_TOTAL + CP_subseteq_TOTAL + TOTAL_subseteq_CONS + CONS_subseteq_Lim + Lim_subseteq_BC + U0_V0_not_in_BC + by blast + +text \In order to show the analogous result for FIN consider the +classes $\{0^\infty\}$ and $\{0^n10^\infty \mid n \in \mathbb{N}\}$. The +former can be learned finitely by a strategy that hypothesizes $0^\infty$ for +every input. The latter can be learned finitely by a strategy that waits for +the 1 and hypothesizes the only function in the class with a 1 at that +position. However, the union of both classes is not in FIN. This is because +any FIN strategy has to hypothesize $0^\infty$ on some prefix of the form +$0^n$. But the strategy then fails for the function $0^n10^\infty$.\ + +lemma singleton_in_FIN: "f \ \ \ {f} \ FIN" +proof - + assume "f \ \" + then obtain i where i: "\ i = f" + using phi_universal by blast + define s :: partial1 where "s = (\_. Some (Suc i))" + then have "s \ \" + using const_in_Prim1[of "Suc i"] by simp + have "learn_fin \ {f} s" + proof (intro learn_finI) + show "environment \ {f} s" + using `s \ \` `f \ \` by (simp add: phi_in_P2) + show "\i n\<^sub>0. \ i = g \ (\n0. s (g \ n) \= 0) \ (\n\n\<^sub>0. s (g \ n) \= Suc i)" + if "g \ {f}" for g + proof - + from that have "g = f" by simp + then have "\ i = g" + using i by simp + moreover have "\n<0. s (g \ n) \= 0" by simp + moreover have "\n\0. s (g \ n) \= Suc i" + using s_def by simp + ultimately show ?thesis by auto + qed + qed + then show "{f} \ FIN" using FIN_def by auto +qed + +definition U_single :: "partial1 set" where + "U_single \ {(\x. if x = n then Some 1 else Some 0)| n. n \ UNIV}" + +lemma U_single_in_FIN: "U_single \ FIN" +proof - + define psi :: partial2 where "psi \ \n x. if x = n then Some 1 else Some 0" + have "psi \ \\<^sup>2" + using psi_def by (intro R2I[of "Cn 2 r_not [r_eq]"]) auto + define s :: partial1 where + "s \ \b. if findr b \= e_length b then Some 0 else Some (Suc (the (findr b)))" + have "s \ \" + proof (rule R1I) + let ?r = "Cn 1 r_ifeq [r_findr, r_length, Z, Cn 1 S [r_findr]]" + show "recfn 1 ?r" by simp + show "total ?r" by auto + show "eval ?r [b] = s b" for b + proof - + let ?b = "the (findr b)" + have "eval ?r [b] = (if ?b = e_length b then Some 0 else Some (Suc (?b)))" + using findr_total by simp + then show "eval ?r [b] = s b" + by (metis findr_total option.collapse option.inject s_def) + qed + qed + have "U_single \ \" + proof + fix f + assume "f \ U_single" + then obtain n where "f = (\x. if x = n then Some 1 else Some 0)" + using U_single_def by auto + then have "f = psi n" + using psi_def by simp + then show "f \ \" + using `psi \ \\<^sup>2` by simp + qed + have "learn_fin psi U_single s" + proof (rule learn_finI) + show "environment psi U_single s" + using `psi \ \\<^sup>2` `s \ \` `U_single \ \` by simp + show "\i n\<^sub>0. psi i = f \ (\n0. s (f \ n) \= 0) \ (\n\n\<^sub>0. s (f \ n) \= Suc i)" + if "f \ U_single" for f + proof - + from that obtain i where i: "f = (\x. if x = i then Some 1 else Some 0)" + using U_single_def by auto + then have "psi i = f" + using psi_def by simp + moreover have "\n n) \= 0" + using i s_def findr_def by simp + moreover have "\n\i. s (f \ n) \= Suc i" + proof (rule allI, rule impI) + fix n + assume "n \ i" + let ?e = "init f n" + have "\i 0" + using `n \ i` i by simp + then have less: "the (findr ?e) < e_length ?e" + and nth_e: "e_nth ?e (the (findr ?e)) \ 0" + using findr_ex by blast+ + then have "s ?e \= Suc (the (findr ?e))" + using s_def by auto + moreover have "the (findr ?e) = i" + using nth_e less i by (metis length_init nth_init option.sel) + ultimately show "s ?e \= Suc i" by simp + qed + ultimately show ?thesis by auto + qed + qed + then show "U_single \ FIN" using FIN_def by blast +qed + +lemma zero_U_single_not_in_FIN: "{0\<^sup>\} \ U_single \ FIN" +proof + assume "{0\<^sup>\} \ U_single \ FIN" + then obtain psi s where learn: "learn_fin psi ({0\<^sup>\} \ U_single) s" + using FIN_def by blast + then have "learn_fin psi {0\<^sup>\} s" + using learn_fin_closed_subseteq by auto + then obtain i n\<^sub>0 where i: + "psi i = 0\<^sup>\" + "\n0. s (0\<^sup>\ \ n) \= 0" + "\n\n\<^sub>0. s (0\<^sup>\ \ n) \= Suc i" + using learn_finE(2) by blast + let ?f = "\x. if x = Suc n\<^sub>0 then Some 1 else Some 0" + have "?f \ 0\<^sup>\" by (metis option.inject zero_neq_one) + have "?f \ U_single" + using U_single_def by auto + then have "learn_fin psi {?f} s" + using learn learn_fin_closed_subseteq by simp + then obtain j m\<^sub>0 where j: + "psi j = ?f" + "\n0. s (?f \ n) \= 0" + "\n\m\<^sub>0. s (?f \ n) \= Suc j" + using learn_finE(2) by blast + consider + (less) "m\<^sub>0 < n\<^sub>0" | (eq) "m\<^sub>0 = n\<^sub>0" | (gr) "m\<^sub>0 > n\<^sub>0" + by linarith + then show False + proof (cases) + case less + then have "s (0\<^sup>\\ m\<^sub>0) \= 0" + using i by simp + moreover have "0\<^sup>\ \ m\<^sub>0 = ?f \ m\<^sub>0" + using less init_eqI[of m\<^sub>0 ?f "0\<^sup>\"] by simp + ultimately have "s (?f \ m\<^sub>0) \= 0" by simp + then show False using j by simp + next + case eq + then have "0\<^sup>\ \ m\<^sub>0 = ?f \ m\<^sub>0" + using init_eqI[of m\<^sub>0 ?f "0\<^sup>\"] by simp + then have "s (0\<^sup>\ \ m\<^sub>0) = s (?f \ m\<^sub>0)" by simp + then have "i = j" + using i j eq by simp + then have "psi i = psi j" by simp + then show False using `?f \ 0\<^sup>\` i j by simp + next + case gr + have "0\<^sup>\ \ n\<^sub>0 = ?f \ n\<^sub>0" + using init_eqI[of n\<^sub>0 ?f "0\<^sup>\"] by simp + moreover have "s (0\<^sup>\ \ n\<^sub>0) \= Suc i" + using i by simp + moreover have "s (?f \ n\<^sub>0) \= 0" + using j gr by simp + ultimately show False by simp + qed +qed + +lemma FIN_not_closed_under_union: "\U V. U \ FIN \ V \ FIN \ U \ V \ FIN" +proof - + have "{0\<^sup>\} \ FIN" + using singleton_in_FIN const_in_Prim1 by simp + moreover have "U_single \ FIN" + using U_single_in_FIN by simp + ultimately show ?thesis + using zero_U_single_not_in_FIN by blast +qed + +text \In contrast to the inference types, NUM is closed under the union +of classes. The total numberings that exist for each NUM class can be +interleaved to produce a total numbering encompassing the union of the +classes. To define the interleaving, modulo and division by two will be +helpful.\ + +definition "r_div2 \ + r_shrink + (Pr 1 Z + (Cn 3 r_ifle + [Cn 3 r_mul [r_constn 2 2, Cn 3 S [Id 3 0]], Id 3 2, Cn 3 S [Id 3 1], Id 3 1]))" + +lemma r_div2_prim [simp]: "prim_recfn 1 r_div2" + unfolding r_div2_def by simp + +lemma r_div2 [simp]: "eval r_div2 [n] \= n div 2" +proof - + let ?p = "Pr 1 Z + (Cn 3 r_ifle + [Cn 3 r_mul [r_constn 2 2, Cn 3 S [Id 3 0]], Id 3 2, Cn 3 S [Id 3 1], Id 3 1])" + have "eval ?p [i, n] \= min (n div 2) i" for i + by (induction i) auto + then have "eval ?p [n, n] \= n div 2" by simp + then show ?thesis unfolding r_div2_def by simp +qed + +definition "r_mod2 \ Cn 1 r_sub [Id 1 0, Cn 1 r_mul [r_const 2, r_div2]]" + +lemma r_mod2_prim [simp]: "prim_recfn 1 r_mod2" + unfolding r_mod2_def by simp + +lemma r_mod2 [simp]: "eval r_mod2 [n] \= n mod 2" + unfolding r_mod2_def using Rings.semiring_modulo_class.minus_mult_div_eq_mod + by auto + +lemma NUM_closed_under_union: + assumes "U \ NUM" and "V \ NUM" + shows "U \ V \ NUM" +proof - + from assms obtain psi_u psi_v where + psi_u: "psi_u \ \\<^sup>2" "\f. f \ U \ \i. psi_u i = f" and + psi_v: "psi_v \ \\<^sup>2" "\f. f \ V \ \i. psi_v i = f" + by fastforce + define psi where "psi \ \i. if i mod 2 = 0 then psi_u (i div 2) else psi_v (i div 2)" + from psi_u(1) obtain u where u: "recfn 2 u" "total u" "\x y. eval u [x, y] = psi_u x y" + by auto + from psi_v(1) obtain v where v: "recfn 2 v" "total v" "\x y. eval v [x, y] = psi_v x y" + by auto + let ?r_psi = "Cn 2 r_ifz + [Cn 2 r_mod2 [Id 2 0], + Cn 2 u [Cn 2 r_div2 [Id 2 0], Id 2 1], + Cn 2 v [Cn 2 r_div2 [Id 2 0], Id 2 1]]" + show ?thesis + proof (rule NUM_I[of psi]) + show "psi \ \\<^sup>2" + proof (rule R2I) + show "recfn 2 ?r_psi" + using u(1) v(1) by simp + show "eval ?r_psi [x, y] = psi x y" for x y + using u v psi_def prim_recfn_total R2_imp_total2[OF psi_u(1)] + R2_imp_total2[OF psi_v(1)] + by simp + moreover have "psi x y \" for x y + using psi_def psi_u(1) psi_v(1) by simp + ultimately show "total ?r_psi" + using `recfn 2 ?r_psi` totalI2 by simp + qed + show "\i. psi i = f" if "f \ U \ V" for f + proof (cases "f \ U") + case True + then obtain j where "psi_u j = f" + using psi_u(2) by auto + then have "psi (2 * j) = f" + using psi_def by simp + then show ?thesis by auto + next + case False + then have "f \ V" + using that by simp + then obtain j where "psi_v j = f" + using psi_v(2) by auto + then have "psi (Suc (2 * j)) = f" + using psi_def by simp + then show ?thesis by auto + qed + qed +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/Universal.thy b/thys/Inductive_Inference/Universal.thy new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/Universal.thy @@ -0,0 +1,2537 @@ +section \A universal partial recursive function\ + +theory Universal + imports Partial_Recursive +begin + +text \The main product of this section is a universal partial recursive +function, which given a code $i$ of an $n$-ary partial recursive function $f$ +and an encoded list @{term xs} of $n$ arguments, computes @{term "eval f +xs"}. From this we can derive fixed-arity universal functions satisfying the +usual results such as the $s$-$m$-$n$ theorem. To represent the code $i$, we +need a way to encode @{typ recf}s as natural numbers (Section~\ref{s:recf_enc}). To +construct the universal function, we devise a ternary function taking $i$, +$xs$, and a step bound $t$ and simulating the execution of $f$ on input $xs$ for +$t$ steps. This function is useful in its own right, enabling techniques like +dovetailing or ``concurrent'' evaluation of partial recursive functions. + +The notion of a ``step'' is not part of the definition of (the evaluation of) +partial recursive functions, but one can simulate the evaluation on an +abstract machine (Section~\ref{s:step}). This machine's configurations can be +encoded as natural numbers, and this leads us to a step function @{typ "nat +\ nat"} on encoded configurations (Section~\ref{s:step_enc}). +This function in turn can be computed by a primitive recursive function, from +which we develop the aforementioned ternary function of $i$, @{term xs}, and +$t$ (Section~\ref{s:step_recf}). From this we can finally derive +a universal function (Section~\ref{s:the_universal}).\ + +subsection \A step function\label{s:step}\ + +text \We simulate the stepwise execution of a partial recursive +function in a fairly straightforward way reminiscent of the execution of +function calls in an imperative programming language. A configuration of the +abstract machine is a pair consisting of: +\begin{enumerate} +\item A stack of frames. A frame represents the execution of a function and is + a triple @{term "(f, xs, locals)"} of + \begin{enumerate} + \item a @{typ recf} @{term f} being executed, + \item a @{typ "nat list"} of arguments of @{term f}, + \item a @{typ "nat list"} of local variables, which holds intermediate + values when @{term f} is of the form @{term Cn}, @{term Pr}, or @{term Mn}. + \end{enumerate} +\item A register of type @{typ "nat option"} representing the return value of + the last function call: @{term None} signals that in the previous step the + stack was not popped and hence no value was returned, whereas @{term "Some + v"} means that in the previous step a function returned @{term v}. +\end{enumerate} +For computing @{term h} on input @{term xs}, the initial configuration is +@{term "([(h, xs, [])], None)"}. When the computation for a frame ends, it is +popped off the stack, and its return value is put in the register. The entire +computation ends when the stack is empty. In such a final configuration the +register contains the value of @{term h} at @{term xs}. If no final +configuration is ever reached, @{term h} diverges at @{term xs}. + +The execution of one step depends on the topmost (that is, active) frame. In +the step when a frame @{term "(h, xs, locals)"} is pushed onto the stack, the +local variables are @{term "locals = []"}. The following happens until the +frame is popped off the stack again (if it ever is): +\begin{itemize} +\item For the base functions @{term "h = Z"}, @{term "h = S"}, + @{term[names_short] "h = Id m n"}, the frame is popped off the stack right away, + and the return value is placed in the register. +\item For @{term "h = Cn n f gs"}, for each function $g$ in @{term gs}: + \begin{enumerate} + \item A new frame of the form @{term "(g, xs, [])"} is pushed onto the stack. + \item When (and if) this frame + is eventually popped, the value in the register is @{term "eval g xs"}. This value + is appended to the list @{term locals} of local variables. + \end{enumerate} + When all $g$ in $gs$ have been evaluated in this manner, $f$ is evaluated on the local variables + by pushing @{term "(f, locals, [])"}. The resulting register value is kept + and the active frame for $h$ is popped off the stack. +\item For @{text "h = Pr n f g"}, let @{term "xs = y # ys"}. First @{term "(f, + ys, [])"} is pushed and the return value stored in the @{term + locals}. Then @{term "(g, x # v # ys, [])"} is pushed, + where $x$ is the length of @{term locals} and $v$ the most recently + appended value. The return value is appended to @{term locals}. This is + repeated until the length of @{term locals} reaches @{term y}. Then the most + recently appended local is placed in the register, and the stack is popped. +\item For @{text "h = Mn n f"}, frames @{term "(f, x # xs, [])"} are pushed + for $x = 0, 1, 2, \ldots$ until one of them returns $0$. Then this + $x$ is placed in the register and the stack is popped. Until then $x$ is + stored in @{term locals}. If none of these evaluations return $0$, the + stack never shrinks, and thus the machine never reaches a final state. +\end{itemize}\ + +type_synonym frame = "recf \ nat list \ nat list" + +type_synonym configuration = "frame list \ nat option" + + +subsubsection \Definition of the step function\ + +fun step :: "configuration \ configuration" where + "step ([], rv) = ([], rv)" +| "step (((Z, _, _) # fs), rv) = (fs, Some 0)" +| "step (((S, xs, _) # fs), rv) = (fs, Some (Suc (hd xs)))" +| "step (((Id m n, xs, _) # fs), rv) = (fs, Some (xs ! n))" +| "step (((Cn n f gs, xs, ls) # fs), rv) = + (if length ls = length gs + then if rv = None + then ((f, ls, []) # (Cn n f gs, xs, ls) # fs, None) + else (fs, rv) + else if rv = None + then if length ls < length gs + then ((gs ! (length ls), xs, []) # (Cn n f gs, xs, ls) # fs, None) + else (fs, rv) \\cannot occur, so don't-care term\ + else ((Cn n f gs, xs, ls @ [the rv]) # fs, None))" +| "step (((Pr n f g, xs, ls) # fs), rv) = + (if ls = [] + then if rv = None + then ((f, tl xs, []) # (Pr n f g, xs, ls) # fs, None) + else ((Pr n f g, xs, [the rv]) # fs, None) + else if length ls = Suc (hd xs) + then (fs, Some (hd ls)) + else if rv = None + then ((g, (length ls - 1) # hd ls # tl xs, []) # (Pr n f g, xs, ls) # fs, None) + else ((Pr n f g, xs, (the rv) # ls) # fs, None))" +| "step (((Mn n f, xs, ls) # fs), rv) = + (if ls = [] + then ((f, 0 # xs, []) # (Mn n f, xs, [0]) # fs, None) + else if rv = Some 0 + then (fs, Some (hd ls)) + else ((f, (Suc (hd ls)) # xs, []) # (Mn n f, xs, [Suc (hd ls)]) # fs, None))" + +definition reachable :: "configuration \ configuration \ bool" where + "reachable x y \ \t. iterate t step x = y" + +lemma step_reachable [intro]: + assumes "step x = y" + shows "reachable x y" + unfolding reachable_def using assms by (metis iterate.simps(1,2) comp_id) + +lemma reachable_transitive [trans]: + assumes "reachable x y" and "reachable y z" + shows "reachable x z" + using assms iterate_additive[where ?f=step] reachable_def by metis + +lemma reachable_refl: "reachable x x" + unfolding reachable_def by (metis iterate.simps(1) eq_id_iff) + +text \From a final configuration, that is, when the stack is empty, +only final configurations are reachable.\ + +lemma step_empty_stack: + assumes "fst x = []" + shows "fst (step x) = []" + using assms by (metis prod.collapse step.simps(1)) + +lemma reachable_empty_stack: + assumes "fst x = []" and "reachable x y" + shows "fst y = []" +proof - + have "fst (iterate t step x) = []" for t + using assms step_empty_stack by (induction t) simp_all + then show ?thesis + using reachable_def assms(2) by auto +qed + +abbreviation nonterminating :: "configuration \ bool" where + "nonterminating x \ \t. fst (iterate t step x) \ []" + +lemma reachable_nonterminating: + assumes "reachable x y" and "nonterminating y" + shows "nonterminating x" +proof - + from assms(1) obtain t\<^sub>1 where t1: "iterate t\<^sub>1 step x = y" + using reachable_def by auto + have "fst (iterate t step x) \ []" for t + proof (cases "t \ t\<^sub>1") + case True + then show ?thesis + using t1 assms(2) reachable_def reachable_empty_stack iterate_additive' + by (metis le_Suc_ex) + next + case False + then have "iterate t step x = iterate (t\<^sub>1 + (t - t\<^sub>1)) step x" + by simp + then have "iterate t step x = iterate (t - t\<^sub>1) step (iterate t\<^sub>1 step x)" + by (simp add: iterate_additive') + then have "iterate t step x = iterate (t - t\<^sub>1) step y" + using t1 by simp + then show "fst (iterate t step x) \ []" + using assms(2) by simp + qed + then show ?thesis .. +qed + +text \The function @{term step} is underdefined, for example, when the +top frame contains a non-well-formed @{typ recf} or too few arguments. All is +well, though, if every frame contains a well-formed @{typ recf} whose arity +matches the number of arguments. Such stacks will be called +\emph{valid}.\ + +definition valid :: "frame list \ bool" where + "valid stack \ \s\set stack. recfn (length (fst (snd s))) (fst s)" + +lemma valid_frame: "valid (s # ss) \ valid ss \ recfn (length (fst (snd s))) (fst s)" + using valid_def by simp + +lemma valid_ConsE: "valid ((f, xs, locs) # rest) \ valid rest \ recfn (length xs) f" + using valid_def by simp + +lemma valid_ConsI: "valid rest \ recfn (length xs) f \ valid ((f, xs, locs) # rest)" + using valid_def by simp + +text \Stacks in initial configurations are valid, and performing a step +maintains the validity of the stack.\ + +lemma step_valid: "valid stack \ valid (fst (step (stack, rv)))" +proof (cases stack) + case Nil + then show ?thesis using valid_def by simp +next + case (Cons s ss) + assume valid: "valid stack" + then have *: "valid ss \ recfn (length (fst (snd s))) (fst s)" + using valid_frame Cons by simp + show ?thesis + proof (cases "fst s") + case Z + then show ?thesis using Cons valid * by (metis fstI prod.collapse step.simps(2)) + next + case S + then show ?thesis using Cons valid * by (metis fst_conv prod.collapse step.simps(3)) + next + case Id + then show ?thesis using Cons valid * by (metis fstI prod.collapse step.simps(4)) + next + case (Cn n f gs) + then obtain xs ls where "s = (Cn n f gs, xs, ls)" + using Cons by (metis prod.collapse) + moreover consider + "length ls = length gs \ rv \" + | "length ls = length gs \ rv \" + | "length ls < length gs \ rv \" + | "length ls \ length gs \ rv \" + | "length ls > length gs \ rv \" + by linarith + ultimately show ?thesis using valid Cons valid_def by (cases) auto + next + case (Pr n f g) + then obtain xs ls where s: "s = (Pr n f g, xs, ls)" + using Cons by (metis prod.collapse) + consider + "length ls = 0 \ rv \" + | "length ls = 0 \ rv \" + | "length ls \ 0 \ length ls = Suc (hd xs)" + | "length ls \ 0 \ length ls \ Suc (hd xs) \ rv \" + | "length ls \ 0 \ length ls \ Suc (hd xs) \ rv \" + by linarith + then show ?thesis using Cons * valid_def s by (cases) auto + next + case (Mn n f) + then obtain xs ls where s: "s = (Mn n f, xs, ls)" + using Cons by (metis prod.collapse) + consider + "length ls = 0" + | "length ls \ 0 \ rv \" + | "length ls \ 0 \ rv \" + by linarith + then show ?thesis using Cons * valid_def s by (cases) auto + qed +qed + +corollary iterate_step_valid: + assumes "valid stack" + shows "valid (fst (iterate t step (stack, rv)))" + using assms +proof (induction t) + case 0 + then show ?case by simp +next + case (Suc t) + moreover have "iterate (Suc t) step (stack, rv) = step (iterate t step (stack, rv))" + by simp + ultimately show ?case using step_valid valid_def by (metis prod.collapse) +qed + + +subsubsection \Correctness of the step function\ + +text \The function @{term step} works correctly for a @{typ recf} $f$ +on arguments @{term xs} in some configuration if (1) in case $f$ converges, @{term +step} reaches a configuration with the topmost frame popped and @{term "eval +f xs"} in the register, and (2) in case $f$ diverges, @{term step} does not +reach a final configuration.\ + +fun correct :: "configuration \ bool" where + "correct ([], r) = True" +| "correct ((f, xs, ls) # rest, r) = + (if eval f xs \ then reachable ((f, xs, ls) # rest, r) (rest, eval f xs) + else nonterminating ((f, xs, ls) # rest, None))" + +lemma correct_convergI: + assumes "eval f xs \" and "reachable ((f, xs, ls) # rest, None) (rest, eval f xs)" + shows "correct ((f, xs, ls) # rest, None)" + using assms by auto + +lemma correct_convergE: + assumes "correct ((f, xs, ls) # rest, None)" and "eval f xs \" + shows "reachable ((f, xs, ls) # rest, None) (rest, eval f xs)" + using assms by simp + +text \The correctness proof for @{term step} is by structural induction +on the @{typ recf} in the top frame. The base cases @{term Z}, @{term S}, +and @{term[names_short] Id} are simple. For @{text "X = Cn, Pr, Mn"}, the +lemmas named @{text reachable_X} show which configurations are reachable for +@{typ recf}s of shape @{text X}. Building on those, the lemmas named @{text +step_X_correct} show @{term step}'s correctness for @{text X}.\ + +lemma reachable_Cn: + assumes "valid (((Cn n f gs), xs, []) # rest)" (is "valid ?stack") + and "\xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + and "\g xs rest. + g \ set gs \ valid ((g, xs, []) # rest) \ correct ((g, xs, []) # rest, None)" + and "\i" + and "k \ length gs" + shows "reachable + (?stack, None) + ((Cn n f gs, xs, take k (map (\g. the (eval g xs)) gs)) # rest, None)" + using assms(4,5) +proof (induction k) + case 0 + then show ?case using reachable_refl by simp +next + case (Suc k) + let ?ys = "map (\g. the (eval g xs)) gs" + from Suc have "k < length gs" by simp + have valid: "recfn (length xs) (Cn n f gs)" "valid rest" + using assms(1) valid_ConsE[of "(Cn n f gs)"] by simp_all + from Suc have "reachable (?stack, None) ((Cn n f gs, xs, take k ?ys) # rest, None)" + (is "_ (?stack1, None)") + by simp + also have "reachable ... ((gs ! k, xs, []) # ?stack1, None)" + using step_reachable `k < length gs` by (simp add: min_absorb2) + also have "reachable ... (?stack1, eval (gs ! k) xs)" + (is "_ (_, ?rv)") + using Suc.prems(1) \k < length gs\ assms(3) valid valid_ConsI by auto + also have "reachable ... ((Cn n f gs, xs, (take (Suc k) ?ys)) # rest, None)" + (is "_ (?stack2, None)") + proof - + have "step (?stack1, ?rv) = ((Cn n f gs, xs, (take k ?ys) @ [the ?rv]) # rest, None)" + using Suc by auto + also have "... = ((Cn n f gs, xs, (take (Suc k) ?ys)) # rest, None)" + by (simp add: \k < length gs\ take_Suc_conv_app_nth) + finally show ?thesis + using step_reachable by simp + qed + finally show "reachable (?stack, None) (?stack2, None)" . +qed + +lemma step_Cn_correct: + assumes "valid (((Cn n f gs), xs, []) # rest)" (is "valid ?stack") + and "\xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + and "\g xs rest. + g \ set gs \ valid ((g, xs, []) # rest) \ correct ((g, xs, []) # rest, None)" + shows "correct (?stack, None)" +proof - + have valid: "recfn (length xs) (Cn n f gs)" "valid rest" + using valid_ConsE[OF assms(1)] by auto + let ?ys = "map (\g. the (eval g xs)) gs" + consider + (diverg_f) "\g\set gs. eval g xs \" and "eval f ?ys \" + | (diverg_gs) "\g\set gs. eval g xs \" + | (converg) "eval (Cn n f gs) xs \" + using valid_ConsE[OF assms(1)] by fastforce + then show ?thesis + proof (cases) + case diverg_f + then have "\i" by simp + then have "reachable (?stack, None) ((Cn n f gs, xs, ?ys) # rest, None)" + (is "_ (?stack1, None)") + using reachable_Cn[OF assms, where ?k="length gs"] by simp + also have "reachable ... ((f, ?ys, []) # ?stack1, None)" (is "_ (?stack2, None)") + by (simp add: step_reachable) + finally have "reachable (?stack, None) (?stack2, None)" . + moreover have "nonterminating (?stack2, None)" + using diverg_f(2) assms(2)[of ?ys ?stack1] valid_ConsE[OF assms(1)] valid_ConsI + by auto + ultimately have "nonterminating (?stack, None)" + using reachable_nonterminating by simp + moreover have "eval (Cn n f gs) xs \" + using diverg_f(2) assms(1) eval_Cn valid_ConsE by presburger + ultimately show ?thesis by simp + next + case diverg_gs + then have ex_i: "\i" + using in_set_conv_nth[of _ gs] by auto + define k where "k = (LEAST i. i < length gs \ eval (gs ! i) xs \)" (is "_ = Least ?P") + then have gs_k: "eval (gs ! k) xs \" + using LeastI_ex[OF ex_i] by simp + have "\i" + using k_def not_less_Least[of _ ?P] LeastI_ex[OF ex_i] by simp + moreover from this have "k < length gs" + using ex_i less_le_trans not_le by blast + ultimately have "reachable (?stack, None) ((Cn n f gs, xs, take k ?ys) # rest, None)" + using reachable_Cn[OF assms] by simp + also have "reachable ... + ((gs ! (length (take k ?ys)), xs, []) # (Cn n f gs, xs, take k ?ys) # rest, None)" + (is "_ (?stack1, None)") + proof - + have "length (take k ?ys) < length gs" + by (simp add: \k < length gs\ less_imp_le_nat min_less_iff_disj) + then show ?thesis using step_reachable by simp + qed + finally have "reachable (?stack, None) (?stack1, None)" . + moreover have "nonterminating (?stack1, None)" + proof - + have "recfn (length xs) (gs ! k)" + using \k < length gs\ valid(1) by simp + then have "correct (?stack1, None)" + using \k < length gs\ nth_mem valid valid_ConsI + assms(3)[of "gs ! (length (take k ?ys))" xs] + by auto + moreover have "length (take k ?ys) = k" + by (simp add: \k < length gs\ less_imp_le_nat min_absorb2) + ultimately show ?thesis using gs_k by simp + qed + ultimately have "nonterminating (?stack, None)" + using reachable_nonterminating by simp + moreover have "eval (Cn n f gs) xs \" + using diverg_gs valid by fastforce + ultimately show ?thesis by simp + next + case converg + then have f: "eval f ?ys \" and g: "\g. g \ set gs \ eval g xs \" + using valid(1) by (metis eval_Cn)+ + then have "\i" + by simp + then have "reachable (?stack, None) ((Cn n f gs, xs, take (length gs) ?ys) # rest, None)" + using reachable_Cn assms by blast + also have "reachable ... ((Cn n f gs, xs, ?ys) # rest, None)" (is "_ (?stack1, None)") + by (simp add: reachable_refl) + also have "reachable ... ((f, ?ys, []) # ?stack1, None)" + using step_reachable by simp + also have "reachable ... (?stack1, eval f ?ys)" + using assms(2)[of "?ys"] correct_convergE valid f valid_ConsI by auto + also have "reachable (?stack1, eval f ?ys) (rest, eval f ?ys)" + using f by auto + finally have "reachable (?stack, None) (rest, eval f ?ys)" . + moreover have "eval (Cn n f gs) xs = eval f ?ys" + using g valid(1) by auto + ultimately show ?thesis + using converg correct_convergI by auto + qed +qed + +text \During the execution of a frame with a partial recursive function +of shape @{term "Pr n f g"} and arguments @{term "x # xs"}, the list of local +variables collects all the function values up to @{term x} in reversed +order. We call such a list a @{term trace} for short.\ + +definition trace :: "nat \ recf \ recf \ nat list \ nat \ nat list" where + "trace n f g xs x \ map (\y. the (eval (Pr n f g) (y # xs))) (rev [0..xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + and "\xs rest. valid ((g, xs, []) # rest) \ correct ((g, xs, []) # rest, None)" + and "y \ x" + and "eval (Pr n f g) (y # xs) \" + shows "reachable (?stack, None) ((Pr n f g, x # xs, trace n f g xs y) # rest, None)" + using assms(4,5) +proof (induction y) + case 0 + have valid: "recfn (length (x # xs)) (Pr n f g)" "valid rest" + using valid_ConsE[OF assms(1)] by simp_all + then have f: "eval f xs \" using 0 by simp + let ?as = "x # xs" + have "reachable (?stack, None) ((f, xs, []) # ((Pr n f g), ?as, []) # rest, None)" + using step_reachable by simp + also have "reachable ... (?stack, eval f xs)" + using assms(2)[of xs "((Pr n f g), ?as, []) # rest"] + correct_convergE[OF _ f] f valid valid_ConsI + by simp + also have "reachable ... ((Pr n f g, ?as, [the (eval f xs)]) # rest, None)" + using step_reachable valid(1) f by simp + finally have "reachable (?stack, None) ((Pr n f g, ?as, [the (eval f xs)]) # rest, None)" . + then show ?case using trace_def valid(1) by simp +next + case (Suc y) + have valid: "recfn (length (x # xs)) (Pr n f g)" "valid rest" + using valid_ConsE[OF assms(1)] by simp_all + let ?ls = "trace n f g xs y" + have lenls: "length ?ls = Suc y" + using trace_length by auto + moreover have hdls: "hd ?ls = the (eval (Pr n f g) (y # xs))" + using Suc trace_hd by auto + ultimately have g: + "eval g (y # hd ?ls # xs) \" + "eval (Pr n f g) (Suc y # xs) = eval g (y # hd ?ls # xs)" + using eval_Pr_Suc_converg hdls valid(1) Suc by simp_all + then have "reachable (?stack, None) ((Pr n f g, x # xs, ?ls) # rest, None)" + (is "_ (?stack1, None)") + using Suc valid(1) by fastforce + also have "reachable ... ((g, y # hd ?ls # xs, []) # (Pr n f g, x # xs, ?ls) # rest, None)" + using Suc.prems lenls by fastforce + also have "reachable ... (?stack1, eval g (y # hd ?ls # xs))" + (is "_ (_, ?rv)") + using assms(3) g(1) valid valid_ConsI by auto + also have "reachable ... ((Pr n f g, x # xs, (the ?rv) # ?ls) # rest, None)" + using Suc.prems(1) g(1) lenls by auto + finally have "reachable (?stack, None) ((Pr n f g, x # xs, (the ?rv) # ?ls) # rest, None)" . + moreover have "trace n f g xs (Suc y) = (the ?rv) # ?ls" + using g(2) trace_Suc by simp + ultimately show ?case by simp +qed + +lemma step_Pr_correct: + assumes "valid (((Pr n f g), xs, []) # rest)" (is "valid ?stack") + and "\xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + and "\xs rest. valid ((g, xs, []) # rest) \ correct ((g, xs, []) # rest, None)" + shows "correct (?stack, None)" +proof - + have valid: "valid rest" "recfn (length xs) (Pr n f g)" + using valid_ConsE[OF assms(1)] by simp_all + then have "length xs > 0" + by auto + then obtain y ys where y_ys: "xs = y # ys" + using list.exhaust_sel by auto + let ?t = "trace n f g ys" + consider + (converg) "eval (Pr n f g) xs \" + | (diverg_f) "eval (Pr n f g) xs \" and "eval f ys \" + | (diverg) "eval (Pr n f g) xs \" and "eval f ys \" + by auto + then show ?thesis + proof (cases) + case converg + then have "\z. z \ y \ reachable (?stack, None) (((Pr n f g), xs, ?t z) # rest, None)" + using assms valid by (simp add: eval_Pr_converg_le reachable_Pr y_ys) + then have "reachable (?stack, None) (((Pr n f g), xs, ?t y) # rest, None)" + by simp + moreover have "reachable (((Pr n f g), xs, ?t y) # rest, None) (rest, Some (hd (?t y)))" + using trace_length step_reachable y_ys by fastforce + ultimately have "reachable (?stack, None) (rest, Some (hd (?t y)))" + using reachable_transitive by blast + then show ?thesis + using assms(1) trace_hd converg y_ys by simp + next + case diverg_f + have *: "step (?stack, None) = ((f, ys, []) # ((Pr n f g), xs, []) # tl ?stack, None)" + (is "_ = (?stack1, None)") + using assms(1,2) y_ys by simp + then have "reachable (?stack, None) (?stack1, None)" + using step_reachable by simp + moreover have "nonterminating (?stack1, None)" + using assms diverg_f valid valid_ConsI * by auto + ultimately have "nonterminating (?stack, None)" + using reachable_nonterminating by blast + then show ?thesis using diverg_f(1) assms(1) by simp + next + case diverg + let ?h = "\z. the (eval (Pr n f g) (z # ys))" + let ?Q = "\z. z < y \ eval (Pr n f g) (z # ys) \" + have "?Q 0" + using assms diverg neq0_conv y_ys valid by fastforce + define zmax where "zmax = Greatest ?Q" + then have "?Q zmax" + using `?Q 0` GreatestI_nat[of ?Q 0 y] by simp + have le_zmax: "\z. ?Q z \ z \ zmax" + using Greatest_le_nat[of ?Q _ y] zmax_def by simp + have len: "length (?t zmax) < Suc y" + by (simp add: \?Q zmax\ trace_length) + have "eval (Pr n f g) (y # ys) \" if "y \ zmax" for y + using that zmax_def `?Q zmax` assms eval_Pr_converg_le[of n f g ys zmax y] valid y_ys + by simp + then have "reachable (?stack, None) (((Pr n f g), xs, ?t y) # rest, None)" + if "y \ zmax" for y + using that `?Q zmax` diverg y_ys assms reachable_Pr by simp + then have "reachable (?stack, None) (((Pr n f g), xs, ?t zmax) # rest, None)" + (is "reachable _ (?stack1, None)") + by simp + also have "reachable ... + ((g, zmax # ?h zmax # tl xs, []) # (Pr n f g, xs, ?t zmax) # rest, None)" + (is "_ (?stack2, None)") + proof (rule step_reachable) + have "length (?t zmax) \ Suc (hd xs)" + using len y_ys by simp + moreover have "hd (?t zmax) = ?h zmax" + using trace_hd by auto + moreover have "length (?t zmax) = Suc zmax" + using trace_length by simp + ultimately show "step (?stack1, None) = (?stack2, None)" + by auto + qed + finally have "reachable (?stack, None) (?stack2, None)" . + moreover have "nonterminating (?stack2, None)" + proof - + have "correct (?stack2, None)" + using y_ys assms valid_ConsI valid by simp + moreover have "eval g (zmax # ?h zmax # ys) \" + using \?Q zmax\ diverg le_zmax len less_Suc_eq trace_length y_ys valid + by fastforce + ultimately show ?thesis using y_ys by simp + qed + ultimately have "nonterminating (?stack, None)" + using reachable_nonterminating by simp + then show ?thesis using diverg assms(1) by simp + qed +qed + +lemma reachable_Mn: + assumes "valid ((Mn n f, xs, []) # rest)" (is "valid ?stack") + and "\xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + and "\y {None, Some 0}" + shows "reachable (?stack, None) ((f, z # xs, []) # (Mn n f, xs, [z]) # rest, None)" + using assms(3) +proof (induction z) + case 0 + then have "step (?stack, None) = ((f, 0 # xs, []) # (Mn n f, xs, [0]) # rest, None)" + using assms by simp + then show ?case + using step_reachable assms(1) by simp +next + case (Suc z) + have valid: "valid rest" "recfn (length xs) (Mn n f)" + using valid_ConsE[OF assms(1)] by auto + have f: "eval f (z # xs) \ {None, Some 0}" + using Suc by simp + have "reachable (?stack, None) ((f, z # xs, []) # (Mn n f, xs, [z]) # rest, None)" + using Suc by simp + also have "reachable ... ((Mn n f, xs, [z]) # rest, eval f (z # xs))" + using f assms(2)[of "z # xs"] valid correct_convergE valid_ConsI by auto + also have "reachable ... ((f, (Suc z) # xs, []) # (Mn n f, xs, [Suc z]) # rest, None)" + (is "_ (?stack1, None)") + using step_reachable f by simp + finally have "reachable (?stack, None) (?stack1, None)" . + then show ?case by simp +qed + +lemma iterate_step_empty_stack: "iterate t step ([], rv) = ([], rv)" + using step_empty_stack by (induction t) simp_all + +lemma reachable_iterate_step_empty_stack: + assumes "reachable cfg ([], rv)" + shows "\t. iterate t step cfg = ([], rv) \ (\t' [])" +proof - + let ?P = "\t. iterate t step cfg = ([], rv)" + from assms have "\t. ?P t" + by (simp add: reachable_def) + moreover define tmin where "tmin = Least ?P" + ultimately have "?P tmin" + using LeastI_ex[of ?P] by simp + have "fst (iterate t' step cfg) \ []" if "t' < tmin" for t' + proof + assume "fst (iterate t' step cfg) = []" + then obtain v where v: "iterate t' step cfg = ([], v)" + by (metis prod.exhaust_sel) + then have "iterate t'' step ([], v) = ([], v)" for t'' + using iterate_step_empty_stack by simp + then have "iterate (t' + t'') step cfg = ([], v)" for t'' + using v iterate_additive by fast + moreover obtain t'' where "t' + t'' = tmin" + using \t' < tmin\ less_imp_add_positive by auto + ultimately have "iterate tmin step cfg = ([], v)" + by auto + then have "v = rv" + using `?P tmin` by simp + then have "iterate t' step cfg = ([], rv)" + using v by simp + moreover have "\t' ?P t'" + unfolding tmin_def using not_less_Least[of _ ?P] by simp + ultimately show False + using that by simp + qed + then show ?thesis using `?P tmin` by auto +qed + +lemma step_Mn_correct: + assumes "valid ((Mn n f, xs, []) # rest)" (is "valid ?stack") + and "\xs rest. valid ((f, xs, []) # rest) \ correct ((f, xs, []) # rest, None)" + shows "correct (?stack, None)" +proof - + have valid: "valid rest" "recfn (length xs) (Mn n f)" + using valid_ConsE[OF assms(1)] by auto + consider + (diverg) "eval (Mn n f) xs \" and "\z. eval f (z # xs) \" + | (diverg_f) "eval (Mn n f) xs \" and "\z. eval f (z # xs) \" + | (converg) "eval (Mn n f) xs \" + by fast + then show ?thesis + proof (cases) + case diverg + then have "\z. eval f (z # xs) \ Some 0" + using eval_Mn_diverg[OF valid(2)] by simp + then have "\y {None, Some 0}" for z + using diverg by simp + then have reach_z: + "\z. reachable (?stack, None) ((f, z # xs, []) # (Mn n f, xs, [z]) # rest, None)" + using reachable_Mn[OF assms] diverg by simp + + define h :: "nat \ configuration" where + "h z \ ((f, z # xs, []) # (Mn n f, xs, [z]) # rest, None)" for z + then have h_inj: "\x y. x \ y \ h x \ h y" and z_neq_Nil: "\z. fst (h z) \ []" + by simp_all + + have z: "\z\<^sub>0. \z>z\<^sub>0. \ (\t'\t. iterate t' step (?stack, None) = h z)" for t + proof (induction t) + case 0 + then show ?case by (metis h_inj le_zero_eq less_not_refl3) + next + case (Suc t) + then show ?case + using h_inj by (metis (no_types, hide_lams) le_Suc_eq less_not_refl3 less_trans) + qed + + have "nonterminating (?stack, None)" + proof (rule ccontr) + assume "\ nonterminating (?stack, None)" + then obtain t where t: "fst (iterate t step (?stack, None)) = []" + by auto + then obtain z\<^sub>0 where "\z>z\<^sub>0. \ (\t'\t. iterate t' step (?stack, None) = h z)" + using z by auto + then have not_h: "\t'\t. iterate t' step (?stack, None) \ h (Suc z\<^sub>0)" + by simp + have "\t'\t. fst (iterate t' step (?stack, None)) = []" + using t iterate_step_empty_stack iterate_additive'[of t] + by (metis le_Suc_ex prod.exhaust_sel) + then have "\t'\t. iterate t' step (?stack, None) \ h (Suc z\<^sub>0)" + using z_neq_Nil by auto + then have "\t'. iterate t' step (?stack, None) \ h (Suc z\<^sub>0)" + using not_h nat_le_linear by auto + then have "\ reachable (?stack, None) (h (Suc z\<^sub>0))" + using reachable_def by simp + then show False + using reach_z[of "Suc z\<^sub>0"] h_def by simp + qed + then show ?thesis using diverg by simp + next + case diverg_f + let ?P = "\z. eval f (z # xs) \" + define zmin where "zmin \ Least ?P" + then have "\y {None, Some 0}" + using diverg_f eval_Mn_diverg[OF valid(2)] less_trans not_less_Least[of _ ?P] + by blast + moreover have f_zmin: "eval f (zmin # xs) \" + using diverg_f LeastI_ex[of ?P] zmin_def by simp + ultimately have + "reachable (?stack, None) ((f, zmin # xs, []) # (Mn n f, xs, [zmin]) # rest, None)" + (is "reachable _ (?stack1, None)") + using reachable_Mn[OF assms] by simp + moreover have "nonterminating (?stack1, None)" + using f_zmin assms valid diverg_f valid_ConsI by auto + ultimately have "nonterminating (?stack, None)" + using reachable_nonterminating by simp + then show ?thesis using diverg_f by simp + next + case converg + then obtain z where z: "eval (Mn n f) xs \= z" by auto + have f_z: "eval f (z # xs) \= 0" + and f_less_z: "\y. y < z \ eval f (y # xs) \\ 0" + using eval_Mn_convergE(2,3)[OF valid(2) z] by simp_all + then have + "reachable (?stack, None) ((f, z # xs, []) # (Mn n f, xs, [z]) # rest, None)" + using reachable_Mn[OF assms] by simp + also have "reachable ... ((Mn n f, xs, [z]) # rest, eval f (z # xs))" + using assms(2)[of "z # xs"] valid f_z valid_ConsI correct_convergE + by auto + also have "reachable ... (rest, Some z)" + using f_z f_less_z step_reachable by simp + finally have "reachable (?stack, None) (rest, Some z)" . + then show ?thesis using z by simp + qed +qed + +theorem step_correct: + assumes "valid ((f, xs, []) # rest)" + shows "correct ((f, xs, []) # rest, None)" + using assms +proof (induction f arbitrary: xs rest) + case Z + then show ?case using valid_ConsE[of Z] step_reachable by simp +next + case S + then show ?case using valid_ConsE[of S] step_reachable by simp +next + case (Id m n) + then show ?case using valid_ConsE[of "Id m n"] by auto +next + case Cn + then show ?case using step_Cn_correct by presburger +next + case Pr + then show ?case using step_Pr_correct by simp +next + case Mn + then show ?case using step_Mn_correct by presburger +qed + + +subsection \Encoding partial recursive functions\label{s:recf_enc}\ + +text \In this section we define an injective, but not surjective, +mapping from @{typ recf}s to natural numbers.\ + +abbreviation triple_encode :: "nat \ nat \ nat \ nat" where + "triple_encode x y z \ prod_encode (x, prod_encode (y, z))" + +abbreviation quad_encode :: "nat \ nat \ nat \ nat \ nat" where + "quad_encode w x y z \ prod_encode (w, prod_encode (x, prod_encode (y, z)))" + +fun encode :: "recf \ nat" where + "encode Z = 0" +| "encode S = 1" +| "encode (Id m n) = triple_encode 2 m n" +| "encode (Cn n f gs) = quad_encode 3 n (encode f) (list_encode (map encode gs))" +| "encode (Pr n f g) = quad_encode 4 n (encode f) (encode g)" +| "encode (Mn n f) = triple_encode 5 n (encode f)" + +lemma prod_encode_gr1: "a > 1 \ prod_encode (a, x) > 1" + using le_prod_encode_1 less_le_trans by blast + +lemma encode_not_Z_or_S: "encode f = prod_encode (a, b) \ a > 1 \ f \ Z \ f \ S" + by (metis encode.simps(1) encode.simps(2) less_numeral_extra(4) not_one_less_zero + prod_encode_gr1) + +lemma encode_injective: "encode f = encode g \ f = g" +proof (induction g arbitrary: f) + case Z + have "\a x. a > 1 \ prod_encode (a, x) > 0" + using prod_encode_gr1 by (meson less_one less_trans) + then have "f \ Z \ encode f > 0" + by (cases f) auto + then have "encode f = 0 \ f = Z" by fastforce + then show ?case using Z by simp +next + case S + have "\a x. a > 1 \ prod_encode (a, x) \ Suc 0" + using prod_encode_gr1 by (metis One_nat_def less_numeral_extra(4)) + then have "encode f = 1 \ f = S" + by (cases f) auto + then show ?case using S by simp +next + case Id + then obtain z where *: "encode f = prod_encode (2, z)" by simp + show ?case + using Id by (cases f) (simp_all add: * encode_not_Z_or_S prod_encode_eq) +next + case Cn + then obtain z where *: "encode f = prod_encode (3, z)" by simp + show ?case + proof (cases f) + case Z + then show ?thesis using * encode_not_Z_or_S by simp + next + case S + then show ?thesis using * encode_not_Z_or_S by simp + next + case Id + then show ?thesis using * by (simp add: prod_encode_eq) + next + case Cn + then show ?thesis + using * Cn.IH Cn.prems list_decode_encode + by (smt encode.simps(4) fst_conv list.inj_map_strong prod_encode_eq snd_conv) + next + case Pr + then show ?thesis using * by (simp add: prod_encode_eq) + next + case Mn + then show ?thesis using * by (simp add: prod_encode_eq) + qed +next + case Pr + then obtain z where *: "encode f = prod_encode (4, z)" by simp + show ?case + using Pr by (cases f) (simp_all add: * encode_not_Z_or_S prod_encode_eq) +next + case Mn + then obtain z where *: "encode f = prod_encode (5, z)" by simp + show ?case + using Mn by (cases f) (simp_all add: * encode_not_Z_or_S prod_encode_eq) +qed + +definition encode_kind :: "nat \ nat" where + "encode_kind e \ if e = 0 then 0 else if e = 1 then 1 else pdec1 e" + +lemma encode_kind_0: "encode_kind (encode Z) = 0" + unfolding encode_kind_def by simp + +lemma encode_kind_1: "encode_kind (encode S) = 1" + unfolding encode_kind_def by simp + +lemma encode_kind_2: "encode_kind (encode (Id m n)) = 2" + unfolding encode_kind_def + by (metis encode.simps(1-3) encode_injective fst_conv prod_encode_inverse + recf.simps(16) recf.simps(8)) + +lemma encode_kind_3: "encode_kind (encode (Cn n f gs)) = 3" + unfolding encode_kind_def + by (metis encode.simps(1,2,4) encode_injective fst_conv prod_encode_inverse + recf.simps(10) recf.simps(18)) + +lemma encode_kind_4: "encode_kind (encode (Pr n f g)) = 4" + unfolding encode_kind_def + by (metis encode.simps(1,2,5) encode_injective fst_conv prod_encode_inverse + recf.simps(12) recf.simps(20)) + +lemma encode_kind_5: "encode_kind (encode (Mn n f)) = 5" + unfolding encode_kind_def + by (metis encode.simps(1,2,6) encode_injective fst_conv prod_encode_inverse + recf.simps(14) recf.simps(22)) + +lemmas encode_kind_n = + encode_kind_0 encode_kind_1 encode_kind_2 encode_kind_3 encode_kind_4 encode_kind_5 + +lemma encode_kind_Cn: + assumes "encode_kind (encode f) = 3" + shows "\n f' gs. f = Cn n f' gs" + using assms encode_kind_n by (cases f) auto + +lemma encode_kind_Pr: + assumes "encode_kind (encode f) = 4" + shows "\n f' g. f = Pr n f' g" + using assms encode_kind_n by (cases f) auto + +lemma encode_kind_Mn: + assumes "encode_kind (encode f) = 5" + shows "\n g. f = Mn n g" + using assms encode_kind_n by (cases f) auto + +lemma pdec2_encode_Id: "pdec2 (encode (Id m n)) = prod_encode (m, n)" + by simp + +lemma pdec2_encode_Pr: "pdec2 (encode (Pr n f g)) = triple_encode n (encode f) (encode g)" + by simp + + +subsection \The step function on encoded configurations\label{s:step_enc}\ + +text \In this section we construct a function @{text "estep :: nat +\ nat"} that is equivalent to the function @{text "step :: +configuration \ configuration"} except that it applies to encoded +configurations. We start by defining an encoding for configurations.\ + +definition encode_frame :: "frame \ nat" where + "encode_frame s \ + triple_encode (encode (fst s)) (list_encode (fst (snd s))) (list_encode (snd (snd s)))" + +lemma encode_frame: + "encode_frame (f, xs, ls) = triple_encode (encode f) (list_encode xs) (list_encode ls)" + unfolding encode_frame_def by simp + +abbreviation encode_option :: "nat option \ nat" where + "encode_option x \ if x = None then 0 else Suc (the x)" + +definition encode_config :: "configuration \ nat" where + "encode_config cfg \ + prod_encode (list_encode (map encode_frame (fst cfg)), encode_option (snd cfg))" + +lemma encode_config: + "encode_config (ss, rv) = prod_encode (list_encode (map encode_frame ss), encode_option rv)" + unfolding encode_config_def by simp + +text \Various projections from encoded configurations:\ + +definition e2stack where "e2stack e \ pdec1 e" +definition e2rv where "e2rv e \ pdec2 e" +definition e2tail where "e2tail e \ e_tl (e2stack e)" +definition e2frame where "e2frame e \ e_hd (e2stack e)" +definition e2i where "e2i e \ pdec1 (e2frame e)" +definition e2xs where "e2xs e \ pdec12 (e2frame e)" +definition e2ls where "e2ls e \ pdec22 (e2frame e)" +definition e2lenas where "e2lenas e \ e_length (e2xs e)" +definition e2lenls where "e2lenls e \ e_length (e2ls e)" + +lemma e2rv_rv [simp]: + "e2rv (encode_config (ss, rv)) = (if rv \ then 0 else Suc (the rv))" + unfolding e2rv_def using encode_config by simp + +lemma e2stack_stack [simp]: + "e2stack (encode_config (ss, rv)) = list_encode (map encode_frame ss)" + unfolding e2stack_def using encode_config by simp + +lemma e2tail_tail [simp]: + "e2tail (encode_config (s # ss, rv)) = list_encode (map encode_frame ss)" + unfolding e2tail_def using encode_config by fastforce + +lemma e2frame_frame [simp]: + "e2frame (encode_config (s # ss, rv)) = encode_frame s" + unfolding e2frame_def using encode_config by fastforce + +lemma e2i_f [simp]: + "e2i (encode_config ((f, xs, ls) # ss, rv)) = encode f" + unfolding e2i_def using encode_config e2frame_frame encode_frame by force + +lemma e2xs_xs [simp]: + "e2xs (encode_config ((f, xs, ls) # ss, rv)) = list_encode xs" + using e2xs_def e2frame_frame encode_frame by force + +lemma e2ls_ls [simp]: + "e2ls (encode_config ((f, xs, ls) # ss, rv)) = list_encode ls" + using e2ls_def e2frame_frame encode_frame by force + +lemma e2lenas_lenas [simp]: + "e2lenas (encode_config ((f, xs, ls) # ss, rv)) = length xs" + using e2lenas_def e2frame_frame encode_frame by simp + +lemma e2lenls_lenls [simp]: + "e2lenls (encode_config ((f, xs, ls) # ss, rv)) = length ls" + using e2lenls_def e2frame_frame encode_frame by simp + +lemma e2stack_0_iff_Nil: + assumes "e = encode_config (ss, rv)" + shows "e2stack e = 0 \ ss = []" + using assms + by (metis list_encode.simps(1) e2stack_stack list_encode_0 map_is_Nil_conv) + +lemma e2ls_0_iff_Nil [simp]: "list_decode (e2ls e) = [] \ e2ls e = 0" + by (metis list_decode.simps(1) list_encode_decode) + +text \We now define @{text eterm} piecemeal by considering the more +complicated cases @{text Cn}, @{text Pr}, and @{text Mn} separately.\ + +definition "estep_Cn e \ + if e2lenls e = e_length (pdec222 (e2i e)) + then if e2rv e = 0 + then prod_encode (e_cons (triple_encode (pdec122 (e2i e)) (e2ls e) 0) (e2stack e), 0) + else prod_encode (e2tail e, e2rv e) + else if e2rv e = 0 + then if e2lenls e < e_length (pdec222 (e2i e)) + then prod_encode + (e_cons + (triple_encode (e_nth (pdec222 (e2i e)) (e2lenls e)) (e2xs e) 0) + (e2stack e), + 0) + else prod_encode (e2tail e, e2rv e) + else prod_encode + (e_cons + (triple_encode (e2i e) (e2xs e) (e_snoc (e2ls e) (e2rv e - 1))) + (e2tail e), + 0)" + +lemma estep_Cn: + assumes "c = (((Cn n f gs, xs, ls) # fs), rv)" + shows "estep_Cn (encode_config c) = encode_config (step c)" + using encode_frame by (simp add: assms estep_Cn_def, simp add: encode_config assms) + +definition "estep_Pr e \ + if e2ls e = 0 + then if e2rv e = 0 + then prod_encode + (e_cons (triple_encode (pdec122 (e2i e)) (e_tl (e2xs e)) 0) (e2stack e), + 0) + else prod_encode + (e_cons (triple_encode (e2i e) (e2xs e) (singleton_encode (e2rv e - 1))) (e2tail e), + 0) + else if e2lenls e = Suc (e_hd (e2xs e)) + then prod_encode (e2tail e, Suc (e_hd (e2ls e))) + else if e2rv e = 0 + then prod_encode + (e_cons + (triple_encode + (pdec222 (e2i e)) + (e_cons (e2lenls e - 1) (e_cons (e_hd (e2ls e)) (e_tl (e2xs e)))) + 0) + (e2stack e), + 0) + else prod_encode + (e_cons + (triple_encode (e2i e) (e2xs e) (e_cons (e2rv e - 1) (e2ls e))) (e2tail e), + 0)" + +lemma estep_Pr1: + assumes "c = (((Pr n f g, xs, ls) # fs), rv)" + and "ls \ []" + and "length ls \ Suc (hd xs)" + and "rv \ None" + and "recfn (length xs) (Pr n f g)" + shows "estep_Pr (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + from assms(5) have "length xs > 0" by auto + then have eq: "hd xs = e_hd (e2xs ?e)" + using assms e_hd_def by auto + have "step c = ((Pr n f g, xs, (the rv) # ls) # fs, None)" + (is "step c = (?t # ?ss, None)") + using assms by simp + then have "encode_config (step c) = + prod_encode (list_encode (map encode_frame (?t # ?ss)), 0)" + using encode_config by simp + also have "... = + prod_encode (e_cons (encode_frame ?t) (list_encode (map encode_frame (?ss))), 0)" + by simp + also have "... = prod_encode (e_cons (encode_frame ?t) (e2tail ?e), 0)" + using assms(1) by simp + also have "... = prod_encode + (e_cons + (triple_encode (e2i ?e) (e2xs ?e) (e_cons (e2rv ?e - 1) (e2ls ?e))) + (e2tail ?e), + 0)" + by (simp add: assms encode_frame) + finally show ?thesis + using assms eq estep_Pr_def by auto +qed + +lemma estep_Pr2: + assumes "c = (((Pr n f g, xs, ls) # fs), rv)" + and "ls \ []" + and "length ls \ Suc (hd xs)" + and "rv = None" + and "recfn (length xs) (Pr n f g)" + shows "estep_Pr (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + from assms(5) have "length xs > 0" by auto + then have eq: "hd xs = e_hd (e2xs ?e)" + using assms e_hd_def by auto + have "step c = ((g, (length ls - 1) # hd ls # tl xs, []) # (Pr n f g, xs, ls) # fs, None)" + (is "step c = (?t # ?ss, None)") + using assms by simp + then have "encode_config (step c) = + prod_encode (list_encode (map encode_frame (?t # ?ss)), 0)" + using encode_config by simp + also have "... = + prod_encode (e_cons (encode_frame ?t) (list_encode (map encode_frame (?ss))), 0)" + by simp + also have "... = prod_encode (e_cons (encode_frame ?t) (e2stack ?e), 0)" + using assms(1) by simp + also have "... = prod_encode + (e_cons + (triple_encode + (pdec222 (e2i ?e)) + (e_cons (e2lenls ?e - 1) (e_cons (e_hd (e2ls ?e)) (e_tl (e2xs ?e)))) + 0) + (e2stack ?e), + 0)" + using assms(1,2) encode_frame[of g "(length ls - 1) # hd ls # tl xs" "[]"] + pdec2_encode_Pr[of n f g] e2xs_xs e2i_f e2lenls_lenls e2ls_ls e_hd + by (metis list_encode.simps(1) list.collapse list_decode_encode + prod_encode_inverse snd_conv) + finally show ?thesis + using assms eq estep_Pr_def by auto +qed + +lemma estep_Pr3: + assumes "c = (((Pr n f g, xs, ls) # fs), rv)" + and "ls \ []" + and "length ls = Suc (hd xs)" + and "recfn (length xs) (Pr n f g)" + shows "estep_Pr (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + from assms(4) have "length xs > 0" by auto + then have "hd xs = e_hd (e2xs ?e)" + using assms e_hd_def by auto + then have "(length ls = Suc (hd xs)) = (e2lenls ?e = Suc (e_hd (e2xs ?e)))" + using assms by simp + then have *: "estep_Pr ?e = prod_encode (e2tail ?e, Suc (e_hd (e2ls ?e)))" + using assms estep_Pr_def by auto + have "step c = (fs, Some (hd ls))" + using assms(1,2,3) by simp + then have "encode_config (step c) = + prod_encode (list_encode (map encode_frame fs), encode_option (Some (hd ls)))" + using encode_config by simp + also have "... = + prod_encode (list_encode (map encode_frame fs), encode_option (Some (e_hd (e2ls ?e))))" + using assms(1,2) e_hd_def by auto + also have "... = prod_encode (list_encode (map encode_frame fs), Suc (e_hd (e2ls ?e)))" + by simp + also have "... = prod_encode (e2tail ?e, Suc (e_hd (e2ls ?e)))" + using assms(1) by simp + finally have "encode_config (step c) = prod_encode (e2tail ?e, Suc (e_hd (e2ls ?e)))" . + then show ?thesis + using estep_Pr_def * by presburger +qed + +lemma estep_Pr4: + assumes "c = (((Pr n f g, xs, ls) # fs), rv)" and "ls = []" + shows "estep_Pr (encode_config c) = encode_config (step c)" + using encode_frame + by (simp add: assms estep_Pr_def, simp add: encode_config assms) + +lemma estep_Pr: + assumes "c = (((Pr n f g, xs, ls) # fs), rv)" + and "recfn (length xs) (Pr n f g)" + shows "estep_Pr (encode_config c) = encode_config (step c)" + using assms estep_Pr1 estep_Pr2 estep_Pr3 estep_Pr4 by simp + +definition "estep_Mn e \ + if e2ls e = 0 + then prod_encode + (e_cons + (triple_encode (pdec22 (e2i e)) (e_cons 0 (e2xs e)) 0) + (e_cons + (triple_encode (e2i e) (e2xs e) (singleton_encode 0)) + (e2tail e)), + 0) + else if e2rv e = 1 + then prod_encode (e2tail e, Suc (e_hd (e2ls e))) + else prod_encode + (e_cons + (triple_encode (pdec22 (e2i e)) (e_cons (Suc (e_hd (e2ls e))) (e2xs e)) 0) + (e_cons + (triple_encode (e2i e) (e2xs e) (singleton_encode (Suc (e_hd (e2ls e))))) + (e2tail e)), + 0)" + +lemma estep_Mn: + assumes "c = (((Mn n f, xs, ls) # fs), rv)" + shows "estep_Mn (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + consider "ls \ []" and "rv \ Some 0" | "ls \ []" and "rv = Some 0" | "ls = []" + by auto + then show ?thesis + proof (cases) + case 1 + then have step_c: "step c = + ((f, (Suc (hd ls)) # xs, []) # (Mn n f, xs, [Suc (hd ls)]) # fs, None)" + (is "step c = ?cfg") + using assms by simp + have "estep_Mn ?e = + prod_encode + (e_cons + (triple_encode (encode f) (e_cons (Suc (hd ls)) (list_encode xs)) 0) + (e_cons + (triple_encode (encode (Mn n f)) (list_encode xs) (singleton_encode (Suc (hd ls)))) + (list_encode (map encode_frame fs))), + 0)" + using 1 assms e_hd_def estep_Mn_def by auto + also have "... = encode_config ?cfg" + using encode_config by (simp add: encode_frame) + finally show ?thesis + using step_c by simp + next + case 2 + have "estep_Mn ?e = prod_encode (e2tail ?e, Suc (e_hd (e2ls ?e)))" + using 2 assms estep_Mn_def by auto + also have "... = prod_encode (e2tail ?e, Suc (hd ls))" + using 2 assms e_hd_def by auto + also have "... = prod_encode (list_encode (map encode_frame fs), Suc (hd ls))" + using assms by simp + also have "... = encode_config (fs, Some (hd ls))" + using encode_config by simp + finally show ?thesis + using 2 assms by simp + next + case 3 + then show ?thesis + using assms encode_frame by (simp add: estep_Mn_def, simp add: encode_config) + qed +qed + +definition "estep e \ + if e2stack e = 0 then prod_encode (0, e2rv e) + else if e2i e = 0 then prod_encode (e2tail e, 1) + else if e2i e = 1 then prod_encode (e2tail e, Suc (Suc (e_hd (e2xs e)))) + else if encode_kind (e2i e) = 2 then + prod_encode (e2tail e, Suc (e_nth (e2xs e) (pdec22 (e2i e)))) + else if encode_kind (e2i e) = 3 then estep_Cn e + else if encode_kind (e2i e) = 4 then estep_Pr e + else if encode_kind (e2i e) = 5 then estep_Mn e + else 0" + +lemma estep_Z: + assumes "c = (((Z, xs, ls) # fs), rv)" + shows "estep (encode_config c) = encode_config (step c)" + using encode_frame by (simp add: assms estep_def, simp add: encode_config assms) + +lemma estep_S: + assumes "c = (((S, xs, ls) # fs), rv)" + and "recfn (length xs) (fst (hd (fst c)))" + shows "estep (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + from assms have "length xs > 0" by auto + then have eq: "hd xs = e_hd (e2xs ?e)" + using assms(1) e_hd_def by auto + then have "estep ?e = prod_encode (e2tail ?e, Suc (Suc (e_hd (e2xs ?e))))" + using assms(1) estep_def by simp + moreover have "step c = (fs, Some (Suc (hd xs)))" + using assms(1) by simp + ultimately show ?thesis + using assms(1) eq estep_def encode_config[of fs "Some (Suc (hd xs))"] by simp +qed + +lemma estep_Id: + assumes "c = (((Id m n, xs, ls) # fs), rv)" + and "recfn (length xs) (fst (hd (fst c)))" + shows "estep (encode_config c) = encode_config (step c)" +proof - + let ?e = "encode_config c" + from assms have "length xs = m" and "m > 0" by auto + then have eq: "xs ! n = e_nth (e2xs ?e) n" + using assms e_hd_def by auto + moreover have "encode_kind (e2i ?e) = 2" + using assms(1) encode_kind_2 by auto + ultimately have "estep ?e = + prod_encode (e2tail ?e, Suc (e_nth (e2xs ?e) (pdec22 (e2i ?e))))" + using assms estep_def encode_kind_def by auto + moreover have "step c = (fs, Some (xs ! n))" + using assms(1) by simp + ultimately show ?thesis + using assms(1) eq encode_config[of fs "Some (xs ! n)"] by simp +qed + +lemma estep: + assumes "valid (fst c)" + shows "estep (encode_config c) = encode_config (step c)" +proof (cases "fst c") + case Nil + then show ?thesis + using estep_def + by (metis list_encode.simps(1) e2rv_def e2stack_stack encode_config_def + map_is_Nil_conv prod.collapse prod_encode_inverse snd_conv step.simps(1)) +next + case (Cons s fs) + then obtain f xs ls rv where c: "c = ((f, xs, ls) # fs, rv)" + by (metis prod.exhaust_sel) + with assms valid_def have lenas: "recfn (length xs) f" by simp + show ?thesis + proof (cases f) + case Z + then show ?thesis using estep_Z c by simp + next + case S + then show ?thesis using estep_S c lenas by simp + next + case Id + then show ?thesis using estep_Id c lenas by simp + next + case Cn + then show ?thesis + using estep_Cn c + by (metis e2i_f e2stack_0_iff_Nil encode.simps(1) encode.simps(2) encode_kind_2 + encode_kind_3 encode_kind_Cn estep_def list.distinct(1) recf.distinct(13) + recf.distinct(19) recf.distinct(5)) + next + case Pr + then show ?thesis + using estep_Pr c lenas + by (metis e2i_f e2stack_0_iff_Nil encode.simps(1) encode.simps(2) encode_kind_2 + encode_kind_4 encode_kind_Cn encode_kind_Pr estep_def list.distinct(1) recf.distinct(15) + recf.distinct(21) recf.distinct(25) recf.distinct(7)) + next + case Mn + then show ?thesis + using estep_Pr c lenas + by (metis (no_types, lifting) e2i_f e2stack_0_iff_Nil encode.simps(1) + encode.simps(2) encode_kind_2 encode_kind_5 encode_kind_Cn encode_kind_Mn encode_kind_Pr + estep_Mn estep_def list.distinct(1) recf.distinct(17) recf.distinct(23) + recf.distinct(27) recf.distinct(9)) + qed +qed + +subsection \The step function as a partial recursive function\label{s:step_recf}\ + +text \In this section we construct a primitive recursive function +@{term r_step} computing @{term estep}. This will entail defining @{typ +recf}s for many functions defined in the previous section.\ + +definition "r_e2stack \ r_pdec1" + +lemma r_e2stack_prim: "prim_recfn 1 r_e2stack" + unfolding r_e2stack_def using r_pdec1_prim by simp + +lemma r_e2stack [simp]: "eval r_e2stack [e] \= e2stack e" + unfolding r_e2stack_def e2stack_def using r_pdec1_prim by simp + +definition "r_e2rv \ r_pdec2" + +lemma r_e2rv_prim: "prim_recfn 1 r_e2rv" + unfolding r_e2rv_def using r_pdec2_prim by simp + +lemma r_e2rv [simp]: "eval r_e2rv [e] \= e2rv e" + unfolding r_e2rv_def e2rv_def using r_pdec2_prim by simp + +definition "r_e2tail \ Cn 1 r_tl [r_e2stack]" + +lemma r_e2tail_prim: "prim_recfn 1 r_e2tail" + unfolding r_e2tail_def using r_e2stack_prim r_tl_prim by simp + +lemma r_e2tail [simp]: "eval r_e2tail [e] \= e2tail e" + unfolding r_e2tail_def e2tail_def using r_e2stack_prim r_tl_prim by simp + +definition "r_e2frame \ Cn 1 r_hd [r_e2stack]" + +lemma r_e2frame_prim: "prim_recfn 1 r_e2frame" + unfolding r_e2frame_def using r_hd_prim r_e2stack_prim by simp + +lemma r_e2frame [simp]: "eval r_e2frame [e] \= e2frame e" + unfolding r_e2frame_def e2frame_def using r_hd_prim r_e2stack_prim by simp + +definition "r_e2i \ Cn 1 r_pdec1 [r_e2frame]" + +lemma r_e2i_prim: "prim_recfn 1 r_e2i" + unfolding r_e2i_def using r_pdec12_prim r_e2frame_prim by simp + +lemma r_e2i [simp]: "eval r_e2i [e] \= e2i e" + unfolding r_e2i_def e2i_def using r_pdec12_prim r_e2frame_prim by simp + +definition "r_e2xs \ Cn 1 r_pdec12 [r_e2frame]" + +lemma r_e2xs_prim: "prim_recfn 1 r_e2xs" + unfolding r_e2xs_def using r_pdec122_prim r_e2frame_prim by simp + +lemma r_e2xs [simp]: "eval r_e2xs [e] \= e2xs e" + unfolding r_e2xs_def e2xs_def using r_pdec122_prim r_e2frame_prim by simp + +definition "r_e2ls \ Cn 1 r_pdec22 [r_e2frame]" + +lemma r_e2ls_prim: "prim_recfn 1 r_e2ls" + unfolding r_e2ls_def using r_pdec222_prim r_e2frame_prim by simp + +lemma r_e2ls [simp]: "eval r_e2ls [e] \= e2ls e" + unfolding r_e2ls_def e2ls_def using r_pdec222_prim r_e2frame_prim by simp + +definition "r_e2lenls \ Cn 1 r_length [r_e2ls]" + +lemma r_e2lenls_prim: "prim_recfn 1 r_e2lenls" + unfolding r_e2lenls_def using r_length_prim r_e2ls_prim by simp + +lemma r_e2lenls [simp]: "eval r_e2lenls [e] \= e2lenls e" + unfolding r_e2lenls_def e2lenls_def using r_length_prim r_e2ls_prim by simp + +definition "r_kind \ + Cn 1 r_ifz [Id 1 0, Z, Cn 1 r_ifeq [Id 1 0, r_const 1, r_const 1, r_pdec1]]" + +lemma r_kind_prim: "prim_recfn 1 r_kind" + unfolding r_kind_def by simp + +lemma r_kind: "eval r_kind [e] \= encode_kind e" + unfolding r_kind_def encode_kind_def by simp + +lemmas helpers_for_r_step_prim = + r_e2i_prim + r_e2lenls_prim + r_e2ls_prim + r_e2rv_prim + r_e2xs_prim + r_e2stack_prim + r_e2tail_prim + r_e2frame_prim + +text \We define primitive recursive functions @{term r_step_Id}, @{term +r_step_Cn}, @{term r_step_Pr}, and @{term r_step_Mn}. The last three +correspond to @{term estep_Cn}, @{term estep_Pr}, and @{term estep_Mn} from +the previous section.\ + +definition "r_step_Id \ + Cn 1 r_prod_encode [r_e2tail, Cn 1 S [Cn 1 r_nth [r_e2xs, Cn 1 r_pdec22 [r_e2i]]]]" + +lemma r_step_Id: + "eval r_step_Id [e] \= prod_encode (e2tail e, Suc (e_nth (e2xs e) (pdec22 (e2i e))))" + unfolding r_step_Id_def using helpers_for_r_step_prim by simp + +abbreviation r_triple_encode :: "recf \ recf \ recf \ recf" where + "r_triple_encode x y z \ Cn 1 r_prod_encode [x, Cn 1 r_prod_encode [y, z]]" + +definition "r_step_Cn \ + Cn 1 r_ifeq + [r_e2lenls, + Cn 1 r_length [Cn 1 r_pdec222 [r_e2i]], + Cn 1 r_ifz + [r_e2rv, + Cn 1 r_prod_encode + [Cn 1 r_cons [r_triple_encode (Cn 1 r_pdec122 [r_e2i]) r_e2ls Z, r_e2stack], + Z], + Cn 1 r_prod_encode [r_e2tail, r_e2rv]], + Cn 1 r_ifz + [r_e2rv, + Cn 1 r_ifless + [r_e2lenls, + Cn 1 r_length [Cn 1 r_pdec222 [r_e2i]], + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode (Cn 1 r_nth [Cn 1 r_pdec222 [r_e2i], r_e2lenls]) r_e2xs Z, + r_e2stack], + Z], + Cn 1 r_prod_encode [r_e2tail, r_e2rv]], + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode r_e2i r_e2xs (Cn 1 r_snoc [r_e2ls, Cn 1 r_dec [r_e2rv]]), + r_e2tail], + Z]]]" + +lemma r_step_Cn_prim: "prim_recfn 1 r_step_Cn" + unfolding r_step_Cn_def using helpers_for_r_step_prim by simp + +lemma r_step_Cn: "eval r_step_Cn [e] \= estep_Cn e" + unfolding r_step_Cn_def estep_Cn_def using helpers_for_r_step_prim by simp + +definition "r_step_Pr \ + Cn 1 r_ifz + [r_e2ls, + Cn 1 r_ifz + [r_e2rv, + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode (Cn 1 r_pdec122 [r_e2i]) (Cn 1 r_tl [r_e2xs]) Z, + r_e2stack], + Z], + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode r_e2i r_e2xs (Cn 1 r_singleton_encode [Cn 1 r_dec [r_e2rv]]), + r_e2tail], + Z]], + Cn 1 r_ifeq + [r_e2lenls, + Cn 1 S [Cn 1 r_hd [r_e2xs]], + Cn 1 r_prod_encode [r_e2tail, Cn 1 S [Cn 1 r_hd [r_e2ls]]], + Cn 1 r_ifz + [r_e2rv, + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode + (Cn 1 r_pdec222 [r_e2i]) + (Cn 1 r_cons + [Cn 1 r_dec [r_e2lenls], + Cn 1 r_cons [Cn 1 r_hd [r_e2ls], + Cn 1 r_tl [r_e2xs]]]) + Z, + r_e2stack], + Z], + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode r_e2i r_e2xs (Cn 1 r_cons [Cn 1 r_dec [r_e2rv], r_e2ls]), + r_e2tail], + Z]]]]" + +lemma r_step_Pr_prim: "prim_recfn 1 r_step_Pr" + unfolding r_step_Pr_def using helpers_for_r_step_prim by simp + +lemma r_step_Pr: "eval r_step_Pr [e] \= estep_Pr e" + unfolding r_step_Pr_def estep_Pr_def using helpers_for_r_step_prim by simp + +definition "r_step_Mn \ + Cn 1 r_ifz + [r_e2ls, + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode (Cn 1 r_pdec22 [r_e2i]) (Cn 1 r_cons [Z, r_e2xs]) Z, + Cn 1 r_cons + [r_triple_encode r_e2i r_e2xs (Cn 1 r_singleton_encode [Z]), + r_e2tail]], + Z], + Cn 1 r_ifeq + [r_e2rv, + r_const 1, + Cn 1 r_prod_encode [r_e2tail, Cn 1 S [Cn 1 r_hd [r_e2ls]]], + Cn 1 r_prod_encode + [Cn 1 r_cons + [r_triple_encode + (Cn 1 r_pdec22 [r_e2i]) + (Cn 1 r_cons [Cn 1 S [Cn 1 r_hd [r_e2ls]], r_e2xs]) + Z, + Cn 1 r_cons + [r_triple_encode r_e2i r_e2xs (Cn 1 r_singleton_encode [Cn 1 S [Cn 1 r_hd [r_e2ls]]]), + r_e2tail]], + Z]]]" + +lemma r_step_Mn_prim: "prim_recfn 1 r_step_Mn" + unfolding r_step_Mn_def using helpers_for_r_step_prim by simp + +lemma r_step_Mn: "eval r_step_Mn [e] \= estep_Mn e" + unfolding r_step_Mn_def estep_Mn_def using helpers_for_r_step_prim by simp + +definition "r_step \ + Cn 1 r_ifz + [r_e2stack, + Cn 1 r_prod_encode [Z, r_e2rv], + Cn 1 r_ifz + [r_e2i, + Cn 1 r_prod_encode [r_e2tail, r_const 1], + Cn 1 r_ifeq + [r_e2i, + r_const 1, + Cn 1 r_prod_encode [r_e2tail, Cn 1 S [Cn 1 S [Cn 1 r_hd [r_e2xs]]]], + Cn 1 r_ifeq + [Cn 1 r_kind [r_e2i], + r_const 2, + Cn 1 r_prod_encode [r_e2tail, Cn 1 S [Cn 1 r_nth [r_e2xs, Cn 1 r_pdec22 [r_e2i]]]], + Cn 1 r_ifeq + [Cn 1 r_kind [r_e2i], + r_const 3, + r_step_Cn, + Cn 1 r_ifeq + [Cn 1 r_kind [r_e2i], + r_const 4, + r_step_Pr, + Cn 1 r_ifeq + [Cn 1 r_kind [r_e2i], r_const 5, r_step_Mn, Z]]]]]]]" + +lemma r_step_prim: "prim_recfn 1 r_step" + unfolding r_step_def + using r_kind_prim r_step_Mn_prim r_step_Pr_prim r_step_Cn_prim helpers_for_r_step_prim + by simp + +lemma r_step: "eval r_step [e] \= estep e" + unfolding r_step_def estep_def + using r_kind_prim r_step_Mn_prim r_step_Pr_prim r_step_Cn_prim helpers_for_r_step_prim + r_kind r_step_Cn r_step_Pr r_step_Mn + by simp + +theorem r_step_equiv_step: + assumes "valid (fst c)" + shows "eval r_step [encode_config c] \= encode_config (step c)" + using r_step estep assms by simp + + +subsection \The universal function\label{s:the_universal}\ + +text \The next function computes the configuration after arbitrarily +many steps.\ + +definition "r_leap \ + Pr 2 + (Cn 2 r_prod_encode + [Cn 2 r_singleton_encode + [Cn 2 r_prod_encode [Id 2 0, Cn 2 r_prod_encode [Id 2 1, r_constn 1 0]]], + r_constn 1 0]) + (Cn 4 r_step [Id 4 1])" + +lemma r_leap_prim [simp]: "prim_recfn 3 r_leap" + unfolding r_leap_def using r_step_prim by simp + +lemma r_leap_total: "eval r_leap [t, i, x] \" + using prim_recfn_total[OF r_leap_prim] by simp + +lemma r_leap: + assumes "i = encode f" and "recfn (e_length x) f" + shows "eval r_leap [t, i, x] \= encode_config (iterate t step ([(f, list_decode x, [])], None))" +proof (induction t) + case 0 + then show ?case + unfolding r_leap_def using r_step_prim assms encode_config encode_frame by simp +next + case (Suc t) + let ?c = "([(f, list_decode x, [])], None)" + let ?tc = "iterate t step ?c" + have "valid (fst ?c)" + using valid_def assms by simp + then have valid: "valid (fst ?tc)" + using iterate_step_valid by simp + have "eval r_leap [Suc t, i, x] = + eval (Cn 4 r_step [Id 4 1]) [t, the (eval r_leap [t, i, x]), i, x]" + unfolding r_leap_def using eval_Pr_prim_Suc r_step_prim assms by simp + then have "eval r_leap [Suc t, i, x] = eval (Cn 4 r_step [Id 4 1]) [t, encode_config ?tc, i, x]" + using Suc by simp + then have "eval r_leap [Suc t, i, x] = eval r_step [encode_config ?tc]" + using r_step_prim by simp + then have "eval r_leap [Suc t, i, x] \= encode_config (step ?tc)" + by (simp add: r_step_equiv_step valid) + then show ?case by simp +qed + +lemma step_leaves_empty_stack_empty: + assumes "iterate t step ([(f, list_decode x, [])], None) = ([], Some v)" + shows "iterate (t + t') step ([(f, list_decode x, [])], None) = ([], Some v)" + using assms by (induction t') simp_all + +text \The next function is essentially a convenience wrapper around +@{term r_leap}. It returns zero if the configuration returned by @{term +r_leap} is non-final, and @{term "Suc v"} if the configuration is final with +return value $v$.\ + +definition "r_result \ + Cn 3 r_ifz [Cn 3 r_pdec1 [r_leap], Cn 3 r_pdec2 [r_leap], r_constn 2 0]" + +lemma r_result_prim [simp]: "prim_recfn 3 r_result" + unfolding r_result_def using r_leap_prim by simp + +lemma r_result_total: "total r_result" + using r_result_prim by blast + +lemma r_result_empty_stack_None: + assumes "i = encode f" + and "recfn (e_length x) f" + and "iterate t step ([(f, list_decode x, [])], None) = ([], None)" + shows "eval r_result [t, i, x] \= 0" + unfolding r_result_def + using assms r_leap e2stack_0_iff_Nil e2stack_def e2stack_stack r_leap_total r_leap_prim + e2rv_def e2rv_rv + by simp + +lemma r_result_empty_stack_Some: + assumes "i = encode f" + and "recfn (e_length x) f" + and "iterate t step ([(f, list_decode x, [])], None) = ([], Some v)" + shows "eval r_result [t, i, x] \= Suc v" + unfolding r_result_def + using assms r_leap e2stack_0_iff_Nil e2stack_def e2stack_stack r_leap_total r_leap_prim + e2rv_def e2rv_rv + by simp + +lemma r_result_empty_stack_stays: + assumes "i = encode f" + and "recfn (e_length x) f" + and "iterate t step ([(f, list_decode x, [])], None) = ([], Some v)" + shows "eval r_result [t + t', i, x] \= Suc v" + using assms step_leaves_empty_stack_empty r_result_empty_stack_Some by simp + +lemma r_result_nonempty_stack: + assumes "i = encode f" + and "recfn (e_length x) f" + and "fst (iterate t step ([(f, list_decode x, [])], None)) \ []" + shows "eval r_result [t, i, x] \= 0" +proof - + obtain ss rv where "iterate t step ([(f, list_decode x, [])], None) = (ss, rv)" + by fastforce + moreover from this assms(3) have "ss \ []" by simp + ultimately have "eval r_leap [t, i, x] \= encode_config (ss, rv)" + using assms r_leap by simp + then have "eval (Cn 3 r_pdec1 [r_leap]) [t, i, x] \\ 0" + using `ss \ []` r_leap_prim encode_config r_leap_total list_encode_0 + by (auto, blast) + then show ?thesis unfolding r_result_def using r_leap_prim by auto +qed + +lemma r_result_Suc: + assumes "i = encode f" + and "recfn (e_length x) f" + and "eval r_result [t, i, x] \= Suc v" + shows "iterate t step ([(f, list_decode x, [])], None) = ([], Some v)" + (is "?cfg = _") +proof (cases "fst ?cfg") + case Nil + then show ?thesis + using assms r_result_empty_stack_None r_result_empty_stack_Some + by (metis Zero_not_Suc nat.inject option.collapse option.inject prod.exhaust_sel) +next + case Cons + then show ?thesis using assms r_result_nonempty_stack by simp +qed + +lemma r_result_converg: + assumes "i = encode f" + and "recfn (e_length x) f" + and "eval f (list_decode x) \= v" + shows "\t. + (\t'\t. eval r_result [t', i, x] \= Suc v) \ + (\t'= 0)" +proof - + let ?xs = "list_decode x" + let ?stack = "[(f, ?xs, [])]" + have "wellf f" using assms(2) by simp + moreover have "length ?xs = arity f" + using assms(2) by simp + ultimately have "correct (?stack, None)" + using step_correct valid_def by simp + with assms(3) have "reachable (?stack, None) ([], Some v)" + by simp + then obtain t where + "iterate t step (?stack, None) = ([], Some v)" + "\t' []" + using reachable_iterate_step_empty_stack by blast + then have t: + "eval r_result [t, i, x] \= Suc v" + "\t'= 0" + using r_result_empty_stack_Some r_result_nonempty_stack assms(1,2) + by simp_all + then have "eval r_result [t + t', i, x] \= Suc v" for t' + using r_result_empty_stack_stays assms r_result_Suc by simp + then have "\t'\t. eval r_result [t', i, x] \= Suc v" + using le_Suc_ex by blast + with t(2) show ?thesis by auto +qed + +lemma r_result_diverg: + assumes "i = encode f" + and "recfn (e_length x) f" + and "eval f (list_decode x) \" + shows "eval r_result [t, i, x] \= 0" +proof - + let ?xs = "list_decode x" + let ?stack = "[(f, ?xs, [])]" + have "recfn (length ?xs) f" + using assms(2) by auto + then have "correct (?stack, None)" + using step_correct valid_def by simp + with assms(3) have "nonterminating (?stack, None)" + by simp + then show ?thesis + using r_result_nonempty_stack assms(1,2) by simp +qed + +text \Now we can define the universal partial recursive function. This +function executes @{term r_result} for increasing time bounds, waits for it +to reach a final configuration, and then extracts its result value. If no +final configuration is reached, the universal function diverges.\ + +definition "r_univ \ + Cn 2 r_dec [Cn 2 r_result [Mn 2 (Cn 3 r_not [r_result]), Id 2 0, Id 2 1]]" + +lemma r_univ_recfn [simp]: "recfn 2 r_univ" + unfolding r_univ_def by simp + +theorem r_univ: + assumes "i = encode f" and "recfn (e_length x) f" + shows "eval r_univ [i, x] = eval f (list_decode x)" +proof - + let ?cond = "Cn 3 r_not [r_result]" + let ?while = "Mn 2 ?cond" + let ?res = "Cn 2 r_result [?while, Id 2 0, Id 2 1]" + let ?xs = "list_decode x" + have *: "eval ?cond [t, i, x] \= (if eval r_result [t, i, x] \= 0 then 1 else 0)" for t + proof - + have "eval ?cond [t, i, x] = eval r_not [the (eval r_result [t, i, x])]" + using r_result_total by simp + moreover have "eval r_result [t, i, x] \" + by (simp add: r_result_total) + ultimately show ?thesis by auto + qed + show ?thesis + proof (cases "eval f ?xs \") + case True + then show ?thesis + unfolding r_univ_def using * r_result_diverg[OF assms] eval_Mn_diverg by simp + next + case False + then obtain v where v: "eval f ?xs \= v" by auto + then obtain t where t: + "\t'\t. eval r_result [t', i, x] \= Suc v" + "\t'= 0" + using r_result_converg[OF assms] by blast + then have + "\t'\t. eval ?cond [t', i, x] \= 0" + "\t'= 1" + using * by simp_all + then have "eval ?while [i, x] \= t" + using eval_Mn_convergI[of 2 ?cond "[i, x]" t] by simp + then have "eval ?res [i, x] = eval r_result [t, i, x]" + by simp + then have "eval ?res [i, x] \= Suc v" + using t(1) by simp + then show ?thesis + unfolding r_univ_def using v by simp + qed +qed + +theorem r_univ': + assumes "recfn (e_length x) f" + shows "eval r_univ [encode f, x] = eval f (list_decode x)" + using r_univ assms by simp + +text \Universal functions for every arity can be built from @{term "r_univ"}.\ + +definition r_universal :: "nat \ recf" where + "r_universal n \ Cn (Suc n) r_univ [Id (Suc n) 0, r_shift (r_list_encode (n - 1))]" + +lemma r_universal_recfn [simp]: "n > 0 \ recfn (Suc n) (r_universal n)" + unfolding r_universal_def by simp + +lemma r_universal: + assumes "recfn n f" and "length xs = n" + shows "eval (r_universal n) (encode f # xs) = eval f xs" + unfolding r_universal_def using wellf_arity_nonzero assms r_list_encode r_univ' + by fastforce + +text \We will mostly be concerned with computing unary functions. Hence +we introduce separate functions for this case.\ + +definition "r_result1 \ + Cn 3 r_result [Id 3 0, Id 3 1, Cn 3 r_singleton_encode [Id 3 2]]" + +lemma r_result1_prim [simp]: "prim_recfn 3 r_result1" + unfolding r_result1_def by simp + +lemma r_result1_total: "total r_result1" + using Mn_free_imp_total by simp + +lemma r_result1 [simp]: + "eval r_result1 [t, i, x] = eval r_result [t, i, singleton_encode x]" + unfolding r_result1_def by simp + +text \The following function will be our standard Gödel numbering +of all unary partial recursive functions.\ + +definition "r_phi \ r_universal 1" + +lemma r_phi_recfn [simp]: "recfn 2 r_phi" + unfolding r_phi_def by simp + +theorem r_phi: + assumes "i = encode f" and "recfn 1 f" + shows "eval r_phi [i, x] = eval f [x]" + unfolding r_phi_def using r_universal assms by simp + +corollary r_phi': + assumes "recfn 1 f" + shows "eval r_phi [encode f, x] = eval f [x]" + using assms r_phi by simp + +lemma r_phi'': "eval r_phi [i, x] = eval r_univ [i, singleton_encode x]" + unfolding r_universal_def r_phi_def using r_list_encode by simp + + +section \Applications of the universal function\ + +text \In this section we shall see some ways @{term r_univ} and @{term r_result} can +be used.\ + +subsection \Lazy conditional evaluation\ + +text \With the help of @{term r_univ} we can now define a +\hypertarget{p:r_lifz}{lazy variant} of @{term r_ifz}, in which only one +branch is evaluated.\ + +definition r_lazyifzero :: "nat \ nat \ nat \ recf" where + "r_lazyifzero n j\<^sub>1 j\<^sub>2 \ + Cn (Suc (Suc n)) r_univ + [Cn (Suc (Suc n)) r_ifz [Id (Suc (Suc n)) 0, r_constn (Suc n) j\<^sub>1, r_constn (Suc n) j\<^sub>2], + r_shift (r_list_encode n)]" + +lemma r_lazyifzero_recfn: "recfn (Suc (Suc n)) (r_lazyifzero n j\<^sub>1 j\<^sub>2)" + using r_lazyifzero_def by simp + +lemma r_lazyifzero: + assumes "length xs = Suc n" + and "j\<^sub>1 = encode f\<^sub>1" + and "j\<^sub>2 = encode f\<^sub>2" + and "recfn (Suc n) f\<^sub>1" + and "recfn (Suc n) f\<^sub>2" + shows "eval (r_lazyifzero n j\<^sub>1 j\<^sub>2) (c # xs) = (if c = 0 then eval f\<^sub>1 xs else eval f\<^sub>2 xs)" +proof - + let ?a = "r_constn (Suc n) n" + let ?b = "Cn (Suc (Suc n)) r_ifz + [Id (Suc (Suc n)) 0, r_constn (Suc n) j\<^sub>1, r_constn (Suc n) j\<^sub>2]" + let ?c = "r_shift (r_list_encode n)" + have "eval ?a (c # xs) \= n" + using assms(1) by simp + moreover have "eval ?b (c # xs) \= (if c = 0 then j\<^sub>1 else j\<^sub>2)" + using assms(1) by simp + moreover have "eval ?c (c # xs) \= list_encode xs" + using assms(1) r_list_encode r_shift by simp + ultimately have "eval (r_lazyifzero n j\<^sub>1 j\<^sub>2) (c # xs) = + eval r_univ [if c = 0 then j\<^sub>1 else j\<^sub>2, list_encode xs]" + unfolding r_lazyifzero_def using r_lazyifzero_recfn assms(1) by simp + then show ?thesis using assms r_univ by simp +qed + +definition r_lifz :: "recf \ recf \ recf" where + "r_lifz f g \ r_lazyifzero (arity f - 1) (encode f) (encode g)" + +lemma r_lifz_recfn [simp]: + assumes "recfn n f" and "recfn n g" + shows "recfn (Suc n) (r_lifz f g)" + using assms r_lazyifzero_recfn r_lifz_def wellf_arity_nonzero by auto + +lemma r_lifz [simp]: + assumes "length xs = n" and "recfn n f" and "recfn n g" + shows "eval (r_lifz f g) (c # xs) = (if c = 0 then eval f xs else eval g xs)" + using assms r_lazyifzero r_lifz_def wellf_arity_nonzero + by (metis One_nat_def Suc_pred) + + +subsection \Enumerating the domains of partial recursive functions\ + +text \In this section we define a binary function $\mathit{enumdom}$ +such that for all $i$, the domain of $\varphi_i$ equals +$\{\mathit{enumdom}(i, x) \mid \mathit{enumdom}(i, x)\!\downarrow\}$. In +other words, the image of $\mathit{enumdom}_i$ is the domain of $\varphi_i$. + +First we need some more properties of @{term r_leap} and @{term r_result}.\ + +lemma r_leap_Suc: "eval r_leap [Suc t, i, x] = eval r_step [the (eval r_leap [t, i, x])]" +proof - + have "eval r_leap [Suc t, i, x] = + eval (Cn 4 r_step [Id 4 1]) [t, the (eval r_leap [t, i, x]), i, x]" + using r_leap_total eval_Pr_converg_Suc r_leap_def + by (metis length_Cons list.size(3) numeral_2_eq_2 numeral_3_eq_3 r_leap_prim) + then show ?thesis using r_step_prim by auto +qed + +lemma r_leap_Suc_saturating: + assumes "pdec1 (the (eval r_leap [t, i, x])) = 0" + shows "eval r_leap [Suc t, i, x] = eval r_leap [t, i, x]" +proof - + let ?e = "eval r_leap [t, i, x]" + have "eval r_step [the ?e] \= estep (the ?e)" + using r_step by simp + then have "eval r_step [the ?e] \= prod_encode (0, e2rv (the ?e))" + using estep_def assms by (simp add: e2stack_def) + then have "eval r_step [the ?e] \= prod_encode (pdec1 (the ?e), pdec2 (the ?e))" + using assms by (simp add: e2rv_def) + then have "eval r_step [the ?e] \= the ?e" by simp + then show ?thesis using r_leap_total r_leap_Suc by simp +qed + +lemma r_result_Suc_saturating: + assumes "eval r_result [t, i, x] \= Suc v" + shows "eval r_result [Suc t, i, x] \= Suc v" +proof - + let ?r = "\t. eval r_ifz [pdec1 (the (eval r_leap [t, i, x])), pdec2 (the (eval r_leap [t, i, x])), 0]" + have "?r t \= Suc v" + using assms unfolding r_result_def using r_leap_total r_leap_prim by simp + then have "pdec1 (the (eval r_leap [t, i, x])) = 0" + using option.sel by fastforce + then have "eval r_leap [Suc t, i, x] = eval r_leap [t, i, x]" + using r_leap_Suc_saturating by simp + moreover have "eval r_result [t, i, x] = ?r t" + unfolding r_result_def using r_leap_total r_leap_prim by simp + moreover have "eval r_result [Suc t, i, x] = ?r (Suc t)" + unfolding r_result_def using r_leap_total r_leap_prim by simp + ultimately have "eval r_result [Suc t, i, x] = eval r_result [t, i, x]" + by simp + with assms show ?thesis by simp +qed + +lemma r_result_saturating: + assumes "eval r_result [t, i, x] \= Suc v" + shows "eval r_result [t + d, i, x] \= Suc v" + using r_result_Suc_saturating assms by (induction d) simp_all + +lemma r_result_converg': + assumes "eval r_univ [i, x] \= v" + shows "\t. (\t'\t. eval r_result [t', i, x] \= Suc v) \ (\t'= 0)" +proof - + let ?f = "Cn 3 r_not [r_result]" + let ?m = "Mn 2 ?f" + have "recfn 2 ?m" by simp + have eval_m: "eval ?m [i, x] \" + proof + assume "eval ?m [i, x] \" + then have "eval r_univ [i, x] \" + unfolding r_univ_def by simp + with assms show False by simp + qed + then obtain t where t: "eval ?m [i, x] \= t" + by auto + then have f_t: "eval ?f [t, i, x] \= 0" and f_less_t: "\y. y < t \ eval ?f [y, i, x] \\ 0" + using eval_Mn_convergE[of 2 ?f "[i, x]" t] `recfn 2 ?m` + by (metis (no_types, lifting) One_nat_def Suc_1 length_Cons list.size(3))+ + have eval_Cn2: "eval (Cn 2 r_result [?m, Id 2 0, Id 2 1]) [i, x] \" + proof + assume "eval (Cn 2 r_result [?m, Id 2 0, Id 2 1]) [i, x] \" + then have "eval r_univ [i, x] \" + unfolding r_univ_def by simp + with assms show False by simp + qed + have "eval r_result [t, i, x] \= Suc v" + proof (rule ccontr) + assume neq_Suc: "\ eval r_result [t, i, x] \= Suc v" + show False + proof (cases "eval r_result [t, i, x] = None") + case True + then show ?thesis using f_t by simp + next + case False + then obtain w where w: "eval r_result [t, i, x] \= w" "w \ Suc v" + using neq_Suc by auto + moreover have "eval r_result [t, i, x] \\ 0" + by (rule ccontr; use f_t in auto) + ultimately have "w \ 0" by simp + have "eval (Cn 2 r_result [?m, Id 2 0, Id 2 1]) [i, x] = + eval r_result [the (eval ?m [i, x]), i, x]" + using eval_m by simp + with w t have "eval (Cn 2 r_result [?m, Id 2 0, Id 2 1]) [i, x] \= w" + by simp + moreover have "eval r_univ [i, x] = + eval r_dec [the (eval (Cn 2 r_result [?m, Id 2 0, Id 2 1]) [i, x])]" + unfolding r_univ_def using eval_Cn2 by simp + ultimately have "eval r_univ [i, x] = eval r_dec [w]" by simp + then have "eval r_univ [i, x] \= w - 1" by simp + with assms `w \ 0` w show ?thesis by simp + qed + qed + then have "\t'\t. eval r_result [t', i, x] \= Suc v" + using r_result_saturating le_Suc_ex by blast + moreover have "eval r_result [y, i, x] \= 0" if "y < t" for y + proof (rule ccontr) + assume neq0: "eval r_result [y, i, x] \ Some 0" + then show False + proof (cases "eval r_result [y, i, x] = None") + case True + then show ?thesis using f_less_t `y < t` by fastforce + next + case False + then obtain v where "eval r_result [y, i, x] \= v" "v \ 0" + using neq0 by auto + then have "eval ?f [y, i, x] \= 0" by simp + then show ?thesis using f_less_t `y < t` by simp + qed + qed + ultimately show ?thesis by auto +qed + +lemma r_result_diverg': + assumes "eval r_univ [i, x] \" + shows "eval r_result [t, i, x] \= 0" +proof (rule ccontr) + let ?f = "Cn 3 r_not [r_result]" + let ?m = "Mn 2 ?f" + assume "eval r_result [t, i, x] \ Some 0" + with r_result_total have "eval r_result [t, i, x] \\ 0" by simp + then have "eval ?f [t, i, x] \= 0" by auto + moreover have "eval ?f [y, i, x] \" if "y < t" for y + using r_result_total by simp + ultimately have "\z. eval ?f (z # [i, x]) \= 0 \ (\y)" + by blast + then have "eval ?m [i, x] \" by simp + then have "eval r_univ [i, x] \" + unfolding r_univ_def using r_result_total by simp + with assms show False by simp +qed + +lemma r_result_bivalent': + assumes "eval r_univ [i, x] \= v" + shows "eval r_result [t, i, x] \= Suc v \ eval r_result [t, i, x] \= 0" + using r_result_converg'[OF assms] not_less by blast + +lemma r_result_Some': + assumes "eval r_result [t, i, x] \= Suc v" + shows "eval r_univ [i, x] \= v" +proof (rule ccontr) + assume not_v: "\ eval r_univ [i, x] \= v" + show False + proof (cases "eval r_univ [i, x] \") + case True + then show ?thesis + using assms r_result_diverg' by simp + next + case False + then obtain w where w: "eval r_univ [i, x] \= w" "w \ v" + using not_v by auto + then have "eval r_result [t, i, x] \= Suc w \ eval r_result [t, i, x] \= 0" + using r_result_bivalent' by simp + then show ?thesis using assms not_v w by simp + qed +qed + +lemma r_result1_converg': + assumes "eval r_phi [i, x] \= v" + shows "\t. + (\t'\t. eval r_result1 [t', i, x] \= Suc v) \ + (\t'= 0)" + using assms r_result1 r_result_converg' r_phi'' by simp + +lemma r_result1_diverg': + assumes "eval r_phi [i, x] \" + shows "eval r_result1 [t, i, x] \= 0" + using assms r_result1 r_result_diverg' r_phi'' by simp + +lemma r_result1_Some': + assumes "eval r_result1 [t, i, x] \= Suc v" + shows "eval r_phi [i, x] \= v" + using assms r_result1 r_result_Some' r_phi'' by simp + +text \The next function performs dovetailing in order to evaluate +$\varphi_i$ for every argument for arbitrarily many steps. Given $i$ and $z$, +the function decodes $z$ into a pair $(x, t$) and outputs zero (meaning +``true'') iff.\ the computation of $\varphi_i$ on input $x$ halts after at most +$t$ steps. Fixing $i$ and varying $z$ will eventually compute $\varphi_i$ +for every argument in the domain of $\varphi_i$ sufficiently long for it to +converge.\ + +definition "r_dovetail \ + Cn 2 r_not [Cn 2 r_result1 [Cn 2 r_pdec2 [Id 2 1], Id 2 0, Cn 2 r_pdec1 [Id 2 1]]]" + +lemma r_dovetail_prim: "prim_recfn 2 r_dovetail" + by (simp add: r_dovetail_def) + +lemma r_dovetail: + "eval r_dovetail [i, z] \= + (if the (eval r_result1 [pdec2 z, i, pdec1 z]) > 0 then 0 else 1)" + unfolding r_dovetail_def using r_result_total by simp + +text \The function $\mathit{enumdom}$ works as follows in order to +enumerate exactly the domain of $\varphi_i$. Given $i$ and $y$ it searches +for the minimum $z \geq y$ for which the dovetail function returns true. This +$z$ is decoded into $(x, t)$ and the $x$ is output. In this way every value +output by $\mathit{enumdom}$ is in the domain of $\varphi_i$ by construction +of @{term r_dovetail}. Conversely an $x$ in the domain will be output for $y += (x, t)$ where $t$ is such that $\varphi_i$ halts on $x$ within $t$ +steps.\ + +definition "r_dovedelay \ + Cn 3 r_and + [Cn 3 r_dovetail [Id 3 1, Id 3 0], + Cn 3 r_ifle [Id 3 2, Id 3 0, r_constn 2 0, r_constn 2 1]]" + +lemma r_dovedelay_prim: "prim_recfn 3 r_dovedelay" + unfolding r_dovedelay_def using r_dovetail_prim by simp + +lemma r_dovedelay: + "eval r_dovedelay [z, i, y] \= + (if the (eval r_result1 [pdec2 z, i, pdec1 z]) > 0 \ y \ z then 0 else 1)" + by (simp add: r_dovedelay_def r_dovetail r_dovetail_prim) + +definition "r_enumdom \ Cn 2 r_pdec1 [Mn 2 r_dovedelay]" + +lemma r_enumdom_recfn [simp]: "recfn 2 r_enumdom" + by (simp add: r_enumdom_def r_dovedelay_prim) + +lemma r_enumdom [simp]: + "eval r_enumdom [i, y] = + (if \z. eval r_dovedelay [z, i, y] \= 0 + then Some (pdec1 (LEAST z. eval r_dovedelay [z, i, y] \= 0)) + else None)" +proof - + let ?h = "Mn 2 r_dovedelay" + have "total r_dovedelay" + using r_dovedelay_prim by blast + then have "eval ?h [i, y] = + (if (\z. eval r_dovedelay [z, i, y] \= 0) + then Some (LEAST z. eval r_dovedelay [z, i, y] \= 0) + else None)" + using r_dovedelay_prim r_enumdom_recfn eval_Mn_convergI by simp + then show ?thesis + unfolding r_enumdom_def using r_dovedelay_prim by simp +qed + +text \If @{term i} is the code of the empty function, @{term r_enumdom} +has an empty domain, too.\ + +lemma r_enumdom_empty_domain: + assumes "\x. eval r_phi [i, x] \" + shows "\y. eval r_enumdom [i, y] \" + using assms r_result1_diverg' r_dovedelay by simp + +text \If @{term i} is the code of a function with non-empty domain, +@{term r_enumdom} enumerates its domain.\ + +lemma r_enumdom_nonempty_domain: + assumes "eval r_phi [i, x\<^sub>0] \" + shows "\y. eval r_enumdom [i, y] \" + and "\x. eval r_phi [i, x] \ \ (\y. eval r_enumdom [i, y] \= x)" +proof - + show "eval r_enumdom [i, y] \" for y + proof - + obtain t where t: "\t'\t. the (eval r_result1 [t', i, x\<^sub>0]) > 0" + using assms r_result1_converg' by fastforce + let ?z = "prod_encode (x\<^sub>0, max t y)" + have "y \ ?z" + using le_prod_encode_2 max.bounded_iff by blast + moreover have "pdec2 ?z \ t" by simp + ultimately have "the (eval r_result1 [pdec2 ?z, i, pdec1 ?z]) > 0" + using t by simp + with `y \ ?z` r_dovedelay have "eval r_dovedelay [?z, i, y] \= 0" + by presburger + then show "eval r_enumdom [i, y] \" + using r_enumdom by auto + qed + show "eval r_phi [i, x] \ = (\y. eval r_enumdom [i, y] \= x)" for x + proof + show "\y. eval r_enumdom [i, y] \= x" if "eval r_phi [i, x] \" for x + proof - + from that obtain v where "eval r_phi [i, x] \= v" by auto + then obtain t where t: "the (eval r_result1 [t, i, x]) > 0" + using r_result1_converg' assms + by (metis Zero_not_Suc dual_order.refl option.sel zero_less_iff_neq_zero) + let ?y = "prod_encode (x, t)" + have "eval r_dovedelay [?y, i, ?y] \= 0" + using r_dovedelay t by simp + moreover from this have "(LEAST z. eval r_dovedelay [z, i, ?y] \= 0) = ?y" + using gr_implies_not_zero r_dovedelay by (intro Least_equality; fastforce) + ultimately have "eval r_enumdom [i, ?y] \= x" + using r_enumdom by auto + then show ?thesis by blast + qed + show "eval r_phi [i, x] \" if "\y. eval r_enumdom [i, y] \= x" for x + proof - + from that obtain y where y: "eval r_enumdom [i, y] \= x" + by auto + then have "eval r_enumdom [i, y] \" + by simp + then have + "\z. eval r_dovedelay [z, i, y] \= 0" and + *: "eval r_enumdom [i, y] \= pdec1 (LEAST z. eval r_dovedelay [z, i, y] \= 0)" + (is "_ \= pdec1 ?z") + using r_enumdom by metis+ + then have z: "eval r_dovedelay [?z, i, y] \= 0" + by (meson wellorder_Least_lemma(1)) + have "the (eval r_result1 [pdec2 ?z, i, pdec1 ?z]) > 0" + proof (rule ccontr) + assume "\ (the (eval r_result1 [pdec2 ?z, i, pdec1 ?z]) > 0)" + then show False + using r_dovedelay z by simp + qed + then have "eval r_phi [i, pdec1 ?z] \" + using r_result1_diverg' assms by fastforce + then show ?thesis using y * by auto + qed + qed +qed + +text \For every $\varphi_i$ with non-empty domain there is a total +recursive function that enumerates the domain of $\varphi_i$.\ + +lemma nonempty_domain_enumerable: + assumes "eval r_phi [i, x\<^sub>0] \" + shows "\g. recfn 1 g \ total g \ (\x. eval r_phi [i, x] \ \ (\y. eval g [y] \= x))" +proof - + define g where "g \ Cn 1 r_enumdom [r_const i, Id 1 0]" + then have "recfn 1 g" by simp + moreover from this have "total g" + using totalI1[of g] g_def assms r_enumdom_nonempty_domain(1) by simp + moreover have "eval r_phi [i, x] \ \ (\y. eval g [y] \= x)" for x + unfolding g_def using r_enumdom_nonempty_domain(2)[OF assms] by simp + ultimately show ?thesis by auto +qed + + +subsection \Concurrent evaluation of functions\ + +text \We define a function that simulates two @{typ recf}s +``concurrently'' for the same argument and returns the result of the one +converging first. If both diverge, so does the simulation function.\ + +definition "r_both \ + Cn 4 r_ifz + [Cn 4 r_result1 [Id 4 0, Id 4 1, Id 4 3], + Cn 4 r_ifz + [Cn 4 r_result1 [Id 4 0, Id 4 2, Id 4 3], + Cn 4 r_prod_encode [r_constn 3 2, r_constn 3 0], + Cn 4 r_prod_encode + [r_constn 3 1, Cn 4 r_dec [Cn 4 r_result1 [Id 4 0, Id 4 2, Id 4 3]]]], + Cn 4 r_prod_encode + [r_constn 3 0, Cn 4 r_dec [Cn 4 r_result1 [Id 4 0, Id 4 1, Id 4 3]]]]" + +lemma r_both_prim [simp]: "prim_recfn 4 r_both" + unfolding r_both_def by simp + +lemma r_both: + assumes "\x. eval r_phi [i, x] = eval f [x]" + and "\x. eval r_phi [j, x] = eval g [x]" + shows "eval f [x] \ \ eval g [x] \ \ eval r_both [t, i, j, x] \= prod_encode (2, 0)" + and "\eval r_result1 [t, i, x] \= 0; eval r_result1 [t, j, x] \= 0\ \ + eval r_both [t, i, j, x] \= prod_encode (2, 0)" + and "eval r_result1 [t, i, x] \= Suc v \ + eval r_both [t, i, j, x] \= prod_encode (0, the (eval f [x]))" + and "\eval r_result1 [t, i, x] \= 0; eval r_result1 [t, j, x] \= Suc v\ \ + eval r_both [t, i, j, x] \= prod_encode (1, the (eval g [x]))" +proof - + have r_result_total [simp]: "eval r_result [t, k, x] \" for t k x + using r_result_total by simp + { + assume "eval f [x] \ \ eval g [x] \" + then have "eval r_result1 [t, i, x] \= 0" and "eval r_result1 [t, j, x] \= 0" + using assms r_result1_diverg' by auto + then show "eval r_both [t, i, j, x] \= prod_encode (2, 0)" + unfolding r_both_def by simp + next + assume "eval r_result1 [t, i, x] \= 0" and "eval r_result1 [t, j, x] \= 0" + then show "eval r_both [t, i, j, x] \= prod_encode (2, 0)" + unfolding r_both_def by simp + next + assume "eval r_result1 [t, i, x] \= Suc v" + moreover from this have "eval r_result1 [t, i, x] \= Suc (the (eval f [x]))" + using assms r_result1_Some' by fastforce + ultimately show "eval r_both [t, i, j, x] \= prod_encode (0, the (eval f [x]))" + unfolding r_both_def by auto + next + assume "eval r_result1 [t, i, x] \= 0" and "eval r_result1 [t, j, x] \= Suc v" + moreover from this have "eval r_result1 [t, j, x] \= Suc (the (eval g [x]))" + using assms r_result1_Some' by fastforce + ultimately show "eval r_both [t, i, j, x] \= prod_encode (1, the (eval g [x]))" + unfolding r_both_def by auto + } +qed + +definition "r_parallel \ + Cn 3 r_both [Mn 3 (Cn 4 r_le [Cn 4 r_pdec1 [r_both], r_constn 3 1]), Id 3 0, Id 3 1, Id 3 2]" + +lemma r_parallel_recfn [simp]: "recfn 3 r_parallel" + unfolding r_parallel_def by simp + +lemma r_parallel: + assumes "\x. eval r_phi [i, x] = eval f [x]" + and "\x. eval r_phi [j, x] = eval g [x]" + shows "eval f [x] \ \ eval g [x] \ \ eval r_parallel [i, j, x] \" + and "eval f [x] \ \ eval g [x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval f [x]))" + and "eval g [x] \ \ eval f [x] \ \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval g [x]))" + and "eval f [x] \ \ eval g [x] \ \ + eval r_parallel [i, j, x] \= prod_encode (0, the (eval f [x])) \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval g [x]))" +proof - + let ?cond = "Cn 4 r_le [Cn 4 r_pdec1 [r_both], r_constn 3 1]" + define m where "m = Mn 3 ?cond" + then have m: "r_parallel = Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]" + unfolding r_parallel_def by simp + from m_def have "recfn 3 m" by simp + { + assume "eval f [x] \ \ eval g [x] \" + then have "\t. eval r_both [t, i, j, x] \= prod_encode (2, 0)" + using assms r_both by simp + then have "eval ?cond [t, i, j, x] \= 1" for t + by simp + then have "eval m [i, j, x] \" + unfolding m_def using eval_Mn_diverg by simp + then have "eval (Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]) [i, j, x] \" + using `recfn 3 m` by simp + then show "eval r_parallel [i, j, x] \" + using m by simp + next + assume "eval f [x] \ \ eval g [x] \" + then obtain vf vg where v: "eval f [x] \= vf" "eval g [x] \= vg" + by auto + then obtain tf where tf: + "\t\tf. eval r_result1 [t, i, x] \= Suc vf" + "\t= 0" + using r_result1_converg' assms by metis + from v obtain tg where tg: + "\t\tg. eval r_result1 [t, j, x] \= Suc vg" + "\t= 0" + using r_result1_converg' assms by metis + show "eval r_parallel [i, j, x] \= prod_encode (0, the (eval f [x])) \ + eval r_parallel [i, j, x] \= prod_encode (1, the (eval g [x]))" + proof (cases "tf \ tg") + case True + with tg(2) have j0: "\t= 0" + by simp + have *: "eval r_both [tf, i, j, x] \= prod_encode (0, the (eval f [x]))" + using r_both(3) assms tf(1) by simp + have "eval m [i, j, x] \= tf" + unfolding m_def + proof (rule eval_Mn_convergI) + show "recfn (length [i, j, x]) (Mn 3 ?cond)" by simp + have "eval (Cn 4 r_pdec1 [r_both]) [tf, i, j, x] \= 0" + using * by simp + then show "eval ?cond [tf, i, j, x] \= 0" by simp + have "eval r_both [t, i, j, x] \= prod_encode (2, 0)" if "t < tf" for t + using tf(2) r_both(2) assms that j0 by simp + then have "eval ?cond [t, i, j, x] \= 1" if "t < tf" for t + using that by simp + then show "\y. y < tf \ eval ?cond [y, i, j, x] \\ 0" by simp + qed + moreover have "eval r_parallel [i, j, x] = + eval (Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]) [i, j, x]" + using m by simp + ultimately have "eval r_parallel [i, j, x] = eval r_both [tf, i, j, x]" + using `recfn 3 m` by simp + with * have "eval r_parallel [i, j, x] \= prod_encode (0, the (eval f [x]))" + by simp + then show ?thesis by simp + next + case False + with tf(2) have i0: "\t\tg. eval r_result1 [t, i, x] \= 0" + by simp + then have *: "eval r_both [tg, i, j, x] \= prod_encode (1, the (eval g [x]))" + using assms r_both(4) tg(1) by auto + have "eval m [i, j, x] \= tg" + unfolding m_def + proof (rule eval_Mn_convergI) + show "recfn (length [i, j, x]) (Mn 3 ?cond)" by simp + have "eval (Cn 4 r_pdec1 [r_both]) [tg, i, j, x] \= 1" + using * by simp + then show "eval ?cond [tg, i, j, x] \= 0" by simp + have "eval r_both [t, i, j, x] \= prod_encode (2, 0)" if "t < tg" for t + using tg(2) r_both(2) assms that i0 by simp + then have "eval ?cond [t, i, j, x] \= 1" if "t < tg" for t + using that by simp + then show "\y. y < tg \ eval ?cond [y, i, j, x] \\ 0" by simp + qed + moreover have "eval r_parallel [i, j, x] = + eval (Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]) [i, j, x]" + using m by simp + ultimately have "eval r_parallel [i, j, x] = eval r_both [tg, i, j, x]" + using `recfn 3 m` by simp + with * have "eval r_parallel [i, j, x] \= prod_encode (1, the (eval g [x]))" + by simp + then show ?thesis by simp + qed + next + assume eval_fg: "eval g [x] \ \ eval f [x] \" + then have i0: "\t. eval r_result1 [t, i, x] \= 0" + using r_result1_diverg' assms by auto + from eval_fg obtain v where "eval g [x] \= v" + by auto + then obtain t\<^sub>0 where t0: + "\t\t\<^sub>0. eval r_result1 [t, j, x] \= Suc v" + "\t0. eval r_result1 [t, j, x] \= 0" + using r_result1_converg' assms by metis + then have *: "eval r_both [t\<^sub>0, i, j, x] \= prod_encode (1, the (eval g [x]))" + using r_both(4) assms i0 by simp + have "eval m [i, j, x] \= t\<^sub>0" + unfolding m_def + proof (rule eval_Mn_convergI) + show "recfn (length [i, j, x]) (Mn 3 ?cond)" by simp + have "eval (Cn 4 r_pdec1 [r_both]) [t\<^sub>0, i, j, x] \= 1" + using * by simp + then show "eval ?cond [t\<^sub>0, i, j, x] \= 0" by simp + have "eval r_both [t, i, j, x] \= prod_encode (2, 0)" if "t < t\<^sub>0" for t + using t0(2) r_both(2) assms that i0 by simp + then have "eval ?cond [t, i, j, x] \= 1" if "t < t\<^sub>0" for t + using that by simp + then show "\y. y < t\<^sub>0 \ eval ?cond [y, i, j, x] \\ 0" by simp + qed + moreover have "eval r_parallel [i, j, x] = + eval (Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]) [i, j, x]" + using m by simp + ultimately have "eval r_parallel [i, j, x] = eval r_both [t\<^sub>0, i, j, x]" + using `recfn 3 m` by simp + with * show "eval r_parallel [i, j, x] \= prod_encode (1, the (eval g [x]))" + by simp + next + assume eval_fg: "eval f [x] \ \ eval g [x] \" + then have j0: "\t. eval r_result1 [t, j, x] \= 0" + using r_result1_diverg' assms by auto + from eval_fg obtain v where "eval f [x] \= v" + by auto + then obtain t\<^sub>0 where t0: + "\t\t\<^sub>0. eval r_result1 [t, i, x] \= Suc v" + "\t0. eval r_result1 [t, i, x] \= 0" + using r_result1_converg' assms by metis + then have *: "eval r_both [t\<^sub>0, i, j, x] \= prod_encode (0, the (eval f [x]))" + using r_both(3) assms by blast + have "eval m [i, j, x] \= t\<^sub>0" + unfolding m_def + proof (rule eval_Mn_convergI) + show "recfn (length [i, j, x]) (Mn 3 ?cond)" by simp + have "eval (Cn 4 r_pdec1 [r_both]) [t\<^sub>0, i, j, x] \= 0" + using * by simp + then show "eval ?cond [t\<^sub>0, i, j, x] \= 0" + by simp + have "eval r_both [t, i, j, x] \= prod_encode (2, 0)" if "t < t\<^sub>0" for t + using t0(2) r_both(2) assms that j0 by simp + then have "eval ?cond [t, i, j, x] \= 1" if "t < t\<^sub>0" for t + using that by simp + then show "\y. y < t\<^sub>0 \ eval ?cond [y, i, j, x] \\ 0" by simp + qed + moreover have "eval r_parallel [i, j, x] = + eval (Cn 3 r_both [m, Id 3 0, Id 3 1, Id 3 2]) [i, j, x]" + using m by simp + ultimately have "eval r_parallel [i, j, x] = eval r_both [t\<^sub>0, i, j, x]" + using `recfn 3 m` by simp + with * show "eval r_parallel [i, j, x] \= prod_encode (0, the (eval f [x]))" + by simp + } +qed + +end \ No newline at end of file diff --git a/thys/Inductive_Inference/document/root.bib b/thys/Inductive_Inference/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/document/root.bib @@ -0,0 +1,181 @@ +@book{Rogers87, + Author = {Hartley {Rogers, Jr.}}, + Publisher = {The MIT Press}, + Title = {Theory of Recursive Functions and Effective Computability}, + Year = {1987}, + Edition = {2nd} +} + +@Article{Kleene43, + Author = "Stephen Cole Kleene", + Title = "Recursive predicates and quantifiers", + Journal = "Trans. Amer. Math. Soc.", + Volume = "53", + Number = "1", + Year = "1943", + Pages = "41--73", + doi = "10.1090/S0002-9947-1943-0007371-8" +} + +@misc{wiki-krt, + author = "{Wikipedia contributors}", + title = "Kleene's recursion theorem --- {Wikipedia}{,} The Free Encyclopedia", + year = "2020", + url = "https://en.wikipedia.org/w/index.php?title=Kleene%27s_recursion_theorem&oldid=936277979", + note = "[Online; accessed 28-March-2020]" +} + +@InCollection{as-ii-87, + author = "Dana Angluin and Carl H. Smith", + title = "Inductive Inference", + booktitle = "Encyclopedia of Artificial Intelligence", + publisher = "J. Wiley and Sons, New York", + year = "1987", + pages = "409--418", +} + +@Article{fkw-iisde-95, + author = "R\={u}si\c{n}\v{s} Freivalds and Efim B. Kinber and + Rolf Wiehagen", + title = "How Inductive Inference Strategies Discover Their + Errors", + journal = "Inform. Comput.", + volume = "118", + number = "2", + year = "1995", + pages = "208--226", +} + +@Article{cs-cicmii-83, + author = "John Case and Carl H. Smith", + title = "Comparison of Identification Criteria for Machine + Inductive Inference", + journal = "Theoret. Comput. Sci.", + volume = "25", + year = "1983", + pages = "193--220", + annote = "Was in STOC78", +} + +@InCollection{b-ttlsf-74, + author = "J. M. Barzdin", + title = "Two Theorems on the Limiting Synthesis of Functions", + booktitle = "Theory of Algorithms and Programs", + volume = "1", + publisher = "Latvian State University, Riga", + year = "1974", + pages = "82--88", + note = "In Russian", +} + +@Article{jb-cpnii-81, + author = "Klaus P. Jantke and Hans-Rainer Beick", + title = "Combining postulates of naturalness in inductive inference", + journal = "Elektronische Informationsverarbeitung und Kybernetik", + volume = "17", + number = "8/9", + year = "1981", + pages = "465--484", +} + +@Article{w-lerfss-76, + author = "Rolf Wiehagen", + title = "Limes-{E}rkennung rekursiver {F}unktionen durch spezielle {S}trategien", + journal = "Journal of Information Processing and Cybernetics (EIK)", + volume = "12", + year = "1976", + pages = "93--99", +} + +@Article{wz-idmowle-94, + author = "Rolf Wiehagen and Thomas Zeugmann", + title = "Ignoring data may be the only way to learn efficiently", + journal = "J. of Experimental and Theoret. Artif. Intell.", + volume = "6", + number = "1", + year = "1994", + pages = "131--144", +} + +@Article{g-lil-67, + author = "E. Mark Gold", + title = "Language Identification in the Limit", + journal = "Inform. Control", + volume = "10", + number = "5", + year = "1967", + pages = "447--474", + comment = "Classic paper, introducing computer science theory + into learning.", +} + +@Article{g-lr-65, + author = "E. M. Gold", + title = "Limiting Recursion", + journal = "J. Symbolic Logic", + volume = "30", + year = "1965", + pages = "28--48", +} + +@Article{s-ftiip1-64, + author = "R. J. Solomonoff", + title = "A Formal Theory of Inductive Inference: Part 1", + journal = "Inform. Control", + volume = "7", + year = "1964", + pages = "1--22", + comment = "Concerned with extrapolation of sequences. Defines + probability of extension via likelihood random TM + program will generate it.", +} + +@Article{s-ftiip2-64, + author = "R. J. Solomonoff", + title = "A Formal Theory of Inductive Inference: Part 2", + journal = "Inform. Control", + volume = "7", + year = "1964", + pages = "224--254", + comment = "Continues Part I. Inference of probabilities and + grammars.", +} + +@InProceedings{b-iiafp-74, + author = "{Ya}. M. Barzdin", + title = "Inductive Inference of Automata, Functions and Programs", + booktitle = "Proceedings International Congress of Mathematics", + year = "1974", + venue = "Vancouver", + pages = "455--460", +} + +@InProceedings{b-iiafp-77, + author = "J. M. Barzdin", + title = "Inductive Inference of Automata, Functions and Programs", + booktitle = "Amer. Math. Soc. Transl.", + year = "1977", + pages = "107--122", +} + +@Article{bb-tmtii-75, + author = "Leonore Blum and Manuel Blum", + title = "Toward a Mathematical Theory of Inductive Inference", + journal = "Inform. Control", + volume = "28", + number = "2", + month = jun, + year = "1975", + pages = "125--155", +} + +@article{Universal_Turing_Machine-AFP, + author = {Jian Xu and Xingyuan Zhang and Christian Urban and Sebastiaan J. C. Joosten}, + title = {Universal Turing Machine}, + journal = {Archive of Formal Proofs}, + month = feb, + year = 2019, + note = {\url{http://isa-afp.org/entries/Universal_Turing_Machine.html}, + Formal proof development}, + ISSN = {2150-914x}, +} diff --git a/thys/Inductive_Inference/document/root.tex b/thys/Inductive_Inference/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Inductive_Inference/document/root.tex @@ -0,0 +1,71 @@ +\documentclass[11pt,a4paper]{report} +\usepackage{isabelle,isabellesym} + +\usepackage[utf8]{inputenc} + +\usepackage[top=3cm,bottom=3cm]{geometry} + +\usepackage{amssymb} % for \mathbb + +% 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{Some classical results in inductive inference of recursive functions} +\author{Frank J. Balbach} +\maketitle + +\begin{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 \emph{Universal Turing Machine} entry by +Xu~et~al.~\cite{Universal_Turing_Machine-AFP}, but different in that it models +partial functions with codomain \emph{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. +\end{abstract} + +\tableofcontents + +\newpage + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} diff --git a/thys/PAC_Checker/Duplicate_Free_Multiset.thy b/thys/PAC_Checker/Duplicate_Free_Multiset.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/Duplicate_Free_Multiset.thy @@ -0,0 +1,157 @@ +(* + File: Duplicate_Free_Multiset.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory Duplicate_Free_Multiset +imports Nested_Multisets_Ordinals.Multiset_More +begin + + +section \Duplicate Free Multisets\ + +(* TODO Move Multiset_More *) +lemma remove_diff_multiset[simp]: \x13 \# A \ A - add_mset x13 B = A - B\ + by (metis diff_intersect_left_idem inter_add_right1) + + +text \Duplicate free multisets are isomorphic to finite sets, but it can be useful to reason about + duplication to speak about intermediate execution steps in the refinements. +\ +lemma distinct_mset_remdups_mset_id: \distinct_mset C \ remdups_mset C = C\ + by (induction C) auto + +lemma notin_add_mset_remdups_mset: + \a \# A \ add_mset a (remdups_mset A) = remdups_mset (add_mset a A)\ + by auto + +lemma distinct_mset_image_mset: + \distinct_mset (image_mset f (mset xs)) \ distinct (map f xs)\ + apply (subst mset_map[symmetric]) + apply (subst distinct_mset_mset_distinct) + .. + +lemma distinct_mset_mono: \D' \# D \ distinct_mset D \ distinct_mset D'\ + by (metis distinct_mset_union subset_mset.le_iff_add) + +lemma distinct_mset_mono_strict: \D' \# D \ distinct_mset D \ distinct_mset D'\ + using distinct_mset_mono by auto + +lemma distinct_set_mset_eq_iff: + assumes \distinct_mset M\ \distinct_mset N\ + shows \set_mset M = set_mset N \ M = N\ + using assms distinct_mset_set_mset_ident by fastforce + +lemma distinct_mset_union2: + \distinct_mset (A + B) \ distinct_mset B\ + using distinct_mset_union[of B A] + by (auto simp: ac_simps) + +lemma distinct_mset_mset_set: \distinct_mset (mset_set A)\ + unfolding distinct_mset_def count_mset_set_if by (auto simp: not_in_iff) + +lemma distinct_mset_inter_remdups_mset: + assumes dist: \distinct_mset A\ + shows \A \# remdups_mset B = A \# B\ +proof - + have [simp]: \A' \# remove1_mset a (remdups_mset Aa) = A' \# Aa\ + if + \A' \# remdups_mset Aa = A' \# Aa\ and + \a \# A'\ and + \a \# Aa\ + for A' Aa :: \'a multiset\ and a + by (metis insert_DiffM inter_add_right1 set_mset_remdups_mset that) + + show ?thesis + using dist + apply (induction A) + subgoal by auto + subgoal for a A' + by (cases \a \# B\) + (use multi_member_split[of a \B\] multi_member_split[of a \A\] in + \auto simp: mset_set.insert_remove\) + done +qed + +lemma finite_mset_set_inter: + \finite A \ finite B \ mset_set (A \ B) = mset_set A \# mset_set B\ + apply (induction A rule: finite_induct) + subgoal by auto + subgoal for a A + by (cases \a \ B\; cases \a \# mset_set B\) + (use multi_member_split[of a \mset_set B\] in + \auto simp: mset_set.insert_remove\) + done + +lemma removeAll_notin: \a \# A \ removeAll_mset a A = A\ + using count_inI by force + +lemma same_mset_distinct_iff: + \mset M = mset M' \ distinct M \ distinct M'\ + by (auto simp: distinct_mset_mset_distinct[symmetric] simp del: distinct_mset_mset_distinct) + + +subsection \More Lists\ +lemma in_set_conv_iff: + \x \ set (take n xs) \ (\i < n. i < length xs \ xs ! i = x)\ + apply (induction n) + subgoal by auto + subgoal for n + apply (cases \Suc n < length xs\) + subgoal by (auto simp: take_Suc_conv_app_nth less_Suc_eq dest: in_set_takeD) + subgoal + apply (cases \n < length xs\) + subgoal + apply (auto simp: in_set_conv_nth) + by (rename_tac i, rule_tac x=i in exI; auto; fail)+ + subgoal + apply (auto simp: take_Suc_conv_app_nth dest: in_set_takeD) + by (rename_tac i, rule_tac x=i in exI; auto; fail)+ + done + done + done + +lemma in_set_take_conv_nth: + \x \ set (take n xs) \ (\m + by (metis in_set_conv_nth length_take min.commute min.strict_boundedE nth_take) + +lemma in_set_remove1D: + \a \ set (remove1 x xs) \ a \ set xs\ + by (meson notin_set_remove1) + + +subsection \Generic Multiset\ + +lemma mset_drop_upto: \mset (drop a N) = {#N!i. i \# mset_set {a.. +proof (induction N arbitrary: a) + case Nil + then show ?case by simp +next + case (Cons c N) + have upt: \{0.. + by auto + then have H: \mset_set {0.. + unfolding upt by auto + have mset_case_Suc: \{#case x of 0 \ c | Suc x \ N ! x . x \# mset_set {Suc a..# mset_set {Suc a.. for a b + by (rule image_mset_cong) (auto split: nat.splits) + have Suc_Suc: \{Suc a.. for a b + by auto + then have mset_set_Suc_Suc: \mset_set {Suc a..# mset_set {a.. for a b + unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto + have *: \{#N ! (x-Suc 0) . x \# mset_set {Suc a..# mset_set {a.. + for a b + by (auto simp add: mset_set_Suc_Suc) + show ?case + apply (cases a) + using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *) +qed + + +subsection \Other\ + +text \I believe this should be added to the simplifier by default...\ +lemma Collect_eq_comp': \ {(x, y). P x y} O {(c, a). c = f a} = {(x, a). P x (f a)}\ + by auto + +end diff --git a/thys/PAC_Checker/Finite_Map_Multiset.thy b/thys/PAC_Checker/Finite_Map_Multiset.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/Finite_Map_Multiset.thy @@ -0,0 +1,227 @@ +(* + File: Finite_Map_Multiset.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory Finite_Map_Multiset +imports "HOL-Library.Finite_Map" Duplicate_Free_Multiset +begin + +notation image_mset (infixr "`#" 90) + +section \Finite maps and multisets\ + +subsection \Finite sets and multisets\ + +abbreviation mset_fset :: \'a fset \ 'a multiset\ where + \mset_fset N \ mset_set (fset N)\ + +definition fset_mset :: \'a multiset \ 'a fset\ where + \fset_mset N \ Abs_fset (set_mset N)\ + +lemma fset_mset_mset_fset: \fset_mset (mset_fset N) = N\ + by (auto simp: fset.fset_inverse fset_mset_def) + +lemma mset_fset_fset_mset[simp]: + \mset_fset (fset_mset N) = remdups_mset N\ + by (auto simp: fset.fset_inverse fset_mset_def Abs_fset_inverse remdups_mset_def) + +lemma in_mset_fset_fmember[simp]: \x \# mset_fset N \ x |\| N\ + by (auto simp: fmember.rep_eq) + +lemma in_fset_mset_mset[simp]: \x |\| fset_mset N \ x \# N\ + by (auto simp: fmember.rep_eq fset_mset_def Abs_fset_inverse) + + +subsection \Finite map and multisets\ + +text \Roughly the same as \<^term>\ran\ and \<^term>\dom\, but with duplication in the content (unlike their + finite sets counterpart) while still working on finite domains (unlike a function mapping). + Remark that \<^term>\dom_m\ (the keys) does not contain duplicates, but we keep for symmetry (and for + easier use of multiset operators as in the definition of \<^term>\ran_m\). +\ +definition dom_m where + \dom_m N = mset_fset (fmdom N)\ + +definition ran_m where + \ran_m N = the `# fmlookup N `# dom_m N\ + +lemma dom_m_fmdrop[simp]: \dom_m (fmdrop C N) = remove1_mset C (dom_m N)\ + unfolding dom_m_def + by (cases \C |\| fmdom N\) + (auto simp: mset_set.remove fmember.rep_eq) + +lemma dom_m_fmdrop_All: \dom_m (fmdrop C N) = removeAll_mset C (dom_m N)\ + unfolding dom_m_def + by (cases \C |\| fmdom N\) + (auto simp: mset_set.remove fmember.rep_eq) + +lemma dom_m_fmupd[simp]: \dom_m (fmupd k C N) = add_mset k (remove1_mset k (dom_m N))\ + unfolding dom_m_def + by (cases \k |\| fmdom N\) + (auto simp: mset_set.remove fmember.rep_eq mset_set.insert_remove) + +lemma distinct_mset_dom: \distinct_mset (dom_m N)\ + by (simp add: distinct_mset_mset_set dom_m_def) + +lemma in_dom_m_lookup_iff: \C \# dom_m N' \ fmlookup N' C \ None\ + by (auto simp: dom_m_def fmdom.rep_eq fmlookup_dom'_iff) + +lemma in_dom_in_ran_m[simp]: \i \# dom_m N \ the (fmlookup N i) \# ran_m N\ + by (auto simp: ran_m_def) + +lemma fmupd_same[simp]: + \x1 \# dom_m x1aa \ fmupd x1 (the (fmlookup x1aa x1)) x1aa = x1aa\ + by (metis fmap_ext fmupd_lookup in_dom_m_lookup_iff option.collapse) + +lemma ran_m_fmempty[simp]: \ran_m fmempty = {#}\ and + dom_m_fmempty[simp]: \dom_m fmempty = {#}\ + by (auto simp: ran_m_def dom_m_def) + +lemma fmrestrict_set_fmupd: + \a \ xs \ fmrestrict_set xs (fmupd a C N) = fmupd a C (fmrestrict_set xs N)\ + \a \ xs \ fmrestrict_set xs (fmupd a C N) = fmrestrict_set xs N\ + by (auto simp: fmfilter_alt_defs) + +lemma fset_fmdom_fmrestrict_set: + \fset (fmdom (fmrestrict_set xs N)) = fset (fmdom N) \ xs\ + by (auto simp: fmfilter_alt_defs) + +lemma dom_m_fmrestrict_set: \dom_m (fmrestrict_set (set xs) N) = mset xs \# dom_m N\ + using fset_fmdom_fmrestrict_set[of \set xs\ N] distinct_mset_dom[of N] + distinct_mset_inter_remdups_mset[of \mset_fset (fmdom N)\ \mset xs\] + by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute + remdups_mset_def) + +lemma dom_m_fmrestrict_set': \dom_m (fmrestrict_set xs N) = mset_set (xs \ set_mset (dom_m N))\ + using fset_fmdom_fmrestrict_set[of \xs\ N] distinct_mset_dom[of N] + by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute + remdups_mset_def) + +lemma indom_mI: \fmlookup m x = Some y \ x \# dom_m m\ + by (drule fmdomI) (auto simp: dom_m_def fmember.rep_eq) + +lemma fmupd_fmdrop_id: + assumes \k |\| fmdom N'\ + shows \fmupd k (the (fmlookup N' k)) (fmdrop k N') = N'\ +proof - + have [simp]: \map_upd k (the (fmlookup N' k)) + (\x. if x \ k then fmlookup N' x else None) = + map_upd k (the (fmlookup N' k)) + (fmlookup N')\ + by (auto intro!: ext simp: map_upd_def) + have [simp]: \map_upd k (the (fmlookup N' k)) (fmlookup N') = fmlookup N'\ + using assms + by (auto intro!: ext simp: map_upd_def) + have [simp]: \finite (dom (\x. if x = k then None else fmlookup N' x))\ + by (subst dom_if) auto + show ?thesis + apply (auto simp: fmupd_def fmupd.abs_eq[symmetric]) + unfolding fmlookup_drop + apply (simp add: fmlookup_inverse) + done +qed + +lemma fm_member_split: \k |\| fmdom N' \ \N'' v. N' = fmupd k v N'' \ the (fmlookup N' k) = v \ + k |\| fmdom N''\ + by (rule exI[of _ \fmdrop k N'\]) + (auto simp: fmupd_fmdrop_id) + +lemma \fmdrop k (fmupd k va N'') = fmdrop k N''\ + by (simp add: fmap_ext) + +lemma fmap_ext_fmdom: + \(fmdom N = fmdom N') \ (\ x. x |\| fmdom N \ fmlookup N x = fmlookup N' x) \ + N = N'\ + by (rule fmap_ext) + (case_tac \x |\| fmdom N\, auto simp: fmdom_notD) + +lemma fmrestrict_set_insert_in: + \xa \ fset (fmdom N) \ + fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\ + apply (rule fmap_ext_fmdom) + apply (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset; fail)[] + apply (auto simp: fmlookup_dom_iff; fail) + done + +lemma fmrestrict_set_insert_notin: + \xa \ fset (fmdom N) \ + fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\ + by (rule fmap_ext_fmdom) + (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset) + +lemma fmrestrict_set_insert_in_dom_m[simp]: + \xa \# dom_m N \ + fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\ + by (simp add: fmrestrict_set_insert_in dom_m_def) + +lemma fmrestrict_set_insert_notin_dom_m[simp]: + \xa \# dom_m N \ + fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\ + by (simp add: fmrestrict_set_insert_notin dom_m_def) + +lemma fmlookup_restrict_set_id: \fset (fmdom N) \ A \ fmrestrict_set A N = N\ + by (metis fmap_ext fmdom'_alt_def fmdom'_notD fmlookup_restrict_set subset_iff) + +lemma fmlookup_restrict_set_id': \set_mset (dom_m N) \ A \ fmrestrict_set A N = N\ + by (rule fmlookup_restrict_set_id) + (auto simp: dom_m_def) + +lemma ran_m_mapsto_upd: + assumes + NC: \C \# dom_m N\ + shows \ran_m (fmupd C C' N) = add_mset C' (remove1_mset (the (fmlookup N C)) (ran_m N))\ +proof - + define N' where + \N' = fmdrop C N\ + have N_N': \dom_m N = add_mset C (dom_m N')\ + using NC unfolding N'_def by auto + have \C \# dom_m N'\ + using NC distinct_mset_dom[of N] unfolding N_N' by auto + then show ?thesis + by (auto simp: N_N' ran_m_def mset_set.insert_remove image_mset_remove1_mset_if + intro!: image_mset_cong) +qed + +lemma ran_m_mapsto_upd_notin: + assumes NC: \C \# dom_m N\ + shows \ran_m (fmupd C C' N) = add_mset C' (ran_m N)\ + using NC + by (auto simp: ran_m_def mset_set.insert_remove image_mset_remove1_mset_if + intro!: image_mset_cong split: if_splits) + +lemma image_mset_If_eq_notin: + \C \# A \ {#f (if x = C then a x else b x). x \# A#} = {# f(b x). x \# A #}\ + by (induction A) auto + +lemma filter_mset_cong2: + "(\x. x \# M \ f x = g x) \ M = N \ filter_mset f M = filter_mset g N" + by (hypsubst, rule filter_mset_cong, simp) + +lemma ran_m_fmdrop: + \C \# dom_m N \ ran_m (fmdrop C N) = remove1_mset (the (fmlookup N C)) (ran_m N)\ + using distinct_mset_dom[of N] + by (cases \fmlookup N C\) + (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \\x. fst (the x)\] + dest!: multi_member_split + intro!: filter_mset_cong2 image_mset_cong2) + +lemma ran_m_fmdrop_notin: + \C \# dom_m N \ ran_m (fmdrop C N) = ran_m N\ + using distinct_mset_dom[of N] + by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \\x. fst (the x)\] + dest!: multi_member_split + intro!: filter_mset_cong2 image_mset_cong2) + +lemma ran_m_fmdrop_If: + \ran_m (fmdrop C N) = (if C \# dom_m N then remove1_mset (the (fmlookup N C)) (ran_m N) else ran_m N)\ + using distinct_mset_dom[of N] + by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \\x. fst (the x)\] + dest!: multi_member_split + intro!: filter_mset_cong2 image_mset_cong2) + +lemma dom_m_empty_iff[iff]: + \dom_m NU = {#} \ NU = fmempty\ + by (cases NU) (auto simp: dom_m_def mset_set.insert_remove) + +end \ No newline at end of file diff --git a/thys/PAC_Checker/More_Loops.thy b/thys/PAC_Checker/More_Loops.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/More_Loops.thy @@ -0,0 +1,128 @@ +(* + File: More_Loops.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory More_Loops +imports + "Refine_Monadic.Refine_While" + "Refine_Monadic.Refine_Foreach" + "HOL-Library.Rewrite" +begin + +subsection \More Theorem about Loops\ + +text \Most theorem below have a counterpart in the Refinement Framework that is weaker (by missing + assertions for example that are critical for code generation). +\ +lemma Down_id_eq: + \\Id x = x\ + by auto + +lemma while_upt_while_direct1: + "b \ a \ + do { + (_,\) \ WHILE\<^sub>T (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) + ([a..); + RETURN \ + } \ do { + (_,\) \ WHILE\<^sub>T (\(i, x). i < b \ c x) (\(i, x). do {ASSERT (i < b); \'\f i x; RETURN (i+1,\') +}) (a,\); + RETURN \ + }" + apply (rewrite at \_ \ \\ Down_id_eq[symmetric]) + apply (refine_vcg WHILET_refine[where R = \{((l, x'), (i::nat, x::'a)). x= x' \ i \ b \ i \ a \ + l = drop (i-a) [a..]) + subgoal by auto + subgoal by (auto simp: FOREACH_cond_def) + subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine]) + subgoal by auto + done + +lemma while_upt_while_direct2: + "b \ a \ + do { + (_,\) \ WHILE\<^sub>T (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) + ([a..); + RETURN \ + } \ do { + (_,\) \ WHILE\<^sub>T (\(i, x). i < b \ c x) (\(i, x). do {ASSERT (i < b); \'\f i x; RETURN (i+1,\') +}) (a,\); + RETURN \ + }" + apply (rewrite at \_ \ \\ Down_id_eq[symmetric]) + apply (refine_vcg WHILET_refine[where R = \{((i::nat, x::'a), (l, x')). x= x' \ i \ b \ i \ a \ + l = drop (i-a) [a..]) + subgoal by auto + subgoal by (auto simp: FOREACH_cond_def) + subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine]) + subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine]) + subgoal by auto + done + +lemma while_upt_while_direct: + "b \ a \ + do { + (_,\) \ WHILE\<^sub>T (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) + ([a..); + RETURN \ + } = do { + (_,\) \ WHILE\<^sub>T (\(i, x). i < b \ c x) (\(i, x). do {ASSERT (i < b); \'\f i x; RETURN (i+1,\') +}) (a,\); + RETURN \ + }" + using while_upt_while_direct1[of a b] while_upt_while_direct2[of a b] + unfolding order_class.eq_iff by fast + +lemma while_nfoldli: + "do { + (_,\) \ WHILE\<^sub>T (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l,\); + RETURN \ + } \ nfoldli l c f \" + apply (induct l arbitrary: \) + apply (subst WHILET_unfold) + apply (simp add: FOREACH_cond_def) + + apply (subst WHILET_unfold) + apply (auto + simp: FOREACH_cond_def FOREACH_body_def + intro: bind_mono Refine_Basic.bind_mono(1)) + done +lemma nfoldli_while: "nfoldli l c f \ + \ + (WHILE\<^sub>T\<^bsup>I\<^esup> + (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l, \) \ + (\(_, \). RETURN \))" +proof (induct l arbitrary: \) + case Nil thus ?case by (subst WHILEIT_unfold) (auto simp: FOREACH_cond_def) +next + case (Cons x ls) + show ?case + proof (cases "c \") + case False thus ?thesis + apply (subst WHILEIT_unfold) + unfolding FOREACH_cond_def + by simp + next + case [simp]: True + from Cons show ?thesis + apply (subst WHILEIT_unfold) + unfolding FOREACH_cond_def FOREACH_body_def + apply clarsimp + apply (rule Refine_Basic.bind_mono) + apply simp_all + done + qed +qed + +lemma while_eq_nfoldli: "do { + (_,\) \ WHILE\<^sub>T (FOREACH_cond c) (\x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l,\); + RETURN \ + } = nfoldli l c f \" + apply (rule antisym) + apply (rule while_nfoldli) + apply (rule order_trans[OF nfoldli_while[where I="\_. True"]]) + apply (simp add: WHILET_def) + done + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy b/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy @@ -0,0 +1,152 @@ +theory PAC_Assoc_Map_Rel + imports PAC_Map_Rel +begin + +section \Hash Map as association list\ + +type_synonym ('k, 'v) hash_assoc = \('k \ 'v) list\ + +definition hassoc_map_rel_raw :: \(('k, 'v) hash_assoc \ _) set\ where + \hassoc_map_rel_raw = br map_of (\_. True)\ + +abbreviation hassoc_map_assn :: \('k \ 'v option) \ ('k, 'v) hash_assoc \ assn\ where + \hassoc_map_assn \ pure (hassoc_map_rel_raw)\ + +lemma hassoc_map_rel_raw_empty[simp]: + \([], m) \ hassoc_map_rel_raw \ m = Map.empty\ + \(p, Map.empty) \ hassoc_map_rel_raw \ p = []\ + \hassoc_map_assn Map.empty [] = emp\ + by (auto simp: hassoc_map_rel_raw_def br_def pure_def) + +definition hassoc_new :: \('k, 'v) hash_assoc Heap\where + \hassoc_new = return []\ + + lemma precise_hassoc_map_assn: \precise hassoc_map_assn\ + by (auto intro!: precise_pure) + (auto simp: single_valued_def hassoc_map_rel_raw_def + br_def) + + definition hassoc_isEmpty :: "('k \ 'v) list \ bool Heap" where + "hassoc_isEmpty ht \ return (length ht = 0)" + + + interpretation hassoc: bind_map_empty hassoc_map_assn hassoc_new + by unfold_locales + (auto intro: precise_hassoc_map_assn + simp: ent_refl_true hassoc_new_def + intro!: return_cons_rule) + + + interpretation hassoc: bind_map_is_empty hassoc_map_assn hassoc_isEmpty + by unfold_locales + (auto simp: precise_hassoc_map_assn hassoc_isEmpty_def ent_refl_true + intro!: precise_pure return_cons_rule) + + definition "op_assoc_empty \ IICF_Map.op_map_empty" + + interpretation hassoc: map_custom_empty op_assoc_empty + by unfold_locales (simp add: op_assoc_empty_def) + + + lemmas [sepref_fr_rules] = hassoc.empty_hnr[folded op_assoc_empty_def] + + definition hassoc_update :: "'k \ 'v \ ('k, 'v) hash_assoc \ ('k, 'v) hash_assoc Heap" where + "hassoc_update k v ht = return ((k, v ) # ht)" + + lemma hassoc_map_assn_Cons: + \hassoc_map_assn (m) (p) \\<^sub>A hassoc_map_assn (m(k \ v)) ((k, v) # p) * true\ + by (auto simp: hassoc_map_rel_raw_def pure_def br_def) + + interpretation hassoc: bind_map_update hassoc_map_assn hassoc_update + by unfold_locales + (auto intro!: return_cons_rule + simp: hassoc_update_def hassoc_map_assn_Cons) + + + definition hassoc_delete :: \'k \ ('k, 'v) hash_assoc \ ('k, 'v) hash_assoc Heap\ where + \hassoc_delete k ht = return (filter (\(a, b). a \ k) ht)\ + + lemma hassoc_map_of_filter_all: + \map_of p |` (- {k}) = map_of (filter (\(a, b). a \ k) p)\ + apply (induction p) + apply (auto simp: restrict_map_def fun_eq_iff split: if_split) + apply presburger+ + done + + lemma hassoc_map_assn_hassoc_delete: \ hassoc_delete k p \<^sub>t\ + by (auto simp: hassoc_delete_def hassoc_map_rel_raw_def pure_def br_def + hassoc_map_of_filter_all + intro!: return_cons_rule) + + interpretation hassoc: bind_map_delete hassoc_map_assn hassoc_delete + by unfold_locales + (auto intro: hassoc_map_assn_hassoc_delete) + + + definition hassoc_lookup :: \'k \ ('k, 'v) hash_assoc \ 'v option Heap\ where + \hassoc_lookup k ht = return (map_of ht k)\ + + lemma hassoc_map_assn_hassoc_lookup: + \ hassoc_lookup k p <\r. hassoc_map_assn m p * \ (r = m k)>\<^sub>t\ + by (auto simp: hassoc_lookup_def hassoc_map_rel_raw_def pure_def br_def + hassoc_map_of_filter_all + intro!: return_cons_rule) + + interpretation hassoc: bind_map_lookup hassoc_map_assn hassoc_lookup + by unfold_locales + (rule hassoc_map_assn_hassoc_lookup) + + setup Locale_Code.open_block + interpretation hassoc: gen_contains_key_by_lookup hassoc_map_assn hassoc_lookup + by unfold_locales + setup Locale_Code.close_block + + interpretation hassoc: bind_map_contains_key hassoc_map_assn hassoc.contains_key + by unfold_locales + + +subsection \Conversion from assoc to other map\ + +definition hash_of_assoc_map where +\hash_of_assoc_map xs = fold (\(k, v) m. if m k \ None then m else m(k \ v)) xs Map.empty\ + +lemma map_upd_map_add_left: + \m(a \ b) ++ m' = m ++ (if a \ dom m' then m'(a \ b) else m')\ +proof - + have \m' a = Some y \ m(a \ b) ++ m' = m ++ m'\ for y + by (metis (no_types) fun_upd_triv fun_upd_upd map_add_assoc map_add_empty map_add_upd + map_le_iff_map_add_commute) + then show ?thesis + by auto +qed + +lemma fold_map_of_alt: + \fold (\(k, v) m. if m k \ None then m else m(k \ v)) xs m' = map_of xs ++ m'\ + by (induction xs arbitrary: m') + (auto simp: map_upd_map_add_left) + +lemma map_of_alt_def: + \map_of xs = hash_of_assoc_map xs\ + using fold_map_of_alt[of xs Map.empty] + unfolding hash_of_assoc_map_def + by auto + +definition hashmap_conv where + [simp]: \hashmap_conv x = x\ + +lemma hash_of_assoc_map_id: + \(hash_of_assoc_map, hashmap_conv) \ hassoc_map_rel_raw \ Id\ + by (auto intro!: fun_relI simp: hassoc_map_rel_raw_def br_def map_of_alt_def) + +definition hassoc_map_rel where + hassoc_map_rel_internal_def: + \hassoc_map_rel K V = hassoc_map_rel_raw O \K,V\map_rel\ + +lemma hassoc_map_rel_def: + \\K,V\ hassoc_map_rel = hassoc_map_rel_raw O \K,V\map_rel\ + unfolding relAPP_def hassoc_map_rel_internal_def + by auto + + +end + diff --git a/thys/PAC_Checker/PAC_Checker.thy b/thys/PAC_Checker/PAC_Checker.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker.thy @@ -0,0 +1,1381 @@ +(* + File: PAC_Checker.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker + imports PAC_Polynomials_Operations + PAC_Checker_Specification + PAC_Map_Rel + Show.Show + Show.Show_Instances +begin + +section \Executable Checker\ + +text \In this layer we finally refine the checker to executable code.\ + +subsection \Definitions\ + +text \Compared to the previous layer, we add an error message when an error is discovered. We do not + attempt to prove anything on the error message (neither that there really is an error, nor that the + error message is correct). +\ + +paragraph \Extended error message\ + +datatype 'a code_status = + is_cfailed: CFAILED (the_error: 'a) | + CSUCCESS | + is_cfound: CFOUND + +text \In the following function, we merge errors. We will never merge an error message with an + another error message; hence we do not attempt to concatenate error messages. +\ +fun merge_cstatus where + \merge_cstatus (CFAILED a) _ = CFAILED a\ | + \merge_cstatus _ (CFAILED a) = CFAILED a\ | + \merge_cstatus CFOUND _ = CFOUND\ | + \merge_cstatus _ CFOUND = CFOUND\ | + \merge_cstatus _ _ = CSUCCESS\ + +definition code_status_status_rel :: \('a code_status \ status) set\ where +\code_status_status_rel = + {(CFOUND, FOUND), (CSUCCESS, SUCCESS)} \ + {(CFAILED a, FAILED)| a. True}\ + +lemma in_code_status_status_rel_iff[simp]: + \(CFOUND, b) \ code_status_status_rel \ b = FOUND\ + \(a, FOUND) \ code_status_status_rel \ a = CFOUND\ + \(CSUCCESS, b) \ code_status_status_rel \ b = SUCCESS\ + \(a, SUCCESS) \ code_status_status_rel \ a = CSUCCESS\ + \(a, FAILED) \ code_status_status_rel \ is_cfailed a\ + \(CFAILED C, b) \ code_status_status_rel \ b = FAILED\ + by (cases a; cases b; auto simp: code_status_status_rel_def; fail)+ + + +paragraph \Refinement relation\ + +fun pac_step_rel_raw :: \('olbl \ 'lbl) set \ ('a \ 'b) set \ ('c \ 'd) set \ ('a, 'c, 'olbl) pac_step \ ('b, 'd, 'lbl) pac_step \ bool\ where +\pac_step_rel_raw R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') \ + (p1, p1') \ R1 \ (p2, p2') \ R1 \ (i, i') \ R1 \ + (r, r') \ R2\ | +\pac_step_rel_raw R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') \ + (p1, p1') \ R1 \ (p2, p2') \ R2 \ (i, i') \ R1 \ + (r, r') \ R2\ | +\pac_step_rel_raw R1 R2 R3 (Del p1) (Del p1') \ + (p1, p1') \ R1\ | +\pac_step_rel_raw R1 R2 R3 (Extension i x p1) (Extension j x' p1') \ + (i, j) \ R1 \ (x, x') \ R3 \ (p1, p1') \ R2\ | +\pac_step_rel_raw R1 R2 R3 _ _ \ False\ + +fun pac_step_rel_assn :: \('olbl \ 'lbl \ assn) \ ('a \ 'b \ assn) \ ('c \ 'd \ assn) \ ('a, 'c, 'olbl) pac_step \ ('b, 'd, 'lbl) pac_step \ assn\ where +\pac_step_rel_assn R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') = + R1 p1 p1' * R1 p2 p2' * R1 i i' * + R2 r r'\ | +\pac_step_rel_assn R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') = + R1 p1 p1' * R2 p2 p2' * R1 i i' * + R2 r r'\ | +\pac_step_rel_assn R1 R2 R3 (Del p1) (Del p1') = + R1 p1 p1'\ | +\pac_step_rel_assn R1 R2 R3 (Extension i x p1) (Extension i' x' p1') = + R1 i i' * R3 x x' * R2 p1 p1'\ | +\pac_step_rel_assn R1 R2 _ _ _ = false\ + +lemma pac_step_rel_assn_alt_def: + \pac_step_rel_assn R1 R2 R3 x y = ( + case (x, y) of + (Add p1 p2 i r, Add p1' p2' i' r') \ + R1 p1 p1' * R1 p2 p2' * R1 i i' * R2 r r' + | (Mult p1 p2 i r, Mult p1' p2' i' r') \ + R1 p1 p1' * R2 p2 p2' * R1 i i' * R2 r r' + | (Del p1, Del p1') \ R1 p1 p1' + | (Extension i x p1, Extension i' x' p1') \ R1 i i' * R3 x x' * R2 p1 p1' + | _ \ false)\ + by (auto split: pac_step.splits) + + +paragraph \Addition checking\ + +definition error_msg where + \error_msg i msg = CFAILED (''s CHECKING failed at line '' @ show i @ '' with error '' @ msg)\ + +definition error_msg_notin_dom_err where + \error_msg_notin_dom_err = '' notin domain''\ + +definition error_msg_notin_dom :: \nat \ string\ where + \error_msg_notin_dom i = show i @ error_msg_notin_dom_err\ + +definition error_msg_reused_dom where + \error_msg_reused_dom i = show i @ '' already in domain''\ + + +definition error_msg_not_equal_dom where + \error_msg_not_equal_dom p q pq r = show p @ '' + '' @ show q @ '' = '' @ show pq @ '' not equal'' @ show r\ + + +definition check_not_equal_dom_err :: \llist_polynomial \ llist_polynomial \ llist_polynomial \ llist_polynomial \ string nres\ where + \check_not_equal_dom_err p q pq r = SPEC (\_. True)\ + + +definition vars_llist :: \llist_polynomial \ string set\ where +\vars_llist xs = \(set ` fst ` set xs)\ + + +definition check_addition_l :: \_ \ _ \ string set \ nat \ nat \ nat \ llist_polynomial \ string code_status nres\ where +\check_addition_l spec A \ p q i r = do { + let b = p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars_llist r \ \; + if \b + then RETURN (error_msg i ((if p \# dom_m A then error_msg_notin_dom p else []) @ (if q \# dom_m A then error_msg_notin_dom p else []) @ + (if i \# dom_m A then error_msg_reused_dom p else []))) + else do { + ASSERT (p \# dom_m A); + let p = the (fmlookup A p); + ASSERT (q \# dom_m A); + let q = the (fmlookup A q); + pq \ add_poly_l (p, q); + b \ weak_equality_l pq r; + b' \ weak_equality_l r spec; + if b then (if b' then RETURN CFOUND else RETURN CSUCCESS) + else do { + c \ check_not_equal_dom_err p q pq r; + RETURN (error_msg i c)} + } +}\ + + +paragraph \Multiplication checking\ + +definition check_mult_l_dom_err :: \bool \ nat \ bool \ nat \ string nres\ where + \check_mult_l_dom_err p_notin p i_already i = SPEC (\_. True)\ + + +definition check_mult_l_mult_err :: \llist_polynomial \ llist_polynomial \ llist_polynomial \ llist_polynomial \ string nres\ where + \check_mult_l_mult_err p q pq r = SPEC (\_. True)\ + + +definition check_mult_l :: \_ \ _ \ _ \ nat \llist_polynomial \ nat \ llist_polynomial \ string code_status nres\ where +\check_mult_l spec A \ p q i r = do { + let b = p \# dom_m A \ i \# dom_m A \ vars_llist q \ \\ vars_llist r \ \; + if \b + then do { + c \ check_mult_l_dom_err (p \# dom_m A) p (i \# dom_m A) i; + RETURN (error_msg i c)} + else do { + ASSERT (p \# dom_m A); + let p = the (fmlookup A p); + pq \ mult_poly_full p q; + b \ weak_equality_l pq r; + b' \ weak_equality_l r spec; + if b then (if b' then RETURN CFOUND else RETURN CSUCCESS) else do { + c \ check_mult_l_mult_err p q pq r; + RETURN (error_msg i c) + } + } + }\ + + +paragraph \Deletion checking\ + +definition check_del_l :: \_ \ _ \ nat \ string code_status nres\ where +\check_del_l spec A p = RETURN CSUCCESS\ + + +paragraph \Extension checking\ + +definition check_extension_l_dom_err :: \nat \ string nres\ where + \check_extension_l_dom_err p = SPEC (\_. True)\ + + +definition check_extension_l_no_new_var_err :: \llist_polynomial \ string nres\ where + \check_extension_l_no_new_var_err p = SPEC (\_. True)\ + +definition check_extension_l_new_var_multiple_err :: \string \ llist_polynomial \ string nres\ where + \check_extension_l_new_var_multiple_err v p = SPEC (\_. True)\ + +definition check_extension_l_side_cond_err + :: \string \ llist_polynomial \ llist_polynomial \ llist_polynomial \ string nres\ +where + \check_extension_l_side_cond_err v p p' q = SPEC (\_. True)\ + +definition check_extension_l + :: \_ \ _ \ string set \ nat \ string \ llist_polynomial \ (string code_status) nres\ +where +\check_extension_l spec A \ i v p = do { + let b = i \# dom_m A \ v \ \ \ ([v], -1) \ set p; + if \b + then do { + c \ check_extension_l_dom_err i; + RETURN (error_msg i c) + } else do { + let p' = remove1 ([v], -1) p; + let b = vars_llist p' \ \; + if \b + then do { + c \ check_extension_l_new_var_multiple_err v p'; + RETURN (error_msg i c) + } + else do { + p2 \ mult_poly_full p' p'; + let p' = map (\(a,b). (a, -b)) p'; + q \ add_poly_l (p2, p'); + eq \ weak_equality_l q []; + if eq then do { + RETURN (CSUCCESS) + } else do { + c \ check_extension_l_side_cond_err v p p' q; + RETURN (error_msg i c) + } + } + } + }\ + + +lemma check_extension_alt_def: + \check_extension A \ i v p \ do { + b \ SPEC(\b. b \ i \# dom_m A \ v \ \); + if \b + then RETURN (False) + else do { + p' \ RETURN (p + Var v); + b \ SPEC(\b. b \ vars p' \ \); + if \b + then RETURN (False) + else do { + pq \ mult_poly_spec p' p'; + let p' = - p'; + p \ add_poly_spec pq p'; + eq \ weak_equality p 0; + if eq then RETURN(True) + else RETURN (False) + } + } + }\ +proof - + have [intro]: \ab \ \ \ + vars ba \ \ \ + MPoly_Type.coeff (ba + Var ab) (monomial (Suc 0) ab) = 1\ for ab ba + by (subst coeff_add[symmetric], subst not_in_vars_coeff0) + (auto simp flip: coeff_add monom.abs_eq + simp: not_in_vars_coeff0 MPoly_Type.coeff_def + Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq) + have [simp]: \MPoly_Type.coeff p (monomial (Suc 0) ab) = -1\ + if \vars (p + Var ab) \ \\ + \ab \ \\ + for ab + proof - + define q where \q \ p + Var ab\ + then have p: \p = q - Var ab\ + by auto + show ?thesis + unfolding p + apply (subst coeff_minus[symmetric], subst not_in_vars_coeff0) + using that unfolding q_def[symmetric] + by (auto simp flip: coeff_minus simp: not_in_vars_coeff0 + Var.abs_eq Var\<^sub>0_def simp flip: monom.abs_eq + simp: not_in_vars_coeff0 MPoly_Type.coeff_def + Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq) + qed + have [simp]: \vars (p - Var ab) = vars (Var ab - p)\ for ab + using vars_uminus[of \p - Var ab\] + by simp + show ?thesis + unfolding check_extension_def + apply (auto 5 5 simp: check_extension_def weak_equality_def + mult_poly_spec_def field_simps + add_poly_spec_def power2_eq_square cong: if_cong + intro!: intro_spec_refine[where R=Id, simplified] + split: option.splits dest: ideal.span_add) + done +qed + +(* Copy of WB_More_Refinement *) +lemma RES_RES_RETURN_RES: \RES A \ (\T. RES (f T)) = RES (\(f ` A))\ + by (auto simp: pw_eq_iff refine_pw_simps) + + +lemma check_add_alt_def: + \check_add A \ p q i r \ + do { + b \ SPEC(\b. b \ p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars r \ \); + if \b + then RETURN False + else do { + ASSERT (p \# dom_m A); + let p = the (fmlookup A p); + ASSERT (q \# dom_m A); + let q = the (fmlookup A q); + pq \ add_poly_spec p q; + eq \ weak_equality pq r; + RETURN eq + } + }\ (is \_ \ ?A\) +proof - + have check_add_alt_def: \check_add A \ p q i r = do { + b \ SPEC(\b. b \ p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars r \ \); + if \b then SPEC(\b. b \ p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars r \ \ \ + the (fmlookup A p) + the (fmlookup A q) - r \ ideal polynomial_bool) + else + SPEC(\b. b \ p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars r \ \ \ + the (fmlookup A p) + the (fmlookup A q) - r \ ideal polynomial_bool)}\ + (is \_ = ?B\) + by (auto simp: check_add_def RES_RES_RETURN_RES) + have \?A \ \ Id (check_add A \ p q i r)\ + apply refine_vcg + apply ((auto simp: check_add_alt_def weak_equality_def + add_poly_spec_def RES_RES_RETURN_RES summarize_ASSERT_conv + cong: if_cong + intro!: ideal.span_zero;fail)+) + done + then show ?thesis + unfolding check_add_alt_def[symmetric] + by simp +qed + +lemma check_mult_alt_def: + \check_mult A \ p q i r \ + do { + b \ SPEC(\b. b \ p \# dom_m A \ i \# dom_m A \ vars q \ \ \ vars r \ \); + if \b + then RETURN False + else do { + ASSERT (p \# dom_m A); + let p = the (fmlookup A p); + pq \ mult_poly_spec p q; + p \ weak_equality pq r; + RETURN p + } + }\ + unfolding check_mult_def + apply (rule refine_IdD) + by refine_vcg + (auto simp: check_mult_def weak_equality_def + mult_poly_spec_def RES_RES_RETURN_RES + intro!: ideal.span_zero + exI[of _ \the (fmlookup A p) * q\]) + +primrec insort_key_rel :: "('b \ 'b \ bool) \ 'b \ 'b list \ 'b list" where +"insort_key_rel f x [] = [x]" | +"insort_key_rel f x (y#ys) = + (if f x y then (x#y#ys) else y#(insort_key_rel f x ys))" + +lemma set_insort_key_rel[simp]: \set (insort_key_rel R x xs) = insert x (set xs)\ + by (induction xs) + auto + +lemma sorted_wrt_insort_key_rel: + \total_on R (insert x (set xs)) \ transp R \ reflp R \ + sorted_wrt R xs \ sorted_wrt R (insort_key_rel R x xs)\ + by (induction xs) + (auto dest: transpD reflpD simp: Restricted_Predicates.total_on_def) + +lemma sorted_wrt_insort_key_rel2: + \total_on R (insert x (set xs)) \ transp R \ x \ set xs \ + sorted_wrt R xs \ sorted_wrt R (insort_key_rel R x xs)\ + by (induction xs) + (auto dest: transpD simp: Restricted_Predicates.total_on_def in_mono) + + +paragraph \Step checking\ + +definition PAC_checker_l_step :: \_ \ string code_status \ string set \ _ \ (llist_polynomial, string, nat) pac_step \ _\ where + \PAC_checker_l_step = (\spec (st', \, A) st. case st of + Add _ _ _ _ \ + do { + r \ full_normalize_poly (pac_res st); + eq \ check_addition_l spec A \ (pac_src1 st) (pac_src2 st) (new_id st) r; + let _ = eq; + if \is_cfailed eq + then RETURN (merge_cstatus st' eq, + \, fmupd (new_id st) r A) + else RETURN (eq, \, A) + } + | Del _ \ + do { + eq \ check_del_l spec A (pac_src1 st); + let _ = eq; + if \is_cfailed eq + then RETURN (merge_cstatus st' eq, \, fmdrop (pac_src1 st) A) + else RETURN (eq, \, A) + } + | Mult _ _ _ _ \ + do { + r \ full_normalize_poly (pac_res st); + q \ full_normalize_poly (pac_mult st); + eq \ check_mult_l spec A \ (pac_src1 st) q (new_id st) r; + let _ = eq; + if \is_cfailed eq + then RETURN (merge_cstatus st' eq, + \, fmupd (new_id st) r A) + else RETURN (eq, \, A) + } + | Extension _ _ _ \ + do { + r \ full_normalize_poly (([new_var st], -1) # (pac_res st)); + (eq) \ check_extension_l spec A \ (new_id st) (new_var st) r; + if \is_cfailed eq + then do { + RETURN (st', + insert (new_var st) \, fmupd (new_id st) r A)} + else RETURN (eq, \, A) + } + )\ + +lemma pac_step_rel_raw_def: + \\K, V, R\ pac_step_rel_raw = pac_step_rel_raw K V R\ + by (auto intro!: ext simp: relAPP_def) + +definition mononoms_equal_up_to_reorder where + \mononoms_equal_up_to_reorder xs ys \ + map (\(a, b). (mset a, b)) xs = map (\(a, b). (mset a, b)) ys\ + + + definition normalize_poly_l where + \normalize_poly_l p = SPEC (\p'. + normalize_poly_p\<^sup>*\<^sup>* ((\(a, b). (mset a, b)) `# mset p) ((\(a, b). (mset a, b)) `# mset p') \ + 0 \# snd `# mset p' \ + sorted_wrt (rel2p (term_order_rel \\<^sub>r int_rel)) p' \ + (\ x \ mononoms p'. sorted_wrt (rel2p var_order_rel) x))\ + + +definition remap_polys_l_dom_err :: \string nres\ where + \remap_polys_l_dom_err = SPEC (\_. True)\ + + +definition remap_polys_l :: \llist_polynomial \ string set \ (nat, llist_polynomial) fmap \ + (_ code_status \ string set \ (nat, llist_polynomial) fmap) nres\ where + \remap_polys_l spec = (\\ A. do{ + dom \ SPEC(\dom. set_mset (dom_m A) \ dom \ finite dom); + failed \ SPEC(\_::bool. True); + if failed + then do { + c \ remap_polys_l_dom_err; + RETURN (error_msg (0 :: nat) c, \, fmempty) + } + else do { + (b, \, A) \ FOREACH dom + (\i (b, \, A'). + if i \# dom_m A + then do { + p \ full_normalize_poly (the (fmlookup A i)); + eq \ weak_equality_l p spec; + \ \ RETURN(\ \ vars_llist (the (fmlookup A i))); + RETURN(b \ eq, \, fmupd i p A') + } else RETURN (b, \, A')) + (False, \, fmempty); + RETURN (if b then CFOUND else CSUCCESS, \, A) + }})\ + +definition PAC_checker_l where + \PAC_checker_l spec A b st = do { + (S, _) \ WHILE\<^sub>T + (\((b, A), n). \is_cfailed b \ n \ []) + (\((bA), n). do { + ASSERT(n \ []); + S \ PAC_checker_l_step spec bA (hd n); + RETURN (S, tl n) + }) + ((b, A), st); + RETURN S + }\ + + +subsection \Correctness\ + +text \We now enter the locale to reason about polynomials directly.\ + +context poly_embed +begin + +abbreviation pac_step_rel where + \pac_step_rel \ p2rel (\Id, fully_unsorted_poly_rel O mset_poly_rel, var_rel\ pac_step_rel_raw)\ + +abbreviation fmap_polys_rel where + \fmap_polys_rel \ \nat_rel, sorted_poly_rel O mset_poly_rel\fmap_rel\ + +lemma + \normalize_poly_p s0 s \ + (s0, p) \ mset_poly_rel \ + (s, p) \ mset_poly_rel\ + by (auto simp: mset_poly_rel_def normalize_poly_p_poly_of_mset) + +lemma vars_poly_of_vars: + \vars (poly_of_vars a :: int mpoly) \ (\ ` set_mset a)\ + by (induction a) + (auto simp: vars_mult_Var) + +lemma vars_polynomial_of_mset: + \vars (polynomial_of_mset za) \ \(image \ ` (set_mset o fst) ` set_mset za)\ + apply (induction za) + using vars_poly_of_vars + by (fastforce elim!: in_vars_addE simp: vars_mult_Const split: if_splits)+ + +lemma fully_unsorted_poly_rel_vars_subset_vars_llist: + \(A, B) \ fully_unsorted_poly_rel O mset_poly_rel \ vars B \ \ ` vars_llist A\ + by (auto simp: fully_unsorted_poly_list_rel_def mset_poly_rel_def + set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1 + list_rel_split_right_iff list_mset_rel_def image_iff + unsorted_term_poly_list_rel_def list_rel_split_left_iff + dest!: set_rev_mp[OF _ vars_polynomial_of_mset] split_list + dest: multi_member_split + dest: arg_cong[of \mset _\ \add_mset _ _\ set_mset]) + +lemma fully_unsorted_poly_rel_extend_vars: + \(A, B) \ fully_unsorted_poly_rel O mset_poly_rel \ + (x1c, x1a) \ \var_rel\set_rel \ + RETURN (x1c \ vars_llist A) + \ \ (\var_rel\set_rel) + (SPEC ((\) (x1a \ vars (B))))\ + using fully_unsorted_poly_rel_vars_subset_vars_llist[of A B] + apply (subst RETURN_RES_refine_iff) + apply clarsimp + apply (rule exI[of _ \x1a \ \ ` vars_llist A\]) + apply (auto simp: set_rel_def var_rel_def br_def + dest: fully_unsorted_poly_rel_vars_subset_vars_llist) + done + +lemma remap_polys_l_remap_polys: + assumes + AB: \(A, B) \ \nat_rel, fully_unsorted_poly_rel O mset_poly_rel\fmap_rel\ and + spec: \(spec, spec') \ sorted_poly_rel O mset_poly_rel\ and + V: \(\, \') \ \var_rel\set_rel\ + shows \remap_polys_l spec \ A \ + \(code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) (remap_polys spec' \' B)\ + (is \_ \ \ ?R _\) +proof - + have 1: \inj_on id (dom :: nat set)\ for dom + by auto + have H: \x \# dom_m A \ + (\p. (the (fmlookup A x), p) \ fully_unsorted_poly_rel \ + (p, the (fmlookup B x)) \ mset_poly_rel \ thesis) \ + thesis\ for x thesis + using fmap_rel_nat_the_fmlookup[OF AB, of x x] fmap_rel_nat_rel_dom_m[OF AB] by auto + have full_normalize_poly: \full_normalize_poly (the (fmlookup A x)) + \ \ (sorted_poly_rel O mset_poly_rel) + (SPEC + (\p. the (fmlookup B x') - p \ More_Modules.ideal polynomial_bool \ + vars p \ vars (the (fmlookup B x'))))\ + if x_dom: \x \# dom_m A\ and \(x, x') \ Id\ for x x' + apply (rule H[OF x_dom]) + subgoal for p + apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans]) + apply assumption + subgoal + using that(2) apply - + unfolding conc_fun_chain[symmetric] + by (rule ref_two_step', rule RES_refine) + (auto simp: rtranclp_normalize_poly_p_poly_of_mset + mset_poly_rel_def ideal.span_zero) + done + done + + have H': \(p, pa) \ sorted_poly_rel O mset_poly_rel \ + weak_equality_l p spec \ SPEC (\eqa. eqa \ pa = spec')\ for p pa + using spec by (auto simp: weak_equality_l_def weak_equality_spec_def + list_mset_rel_def br_def mset_poly_rel_def + dest: list_rel_term_poly_list_rel_same_rightD sorted_poly_list_relD) + + have emp: \(\, \') \ \var_rel\set_rel \ + ((False, \, fmempty), False, \', fmempty) \ bool_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel\ for \ \' + by auto + show ?thesis + using assms + unfolding remap_polys_l_def remap_polys_l_dom_err_def + remap_polys_def prod.case + apply (refine_rcg full_normalize_poly fmap_rel_fmupd_fmap_rel) + subgoal + by auto + subgoal + by auto + subgoal + by (auto simp: error_msg_def) + apply (rule 1) + subgoal by auto + apply (rule emp) + subgoal + using V by auto + subgoal by auto + subgoal by auto + subgoal by (rule H') + apply (rule fully_unsorted_poly_rel_extend_vars) + subgoal by (auto intro!: fmap_rel_nat_the_fmlookup) + subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel) + subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel) + subgoal by auto + subgoal by auto + done +qed + + +lemma fref_to_Down_curry: + \(uncurry f, uncurry g) \ [P]\<^sub>f A \ \B\nres_rel \ + (\x x' y y'. P (x', y') \ ((x, y), (x', y')) \ A \ f x y \ \ B (g x' y'))\ + unfolding fref_def uncurry_def nres_rel_def + by auto + +lemma weak_equality_spec_weak_equality: + \(p, p') \ mset_poly_rel \ + (r, r') \ mset_poly_rel \ + weak_equality_spec p r \ weak_equality p' r'\ + unfolding weak_equality_spec_def weak_equality_def + by (auto simp: mset_poly_rel_def) + + +lemma weak_equality_l_weak_equality_l'[refine]: + \weak_equality_l p q \ \ bool_rel (weak_equality p' q')\ + if \(p, p') \ sorted_poly_rel O mset_poly_rel\ + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + for p p' q q' + using that + by (auto intro!: weak_equality_l_weak_equality_spec[THEN fref_to_Down_curry, THEN order_trans] + ref_two_step' + weak_equality_spec_weak_equality + simp flip: conc_fun_chain) + +lemma error_msg_ne_SUCCES[iff]: + \error_msg i m \ CSUCCESS\ + \error_msg i m \ CFOUND\ + \is_cfailed (error_msg i m)\ + \\is_cfound (error_msg i m)\ + by (auto simp: error_msg_def) + +lemma sorted_poly_rel_vars_llist: + \(r, r') \ sorted_poly_rel O mset_poly_rel \ + vars r' \ \ ` vars_llist r\ + apply (auto simp: mset_poly_rel_def + set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1 + list_rel_split_right_iff list_mset_rel_def image_iff sorted_poly_list_rel_wrt_def + dest!: set_rev_mp[OF _ vars_polynomial_of_mset] + dest!: split_list) + apply (auto dest!: multi_member_split simp: list_rel_append1 + term_poly_list_rel_def eq_commute[of _ \mset _\] + list_rel_split_right_iff list_rel_append2 list_rel_split_left_iff + dest: arg_cong[of \mset _\ \add_mset _ _\ set_mset]) + done + + +lemma check_addition_l_check_add: + assumes \(A, B) \ fmap_polys_rel\ and \(r, r') \ sorted_poly_rel O mset_poly_rel\ + \(p, p') \ Id\ \(q, q') \ Id\ \(i, i') \ nat_rel\ + \(\', \) \ \var_rel\set_rel\ + shows + \check_addition_l spec A \' p q i r \ \ {(st, b). (\is_cfailed st \ b) \ + (is_cfound st \ spec = r)} (check_add B \ p' q' i' r')\ +proof - + have [refine]: + \add_poly_l (p, q) \ \ (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\ + if \(p, p') \ sorted_poly_rel O mset_poly_rel\ + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + for p p' q q' + using that + by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step' + add_poly_p'_add_poly_spec + simp flip: conc_fun_chain) + + show ?thesis + using assms + unfolding check_addition_l_def + check_not_equal_dom_err_def apply - + apply (rule order_trans) + defer + apply (rule ref_two_step') + apply (rule check_add_alt_def) + apply refine_rcg + subgoal + by (drule sorted_poly_rel_vars_llist) + (auto simp: set_rel_def var_rel_def br_def) + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by (auto simp: weak_equality_l_def bind_RES_RETURN_eq) + done +qed + +lemma check_del_l_check_del: + \(A, B) \ fmap_polys_rel \ (x3, x3a) \ Id \ check_del_l spec A (pac_src1 (Del x3)) + \ \ {(st, b). (\is_cfailed st \ b) \ (b \ st = CSUCCESS)} (check_del B (pac_src1 (Del x3a)))\ + unfolding check_del_l_def check_del_def + by (refine_vcg lhs_step_If RETURN_SPEC_refine) + (auto simp: fmap_rel_nat_rel_dom_m bind_RES_RETURN_eq) + +lemma check_mult_l_check_mult: + assumes \(A, B) \ fmap_polys_rel\ and \(r, r') \ sorted_poly_rel O mset_poly_rel\ and + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + \(p, p') \ Id\ \(i, i') \ nat_rel\ \(\, \') \ \var_rel\set_rel\ + shows + \check_mult_l spec A \ p q i r \ \ {(st, b). (\is_cfailed st \ b) \ + (is_cfound st \ spec = r)} (check_mult B \' p' q' i' r')\ +proof - + have [refine]: + \mult_poly_full p q \ \ (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\ + if \(p, p') \ sorted_poly_rel O mset_poly_rel\ + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + for p p' q q' + using that + by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step' + mult_poly_p'_mult_poly_spec + simp flip: conc_fun_chain) + + show ?thesis + using assms + unfolding check_mult_l_def + check_mult_l_mult_err_def check_mult_l_dom_err_def apply - + apply (rule order_trans) + defer + apply (rule ref_two_step') + apply (rule check_mult_alt_def) + apply refine_rcg + subgoal + by (drule sorted_poly_rel_vars_llist)+ + (fastforce simp: set_rel_def var_rel_def br_def) + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by auto + subgoal + by (auto simp: weak_equality_l_def bind_RES_RETURN_eq) + done +qed + + +lemma normalize_poly_normalize_poly_spec: + assumes \(r, t) \ unsorted_poly_rel O mset_poly_rel\ + shows + \normalize_poly r \ \(sorted_poly_rel O mset_poly_rel) (normalize_poly_spec t)\ +proof - + obtain s where + rs: \(r, s) \ unsorted_poly_rel\ and + st: \(s, t) \ mset_poly_rel\ + using assms by auto + show ?thesis + by (rule normalize_poly_normalize_poly_p[THEN order_trans, OF rs]) + (use st in \auto dest!: rtranclp_normalize_poly_p_poly_of_mset + intro!: ref_two_step' RES_refine exI[of _ t] + simp: normalize_poly_spec_def ideal.span_zero mset_poly_rel_def + simp flip: conc_fun_chain\) +qed + +lemma remove1_list_rel: + \(xs, ys) \ \R\ list_rel \ + (a, b) \ R \ + IS_RIGHT_UNIQUE R \ + IS_LEFT_UNIQUE R \ + (remove1 a xs, remove1 b ys) \ \R\list_rel\ + by (induction xs ys rule: list_rel_induct) + (auto simp: single_valued_def IS_LEFT_UNIQUE_def) + +lemma remove1_list_rel2: + \(xs, ys) \ \R\ list_rel \ + (a, b) \ R \ + (\c. (a, c) \ R \ c = b) \ + (\c. (c, b) \ R \ c = a) \ + (remove1 a xs, remove1 b ys) \ \R\list_rel\ + apply (induction xs ys rule: list_rel_induct) + apply (solves \simp (no_asm)\) + by (smt list_rel_simp(4) remove1.simps(2)) + +lemma remove1_sorted_poly_rel_mset_poly_rel: + assumes + \(r, r') \ sorted_poly_rel O mset_poly_rel\ and + \([a], 1) \ set r\ + shows + \(remove1 ([a], 1) r, r' - Var (\ a)) + \ sorted_poly_rel O mset_poly_rel\ +proof - + have [simp]: \([a], {#a#}) \ term_poly_list_rel\ + \\aa. ([a], aa) \ term_poly_list_rel \ aa = {#a#}\ + by (auto simp: term_poly_list_rel_def) + have H: + \\aa. ([a], aa) \ term_poly_list_rel \ aa = {#a#}\ + \\aa. (aa, {#a#}) \ term_poly_list_rel \ aa = [a]\ + by (auto simp: single_valued_def IS_LEFT_UNIQUE_def + term_poly_list_rel_def) + + have [simp]: \Const (1 :: int) = (1 :: int mpoly)\ + by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq) + have [simp]: \sorted_wrt term_order (map fst r) \ + sorted_wrt term_order (map fst (remove1 ([a], 1) r))\ + by (induction r) auto + have [intro]: \distinct (map fst r) \ distinct (map fst (remove1 x r))\ for x + by (induction r) (auto dest: in_set_remove1D) + have [simp]: \(r, ya) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + polynomial_of_mset (mset ya) - Var (\ a) = + polynomial_of_mset (remove1_mset ({#a#}, 1) (mset ya))\ for ya + using assms + by (auto simp: list_rel_append1 list_rel_split_right_iff + dest!: split_list) + + show ?thesis + using assms + apply (elim relcompEpair) + apply (rename_tac za, rule_tac b = \remove1_mset ({#a#}, 1) za\ in relcompI) + apply (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp' + intro!: relcompI[of _ \remove1 ({#a#}, 1) ya\ + for ya :: \(string multiset \ int) list\] remove1_list_rel2 intro: H + simp: list_mset_rel_def br_def + dest: in_diffD) + done +qed + +lemma remove1_sorted_poly_rel_mset_poly_rel_minus: + assumes + \(r, r') \ sorted_poly_rel O mset_poly_rel\ and + \([a], -1) \ set r\ + shows + \(remove1 ([a], -1) r, r' + Var (\ a)) + \ sorted_poly_rel O mset_poly_rel\ +proof - + have [simp]: \([a], {#a#}) \ term_poly_list_rel\ + \\aa. ([a], aa) \ term_poly_list_rel \ aa = {#a#}\ + by (auto simp: term_poly_list_rel_def) + have H: + \\aa. ([a], aa) \ term_poly_list_rel \ aa = {#a#}\ + \\aa. (aa, {#a#}) \ term_poly_list_rel \ aa = [a]\ + by (auto simp: single_valued_def IS_LEFT_UNIQUE_def + term_poly_list_rel_def) + + have [simp]: \Const (1 :: int) = (1 :: int mpoly)\ + by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq) + have [simp]: \sorted_wrt term_order (map fst r) \ + sorted_wrt term_order (map fst (remove1 ([a], -1) r))\ + by (induction r) auto + have [intro]: \distinct (map fst r) \ distinct (map fst (remove1 x r))\ for x + apply (induction r) apply auto + by (meson img_fst in_set_remove1D) + have [simp]: \(r, ya) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + polynomial_of_mset (mset ya) + Var (\ a) = + polynomial_of_mset (remove1_mset ({#a#}, -1) (mset ya))\ for ya + using assms + by (auto simp: list_rel_append1 list_rel_split_right_iff + dest!: split_list) + + show ?thesis + using assms + apply (elim relcompEpair) + apply (rename_tac za, rule_tac b = \remove1_mset ({#a#}, -1) za\ in relcompI) + by (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp' + dest: in_diffD + intro!: relcompI[of _ \remove1 ({#a#}, -1) ya\ + for ya :: \(string multiset \ int) list\] remove1_list_rel2 intro: H + simp: list_mset_rel_def br_def) +qed + + +lemma insert_var_rel_set_rel: + \(\, \') \ \var_rel\set_rel \ + (yb, x2) \ var_rel \ + (insert yb \, insert x2 \') \ \var_rel\set_rel\ + by (auto simp: var_rel_def set_rel_def) + +lemma var_rel_set_rel_iff: + \(\, \') \ \var_rel\set_rel \ + (yb, x2) \ var_rel \ + yb \ \ \ x2 \ \'\ + using \_inj inj_eq by (fastforce simp: var_rel_def set_rel_def br_def) + + +lemma check_extension_l_check_extension: + assumes \(A, B) \ fmap_polys_rel\ and \(r, r') \ sorted_poly_rel O mset_poly_rel\ and + \(i, i') \ nat_rel\ \(\, \') \ \var_rel\set_rel\ \(x, x') \ var_rel\ + shows + \check_extension_l spec A \ i x r \ + \{((st), (b)). + (\is_cfailed st \ b) \ + (is_cfound st \ spec = r)} (check_extension B \' i' x' r')\ +proof - + have \x' = \ x\ + using assms(5) by (auto simp: var_rel_def br_def) + have [refine]: + \mult_poly_full p q \ \ (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\ + if \(p, p') \ sorted_poly_rel O mset_poly_rel\ + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + for p p' q q' + using that + by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step' + mult_poly_p'_mult_poly_spec + simp flip: conc_fun_chain) + have [refine]: + \add_poly_l (p, q) \ \ (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\ + if \(p, p') \ sorted_poly_rel O mset_poly_rel\ + \(q, q') \ sorted_poly_rel O mset_poly_rel\ + for p p' q q' + using that + by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step' + add_poly_p'_add_poly_spec + simp flip: conc_fun_chain) + + have [simp]: \(l, l') \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + (map (\(a, b). (a, - b)) l, map (\(a, b). (a, - b)) l') + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ for l l' + by (induction l l' rule: list_rel_induct) + (auto simp: list_mset_rel_def br_def) + + have [intro!]: + \(x2c, za) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel O list_mset_rel \ + (map (\(a, b). (a, - b)) x2c, + {#case x of (a, b) \ (a, - b). x \# za#}) + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel O list_mset_rel\ for x2c za + apply (auto) + subgoal for y + apply (induction x2c y rule: list_rel_induct) + apply (auto simp: list_mset_rel_def br_def) + apply (rule_tac b = \(aa, - ba) # map (\(a, b). (a, - b)) l'\ in relcompI) + by auto + done + have [simp]: \(\x. fst (case x of (a, b) \ (a, - b))) = fst\ + by (auto intro: ext) + + have uminus: \(x2c, x2a) \ sorted_poly_rel O mset_poly_rel \ + (map (\(a, b). (a, - b)) x2c, + - x2a) + \ sorted_poly_rel O mset_poly_rel\ for x2c x2a x1c x1a + apply (clarsimp simp: sorted_poly_list_rel_wrt_def + mset_poly_rel_def) + apply (rule_tac b = \(\(a, b). (a, - b)) `# za\ in relcompI) + by (auto simp: sorted_poly_list_rel_wrt_def + mset_poly_rel_def comp_def polynomial_of_mset_uminus) + have [simp]: \([], 0) \ sorted_poly_rel O mset_poly_rel\ + by (auto simp: sorted_poly_list_rel_wrt_def + mset_poly_rel_def list_mset_rel_def br_def + intro!: relcompI[of _ \{#}\]) + show ?thesis + unfolding check_extension_l_def + check_extension_l_dom_err_def + check_extension_l_no_new_var_err_def + check_extension_l_new_var_multiple_err_def + check_extension_l_side_cond_err_def + apply (rule order_trans) + defer + apply (rule ref_two_step') + apply (rule check_extension_alt_def) + apply (refine_vcg ) + subgoal using assms(1,3,4,5) + by (auto simp: var_rel_set_rel_iff) + subgoal using assms(1,3,4,5) + by (auto simp: var_rel_set_rel_iff) + subgoal by auto + subgoal by auto + apply (subst \x' = \ x\, rule remove1_sorted_poly_rel_mset_poly_rel_minus) + subgoal using assms by auto + subgoal using assms by auto + subgoal using sorted_poly_rel_vars_llist[of \r\ \r'\] assms + by (force simp: set_rel_def var_rel_def br_def + dest!: sorted_poly_rel_vars_llist) + subgoal by auto + subgoal by auto + subgoal using assms by auto + apply (rule uminus) + subgoal using assms by auto + subgoal using assms by auto + subgoal using assms by auto + subgoal using assms by auto + subgoal using assms by auto + done +qed + + +lemma full_normalize_poly_diff_ideal: + fixes dom + assumes \(p, p') \ fully_unsorted_poly_rel O mset_poly_rel\ + shows + \full_normalize_poly p + \ \ (sorted_poly_rel O mset_poly_rel) + (normalize_poly_spec p')\ +proof - + obtain q where + pq: \(p, q) \ fully_unsorted_poly_rel\ and qp':\(q, p') \ mset_poly_rel\ + using assms by auto + show ?thesis + unfolding normalize_poly_spec_def + apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans]) + apply (rule pq) + unfolding conc_fun_chain[symmetric] + by (rule ref_two_step', rule RES_refine) + (use qp' in \auto dest!: rtranclp_normalize_poly_p_poly_of_mset + simp: mset_poly_rel_def ideal.span_zero\) +qed + +lemma insort_key_rel_decomp: + \\ys zs. xs = ys @ zs \ insort_key_rel R x xs = ys @ x # zs\ + apply (induction xs) + subgoal by auto + subgoal for a xs + by (force intro: exI[of _ \a # _\]) + done + +lemma list_rel_append_same_length: + \length xs = length xs' \ (xs @ ys, xs' @ ys') \ \R\list_rel \ (xs, xs') \ \R\list_rel \ (ys, ys') \ \R\list_rel\ + by (auto simp: list_rel_def list_all2_append2 dest: list_all2_lengthD) + +lemma term_poly_list_rel_list_relD: \(ys, cs) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + cs = map (\(a, y). (mset a, y)) ys\ + by (induction ys arbitrary: cs) + (auto simp: term_poly_list_rel_def list_rel_def list_all2_append list_all2_Cons1 list_all2_Cons2) + +lemma term_poly_list_rel_single: \([x32], {#x32#}) \ term_poly_list_rel\ + by (auto simp: term_poly_list_rel_def) + +lemma unsorted_poly_rel_list_rel_list_rel_uminus: + \(map (\(a, b). (a, - b)) r, yc) + \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + (r, map (\(a, b). (a, - b)) yc) + \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel\ + by (induction r arbitrary: yc) + (auto simp: elim!: list_relE3) + +lemma mset_poly_rel_minus: \({#(a, b)#}, v') \ mset_poly_rel \ + (mset yc, r') \ mset_poly_rel \ + (r, yc) + \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + (add_mset (a, b) (mset yc), + v' + r') + \ mset_poly_rel\ + by (induction r arbitrary: r') + (auto simp: mset_poly_rel_def polynomial_of_mset_uminus) + +lemma fully_unsorted_poly_rel_diff: + \([v], v') \ fully_unsorted_poly_rel O mset_poly_rel \ + (r, r') \ fully_unsorted_poly_rel O mset_poly_rel \ + (v # r, + v' + r') + \ fully_unsorted_poly_rel O mset_poly_rel\ + apply auto + apply (rule_tac b = \y + ya\ in relcompI) + apply (auto simp: fully_unsorted_poly_list_rel_def list_mset_rel_def br_def) + apply (rule_tac b = \yb @ yc\ in relcompI) + apply (auto elim!: list_relE3 simp: unsorted_poly_rel_list_rel_list_rel_uminus mset_poly_rel_minus) + done + +lemma PAC_checker_l_step_PAC_checker_step: + assumes + \(Ast, Bst) \ code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel\ and + \(st, st') \ pac_step_rel\ and + spec: \(spec, spec') \ sorted_poly_rel O mset_poly_rel\ + shows + \PAC_checker_l_step spec Ast st \ \ (code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) (PAC_checker_step spec' Bst st')\ +proof - + obtain A \ cst B \' cst' where + Ast: \Ast = (cst, \, A)\ and + Bst: \Bst = (cst', \', B)\ and + \[intro]: \(\, \') \ \var_rel\set_rel\ and + AB: \(A, B) \ fmap_polys_rel\ + \(cst, cst') \ code_status_status_rel\ + using assms(1) + by (cases Ast; cases Bst; auto) + have [refine]: \(r, ra) \ sorted_poly_rel O mset_poly_rel \ + (eqa, eqaa) + \ {(st, b). (\ is_cfailed st \ b) \ (is_cfound st \ spec = r)} \ + RETURN eqa + \ \ code_status_status_rel + (SPEC + (\st'. (\ is_failed st' \ + is_found st' \ + ra - spec' \ More_Modules.ideal polynomial_bool)))\ + for r ra eqa eqaa + using spec + by (cases eqa) + (auto intro!: RETURN_RES_refine dest!: sorted_poly_list_relD + simp: mset_poly_rel_def ideal.span_zero) + have [simp]: \(eqa, st'a) \ code_status_status_rel \ + (merge_cstatus cst eqa, merge_status cst' st'a) + \ code_status_status_rel\ for eqa st'a + using AB + by (cases eqa; cases st'a) + (auto simp: code_status_status_rel_def) + have [simp]: \(merge_cstatus cst CSUCCESS, cst') \ code_status_status_rel\ + using AB + by (cases st) + (auto simp: code_status_status_rel_def) + have [simp]: \(x32, x32a) \ var_rel \ + ([([x32], -1::int)], -Var x32a) \ fully_unsorted_poly_rel O mset_poly_rel\ for x32 x32a + by (auto simp: mset_poly_rel_def fully_unsorted_poly_list_rel_def list_mset_rel_def br_def + unsorted_term_poly_list_rel_def var_rel_def Const_1_eq_1 + intro!: relcompI[of _ \{#({#x32#}, -1 :: int)#}\] + relcompI[of _ \[({#x32#}, -1)]\]) + have H3: \p - Var a = (-Var a) + p\ for p :: \int mpoly\ and a + by auto + show ?thesis + using assms(2) + unfolding PAC_checker_l_step_def PAC_checker_step_def Ast Bst prod.case + apply (cases st; cases st'; simp only: p2rel_def pac_step.case + pac_step_rel_raw_def mem_Collect_eq prod.case pac_step_rel_raw.simps) + subgoal + apply (refine_rcg normalize_poly_normalize_poly_spec + check_mult_l_check_mult check_addition_l_check_add + full_normalize_poly_diff_ideal) + subgoal using AB by auto + subgoal using AB by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (auto intro: \) + apply assumption+ + subgoal + by (auto simp: code_status_status_rel_def) + subgoal + by (auto intro!: fmap_rel_fmupd_fmap_rel + fmap_rel_fmdrop_fmap_rel AB) + subgoal using AB by auto + done + subgoal + apply (refine_rcg normalize_poly_normalize_poly_spec + check_mult_l_check_mult check_addition_l_check_add + full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]) + subgoal using AB by auto + subgoal using AB by auto + subgoal using AB by auto + subgoal by auto + subgoal by auto + subgoal by auto + apply assumption+ + subgoal + by (auto simp: code_status_status_rel_def) + subgoal + by (auto intro!: fmap_rel_fmupd_fmap_rel + fmap_rel_fmdrop_fmap_rel AB) + subgoal using AB by auto + done + subgoal + apply (refine_rcg full_normalize_poly_diff_ideal + check_extension_l_check_extension) + subgoal using AB by (auto intro!: fully_unsorted_poly_rel_diff[of _ \-Var _ :: int mpoly\, unfolded H3[symmetric]] simp: comp_def case_prod_beta) + subgoal using AB by auto + subgoal using AB by auto + subgoal by auto + subgoal by auto + subgoal + by (auto simp: code_status_status_rel_def) + subgoal + by (auto simp: AB + intro!: fmap_rel_fmupd_fmap_rel insert_var_rel_set_rel) + subgoal + by (auto simp: code_status_status_rel_def AB + code_status.is_cfailed_def) + done + subgoal + apply (refine_rcg normalize_poly_normalize_poly_spec + check_del_l_check_del check_addition_l_check_add + full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]) + subgoal using AB by auto + subgoal using AB by auto + subgoal + by (auto intro!: fmap_rel_fmupd_fmap_rel + fmap_rel_fmdrop_fmap_rel code_status_status_rel_def AB) + subgoal + by (auto intro!: fmap_rel_fmupd_fmap_rel + fmap_rel_fmdrop_fmap_rel AB) + done + done +qed + +lemma code_status_status_rel_discrim_iff: + \(x1a, x1c) \ code_status_status_rel \ is_cfailed x1a \ is_failed x1c\ + \(x1a, x1c) \ code_status_status_rel \ is_cfound x1a \ is_found x1c\ + by (cases x1a; cases x1c; auto; fail)+ + +lemma PAC_checker_l_PAC_checker: + assumes + \(A, B) \ \var_rel\set_rel \\<^sub>r fmap_polys_rel\ and + \(st, st') \ \pac_step_rel\list_rel\ and + \(spec, spec') \ sorted_poly_rel O mset_poly_rel\ and + \(b, b') \ code_status_status_rel\ + shows + \PAC_checker_l spec A b st \ \ (code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) (PAC_checker spec' B b' st')\ +proof - + have [refine0]: \(((b, A), st), (b', B), st') \ ((code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) \\<^sub>r \pac_step_rel\list_rel)\ + using assms by (auto simp: code_status_status_rel_def) + show ?thesis + using assms + unfolding PAC_checker_l_def PAC_checker_def + apply (refine_rcg PAC_checker_l_step_PAC_checker_step + WHILEIT_refine[where R = \((bool_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) \\<^sub>r \pac_step_rel\list_rel)\]) + subgoal by (auto simp: code_status_status_rel_discrim_iff) + subgoal by auto + subgoal by (auto simp: neq_Nil_conv) + subgoal by (auto simp: neq_Nil_conv intro!: param_nth) + subgoal by (auto simp: neq_Nil_conv) + subgoal by auto + done +qed + +end + +lemma less_than_char_of_char[code_unfold]: + \(x, y) \ less_than_char \ (of_char x :: nat) < of_char y\ + by (auto simp: less_than_char_def less_char_def) + + +lemmas [code] = + add_poly_l'.simps[unfolded var_order_rel_def] + +export_code add_poly_l' in SML module_name test + +definition full_checker_l + :: \llist_polynomial \ (nat, llist_polynomial) fmap \ (_, string, nat) pac_step list \ + (string code_status \ _) nres\ +where + \full_checker_l spec A st = do { + spec' \ full_normalize_poly spec; + (b, \, A) \ remap_polys_l spec' {} A; + if is_cfailed b + then RETURN (b, \, A) + else do { + let \ = \ \ vars_llist spec; + PAC_checker_l spec' (\, A) b st + } + }\ + + +context poly_embed +begin + + +term normalize_poly_spec +thm full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]] +abbreviation unsorted_fmap_polys_rel where + \unsorted_fmap_polys_rel \ \nat_rel, fully_unsorted_poly_rel O mset_poly_rel\fmap_rel\ + +lemma full_checker_l_full_checker: + assumes + \(A, B) \ unsorted_fmap_polys_rel\ and + \(st, st') \ \pac_step_rel\list_rel\ and + \(spec, spec') \ fully_unsorted_poly_rel O mset_poly_rel\ + shows + \full_checker_l spec A st \ \ (code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) (full_checker spec' B st')\ +proof - + have [refine]: + \(spec, spec') \ sorted_poly_rel O mset_poly_rel \ + (\, \') \ \var_rel\set_rel \ + remap_polys_l spec \ A \ \(code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel) + (remap_polys_change_all spec' \' B)\ for spec spec' \ \' + apply (rule remap_polys_l_remap_polys[THEN order_trans, OF assms(1)]) + apply assumption+ + apply (rule ref_two_step[OF order.refl]) + apply(rule remap_polys_spec[THEN order_trans]) + by (rule remap_polys_polynomial_bool_remap_polys_change_all) + + show ?thesis + unfolding full_checker_l_def full_checker_def + apply (refine_rcg remap_polys_l_remap_polys + full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]] + PAC_checker_l_PAC_checker) + subgoal + using assms(3) . + subgoal by auto + subgoal by (auto simp: is_cfailed_def is_failed_def) + subgoal by auto + apply (rule fully_unsorted_poly_rel_extend_vars) + subgoal using assms(3) . + subgoal by auto + subgoal by auto + subgoal + using assms(2) by (auto simp: p2rel_def) + subgoal by auto + done +qed + + +lemma full_checker_l_full_checker': + \(uncurry2 full_checker_l, uncurry2 full_checker) \ + ((fully_unsorted_poly_rel O mset_poly_rel) \\<^sub>r unsorted_fmap_polys_rel) \\<^sub>r \pac_step_rel\list_rel \\<^sub>f + \(code_status_status_rel \\<^sub>r \var_rel\set_rel \\<^sub>r fmap_polys_rel)\nres_rel\ + apply (intro frefI nres_relI) + using full_checker_l_full_checker by force + +end + +definition remap_polys_l2 :: \llist_polynomial \ string set \ (nat, llist_polynomial) fmap \ _ nres\ where + \remap_polys_l2 spec = (\\ A. do{ + n \ upper_bound_on_dom A; + b \ RETURN (n \ 2^64); + if b + then do { + c \ remap_polys_l_dom_err; + RETURN (error_msg (0 ::nat) c, \, fmempty) + } + else do { + (b, \, A) \ nfoldli ([0.._. True) + (\i (b, \, A'). + if i \# dom_m A + then do { + ASSERT(fmlookup A i \ None); + p \ full_normalize_poly (the (fmlookup A i)); + eq \ weak_equality_l p spec; + \ \ RETURN (\ \ vars_llist (the (fmlookup A i))); + RETURN(b \ eq, \, fmupd i p A') + } else RETURN (b, \, A') + ) + (False, \, fmempty); + RETURN (if b then CFOUND else CSUCCESS, \, A) + } + })\ + +lemma remap_polys_l2_remap_polys_l: + \remap_polys_l2 spec \ A \ \ Id (remap_polys_l spec \ A)\ +proof - + have [refine]: \(A, A') \ Id \ upper_bound_on_dom A + \ \ {(n, dom). dom = set [0..dom. set_mset (dom_m A') \ dom \ finite dom))\ for A A' + unfolding upper_bound_on_dom_def + apply (rule RES_refine) + apply (auto simp: upper_bound_on_dom_def) + done + have 1: \inj_on id dom\ for dom + by auto + have 2: \x \# dom_m A \ + x' \# dom_m A' \ + (x, x') \ nat_rel \ + (A, A') \ Id \ + full_normalize_poly (the (fmlookup A x)) + \ \ Id + (full_normalize_poly (the (fmlookup A' x')))\ + for A A' x x' + by (auto) + have 3: \(n, dom) \ {(n, dom). dom = set [0.. + ([0.. \nat_rel\list_set_rel\ for n dom + by (auto simp: list_set_rel_def br_def) + have 4: \(p,q) \ Id \ + weak_equality_l p spec \ \Id (weak_equality_l q spec)\ for p q spec + by auto + + have 6: \a = b \ (a, b) \ Id\ for a b + by auto + show ?thesis + unfolding remap_polys_l2_def remap_polys_l_def + apply (refine_rcg LFO_refine[where R= \Id \\<^sub>r \Id\set_rel \\<^sub>r Id\]) + subgoal by auto + subgoal by auto + subgoal by auto + apply (rule 3) + subgoal by auto + subgoal by (simp add: in_dom_m_lookup_iff) + subgoal by (simp add: in_dom_m_lookup_iff) + apply (rule 2) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + apply (rule 4; assumption) + apply (rule 6) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + done +qed + +end diff --git a/thys/PAC_Checker/PAC_Checker_Init.thy b/thys/PAC_Checker/PAC_Checker_Init.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker_Init.thy @@ -0,0 +1,886 @@ +(* + File: PAC_Checker_Init.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker_Init + imports PAC_Checker WB_Sort PAC_Checker_Relation +begin + +section \Initial Normalisation of Polynomials\ + +subsection \Sorting\ + +text \Adapted from the theory \<^text>\HOL-ex.MergeSort\ by Tobias Nipkow. We did not change much, but + we refine it to executable code and try to improve efficiency. +\ + +fun merge :: "_ \ 'a list \ 'a list \ 'a list" +where + "merge f (x#xs) (y#ys) = + (if f x y then x # merge f xs (y#ys) else y # merge f (x#xs) ys)" +| "merge f xs [] = xs" +| "merge f [] ys = ys" + +lemma mset_merge [simp]: + "mset (merge f xs ys) = mset xs + mset ys" + by (induct f xs ys rule: merge.induct) (simp_all add: ac_simps) + +lemma set_merge [simp]: + "set (merge f xs ys) = set xs \ set ys" + by (induct f xs ys rule: merge.induct) auto + +lemma sorted_merge: + "transp f \ (\x y. f x y \ f y x) \ + sorted_wrt f (merge f xs ys) \ sorted_wrt f xs \ sorted_wrt f ys" + apply (induct f xs ys rule: merge.induct) + apply (auto simp add: ball_Un not_le less_le dest: transpD) + apply blast + apply (blast dest: transpD) + done + +fun msort :: "_ \ 'a list \ 'a list" +where + "msort f [] = []" +| "msort f [x] = [x]" +| "msort f xs = merge f + (msort f (take (size xs div 2) xs)) + (msort f (drop (size xs div 2) xs))" + +fun swap_ternary :: \_\nat\nat\ ('a \ 'a \ 'a) \ ('a \ 'a \ 'a)\ where + \swap_ternary f m n = + (if (m = 0 \ n = 1) + then (\(a, b, c). if f a b then (a, b, c) + else (b,a,c)) + else if (m = 0 \ n = 2) + then (\(a, b, c). if f a c then (a, b, c) + else (c,b,a)) + else if (m = 1 \ n = 2) + then (\(a, b, c). if f b c then (a, b, c) + else (a,c,b)) + else (\(a, b, c). (a,b,c)))\ + +fun msort2 :: "_ \ 'a list \ 'a list" +where + "msort2 f [] = []" +| "msort2 f [x] = [x]" +| "msort2 f [x,y] = (if f x y then [x,y] else [y,x])" +| "msort2 f xs = merge f + (msort f (take (size xs div 2) xs)) + (msort f (drop (size xs div 2) xs))" + +lemmas [code del] = + msort2.simps + +declare msort2.simps[simp del] +lemmas [code] = + msort2.simps[unfolded swap_ternary.simps, simplified] + +declare msort2.simps[simp] + +lemma msort_msort2: + fixes xs :: \'a :: linorder list\ + shows \msort (\) xs = msort2 (\) xs\ + apply (induction \(\) :: 'a \ 'a \ bool\ xs rule: msort2.induct) + apply (auto dest: transpD) + done + +lemma sorted_msort: + "transp f \ (\x y. f x y \ f y x) \ + sorted_wrt f (msort f xs)" + by (induct f xs rule: msort.induct) (simp_all add: sorted_merge) + +lemma mset_msort[simp]: + "mset (msort f xs) = mset xs" + by (induction f xs rule: msort.induct) + (simp_all add: union_code) + + +subsection \Sorting applied to monomials\ + +lemma merge_coeffs_alt_def: + \(RETURN o merge_coeffs) p = + REC\<^sub>T(\f p. + (case p of + [] \ RETURN [] + | [_] => RETURN p + | ((xs, n) # (ys, m) # p) \ + (if xs = ys + then if n + m \ 0 then f ((xs, n + m) # p) else f p + else do {p \ f ((ys, m) # p); RETURN ((xs, n) # p)}))) + p\ + apply (induction p rule: merge_coeffs.induct) + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal for x p y q + by (subst RECT_unfold, refine_mono) + (smt case_prod_conv list.simps(5) merge_coeffs.simps(3) nres_monad1 + push_in_let_conv(2)) + done + +lemma hn_invalid_recover: + \is_pure R \ hn_invalid R = (\x y. R x y * true)\ + \is_pure R \ invalid_assn R = (\x y. R x y * true)\ + by (auto simp: is_pure_conv invalid_pure_recover hn_ctxt_def intro!: ext) + +lemma safe_poly_vars: + shows + [safe_constraint_rules]: + "is_pure (poly_assn)" and + [safe_constraint_rules]: + "is_pure (monom_assn)" and + [safe_constraint_rules]: + "is_pure (monomial_assn)" and + [safe_constraint_rules]: + "is_pure string_assn" + by (auto intro!: pure_prod list_assn_pure simp: prod_assn_pure_conv) + +lemma invalid_assn_distrib: + \invalid_assn monom_assn \\<^sub>a invalid_assn int_assn = invalid_assn (monom_assn \\<^sub>a int_assn)\ + apply (simp add: invalid_pure_recover hn_invalid_recover + safe_constraint_rules) + apply (subst hn_invalid_recover) + apply (rule safe_poly_vars(2)) + apply (subst hn_invalid_recover) + apply (rule safe_poly_vars) + apply (auto intro!: ext) + done + +lemma WTF_RF_recover: + \hn_ctxt (invalid_assn monom_assn \\<^sub>a invalid_assn int_assn) xb + x'a \\<^sub>A + hn_ctxt monomial_assn xb x'a \\<^sub>t + hn_ctxt (monomial_assn) xb x'a\ + by (smt assn_aci(5) hn_ctxt_def invalid_assn_distrib invalid_pure_recover is_pure_conv + merge_thms(4) merge_true_star reorder_enttI safe_poly_vars(3) star_aci(2) star_aci(3)) + +lemma WTF_RF: + \hn_ctxt (invalid_assn monom_assn \\<^sub>a invalid_assn int_assn) xb x'a * + (hn_invalid poly_assn la l'a * hn_invalid int_assn a2' a2 * + hn_invalid monom_assn a1' a1 * + hn_invalid poly_assn l l' * + hn_invalid monomial_assn xa x' * + hn_invalid poly_assn ax px) \\<^sub>t + hn_ctxt (monomial_assn) xb x'a * + hn_ctxt poly_assn + la l'a * + hn_ctxt poly_assn l l' * + (hn_invalid int_assn a2' a2 * + hn_invalid monom_assn a1' a1 * + hn_invalid monomial_assn xa x' * + hn_invalid poly_assn ax px)\ + \hn_ctxt (invalid_assn monom_assn \\<^sub>a invalid_assn int_assn) xa x' * + (hn_ctxt poly_assn l l' * hn_invalid poly_assn ax px) \\<^sub>t + hn_ctxt (monomial_assn) xa x' * + hn_ctxt poly_assn l l' * + hn_ctxt poly_assn ax px * + emp\ + by sepref_dbg_trans_step+ + +text \The refinement frameword is completely lost here when synthesizing the constants -- it does + not understant what is pure (actually everything) and what must be destroyed.\ +sepref_definition merge_coeffs_impl + is \RETURN o merge_coeffs\ + :: \poly_assn\<^sup>d \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding merge_coeffs_alt_def + HOL_list.fold_custom_empty poly_assn_alt_def + apply (rewrite in \_\ annotate_assn[where A=\poly_assn\]) + apply sepref_dbg_preproc + apply sepref_dbg_cons_init + apply sepref_dbg_id + apply sepref_dbg_monadify + apply sepref_dbg_opt_init + apply (rule WTF_RF | sepref_dbg_trans_step)+ + apply sepref_dbg_opt + apply sepref_dbg_cons_solve + apply sepref_dbg_cons_solve + apply sepref_dbg_constraints + done + +definition full_quicksort_poly where + \full_quicksort_poly = full_quicksort_ref (\x y. x = y \ (x, y) \ term_order_rel) fst\ + +lemma down_eq_id_list_rel: \\(\Id\list_rel) x = x\ + by auto + +definition quicksort_poly:: \nat \ nat \ llist_polynomial \ (llist_polynomial) nres\ where + \quicksort_poly x y z = quicksort_ref (\) fst (x, y, z)\ + +term partition_between_ref + +definition partition_between_poly :: \nat \ nat \ llist_polynomial \ (llist_polynomial \ nat) nres\ where + \partition_between_poly = partition_between_ref (\) fst\ + +definition partition_main_poly :: \nat \ nat \ llist_polynomial \ (llist_polynomial \ nat) nres\ where + \partition_main_poly = partition_main (\) fst\ + +lemma string_list_trans: + \(xa ::char list list, ya) \ lexord (lexord {(x, y). x < y}) \ + (ya, z) \ lexord (lexord {(x, y). x < y}) \ + (xa, z) \ lexord (lexord {(x, y). x < y})\ + by (smt less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def) + +lemma full_quicksort_sort_poly_spec: + \(full_quicksort_poly, sort_poly_spec) \ \Id\list_rel \\<^sub>f \\Id\list_rel\nres_rel\ +proof - + have xs: \(xs, xs) \ \Id\list_rel\ and \\(\Id\list_rel) x = x\ for x xs + by auto + show ?thesis + apply (intro frefI nres_relI) + unfolding full_quicksort_poly_def + apply (rule full_quicksort_ref_full_quicksort[THEN fref_to_Down_curry, THEN order_trans]) + subgoal + by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def + dest: string_list_trans) + subgoal + using total_on_lexord_less_than_char_linear[unfolded var_order_rel_def] + apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def less_char_def) + done + subgoal by fast + apply (rule xs) + apply (subst down_eq_id_list_rel) + unfolding sorted_wrt_map sort_poly_spec_def + apply (rule full_quicksort_correct_sorted[where R = \(\x y. x = y \ (x, y) \ term_order_rel)\ and h = \fst\, + THEN order_trans]) + subgoal + by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def dest: string_list_trans) + subgoal for x y + using total_on_lexord_less_than_char_linear[unfolded var_order_rel_def] + apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def + less_char_def) + done + subgoal + by (auto simp: rel2p_def p2rel_def) + done +qed + + +subsection \Lifting to polynomials\ + +definition merge_sort_poly :: \_\ where +\merge_sort_poly = msort (\a b. fst a \ fst b)\ + +definition merge_monoms_poly :: \_\ where +\merge_monoms_poly = msort (\)\ + +definition merge_poly :: \_\ where +\merge_poly = merge (\a b. fst a \ fst b)\ + +definition merge_monoms :: \_\ where +\merge_monoms = merge (\)\ + +definition msort_poly_impl :: \(String.literal list \ int) list \ _\ where +\msort_poly_impl = msort (\a b. fst a \ fst b)\ + +definition msort_monoms_impl :: \(String.literal list) \ _\ where +\msort_monoms_impl = msort (\)\ + +lemma msort_poly_impl_alt_def: + \msort_poly_impl xs = + (case xs of + [] \ [] + | [a] \ [a] + | [a,b] \ if fst a \ fst b then [a,b]else [b,a] + | xs \ merge_poly + (msort_poly_impl (take ((length xs) div 2) xs)) + (msort_poly_impl (drop ((length xs) div 2) xs)))\ + unfolding msort_poly_impl_def + apply (auto split: list.splits simp: merge_poly_def) + done + +lemma le_term_order_rel': + \(\) = (\x y. x = y \ term_order_rel' x y)\ + apply (intro ext) + apply (auto simp add: less_list_def less_eq_list_def + lexordp_eq_conv_lexord lexordp_def) + using term_order_rel'_alt_def_lexord term_order_rel'_def apply blast + using term_order_rel'_alt_def_lexord term_order_rel'_def apply blast + done + +fun lexord_eq where + \lexord_eq [] _ = True\ | + \lexord_eq (x # xs) (y # ys) = (x < y \ (x = y \ lexord_eq xs ys))\ | + \lexord_eq _ _ = False\ + +lemma [simp]: + \lexord_eq [] [] = True\ + \lexord_eq (a # b)[] = False\ + \lexord_eq [] (a # b) = True\ + apply auto + done + +lemma var_order_rel': + \(\) = (\x y. x = y \ (x,y) \ var_order_rel)\ + by (intro ext) + (auto simp add: less_list_def less_eq_list_def + lexordp_eq_conv_lexord lexordp_def var_order_rel_def + lexordp_conv_lexord p2rel_def) + + +lemma var_order_rel'': + \(x,y) \ var_order_rel \ x < y\ + by (metis leD less_than_char_linear lexord_linear neq_iff var_order_rel' var_order_rel_antisym + var_order_rel_def) + +lemma lexord_eq_alt_def1: + \a \ b = lexord_eq a b\ for a b :: \String.literal list\ + unfolding le_term_order_rel' + apply (induction a b rule: lexord_eq.induct) + apply (auto simp: var_order_rel'' less_eq_list_def) + done + +lemma lexord_eq_alt_def2: + \(RETURN oo lexord_eq) xs ys = + REC\<^sub>T (\f (xs, ys). + case (xs, ys) of + ([], _) \ RETURN True + | (x # xs, y # ys) \ + if x < y then RETURN True + else if x = y then f (xs, ys) else RETURN False + | _ \ RETURN False) + (xs, ys)\ + apply (subst eq_commute) + apply (induction xs ys rule: lexord_eq.induct) + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + done + + +definition var_order' where + [simp]: \var_order' = var_order\ + +lemma var_order_rel[def_pat_rules]: + \(\)$(x,y)$var_order_rel \ var_order'$x$y\ + by (auto simp: p2rel_def rel2p_def) + +lemma var_order_rel_alt_def: + \var_order_rel = p2rel char.lexordp\ + apply (auto simp: p2rel_def char.lexordp_conv_lexord var_order_rel_def) + using char.lexordp_conv_lexord apply auto + done + +lemma var_order_rel_var_order: + \(x, y) \ var_order_rel \ var_order x y\ + by (auto simp: rel2p_def) + +lemma var_order_string_le[sepref_import_param]: + \((<), var_order') \ string_rel \ string_rel \ bool_rel\ + apply (auto intro!: frefI simp: string_rel_def String.less_literal_def + rel2p_def linorder.lexordp_conv_lexord[OF char.linorder_axioms, + unfolded less_eq_char_def] var_order_rel_def + p2rel_def + simp flip: PAC_Polynomials_Term.less_char_def) + using char.lexordp_conv_lexord apply auto + done + +lemma [sepref_import_param]: + \( (\), (\)) \ monom_rel \ monom_rel \bool_rel\ + apply (intro fun_relI) + using list_rel_list_rel_order_iff by fastforce + +lemma [sepref_import_param]: + \( (<), (<)) \ string_rel \ string_rel \bool_rel\ +proof - + have [iff]: \ord.lexordp (<) (literal.explode a) (literal.explode aa) \ + List.lexordp (<) (literal.explode a) (literal.explode aa)\ for a aa + apply (rule iffI) + apply (metis PAC_Checker_Relation.less_char_def char.lexordp_conv_lexord less_list_def + p2rel_def var_order_rel'' var_order_rel_def) + apply (metis PAC_Checker_Relation.less_char_def char.lexordp_conv_lexord less_list_def + p2rel_def var_order_rel'' var_order_rel_def) + done + show ?thesis + unfolding string_rel_def less_literal.rep_eq less_than_char_def + less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric] + by (intro fun_relI) + (auto simp: string_rel_def less_literal.rep_eq + less_list_def char.lexordp_conv_lexord lexordp_eq_refl + lexord_code lexordp_eq_conv_lexord) +qed + +lemma [sepref_import_param]: + \( (\), (\)) \ string_rel \ string_rel \bool_rel\ + unfolding string_rel_def less_eq_literal.rep_eq less_than_char_def + less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric] + by (intro fun_relI) + (auto simp: string_rel_def less_eq_literal.rep_eq less_than_char_def + less_eq_list_def char.lexordp_eq_conv_lexord lexordp_eq_refl + lexord_code lexordp_eq_conv_lexord + simp flip: less_char_def[abs_def]) + +sepref_register lexord_eq +sepref_definition lexord_eq_term + is \uncurry (RETURN oo lexord_eq)\ + :: \monom_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \\<^sub>a bool_assn\ + supply[[goals_limit=1]] + unfolding lexord_eq_alt_def2 + by sepref + +declare lexord_eq_term.refine[sepref_fr_rules] + + +lemmas [code del] = msort_poly_impl_def msort_monoms_impl_def +lemmas [code] = + msort_poly_impl_def[unfolded lexord_eq_alt_def1[abs_def]] + msort_monoms_impl_def[unfolded msort_msort2] + +lemma term_order_rel_trans: + \(a, aa) \ term_order_rel \ + (aa, ab) \ term_order_rel \ (a, ab) \ term_order_rel\ + by (metis PAC_Checker_Relation.less_char_def p2rel_def string_list_trans var_order_rel_def) + +lemma merge_sort_poly_sort_poly_spec: + \(RETURN o merge_sort_poly, sort_poly_spec) \ \Id\list_rel \\<^sub>f \\Id\list_rel\nres_rel\ + unfolding sort_poly_spec_def merge_sort_poly_def + apply (intro frefI nres_relI) + using total_on_lexord_less_than_char_linear var_order_rel_def + by (auto intro!: sorted_msort simp: sorted_wrt_map rel2p_def + le_term_order_rel' transp_def dest: term_order_rel_trans) + +lemma msort_alt_def: + \RETURN o (msort f) = + REC\<^sub>T (\g xs. + case xs of + [] \ RETURN [] + | [x] \ RETURN [x] + | _ \ do { + a \ g (take (size xs div 2) xs); + b \ g (drop (size xs div 2) xs); + RETURN (merge f a b)})\ + apply (intro ext) + unfolding comp_def + apply (induct_tac f x rule: msort.induct) + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal + by (subst RECT_unfold, refine_mono) + (smt let_to_bind_conv list.simps(5) msort.simps(3)) + done + +lemma monomial_rel_order_map: + \(x, a, b) \ monomial_rel \ + (y, aa, bb) \ monomial_rel \ + fst x \ fst y \ a \ aa\ + apply (cases x; cases y) + apply auto + using list_rel_list_rel_order_iff by fastforce+ + + +lemma step_rewrite_pure: + fixes K :: \('olbl \ 'lbl) set\ + shows + \pure (p2rel (\K, V, R\pac_step_rel_raw)) = pac_step_rel_assn (pure K) (pure V) (pure R)\ + \monomial_assn = pure (monom_rel \\<^sub>r int_rel)\ and + poly_assn_list: + \poly_assn = pure (\monom_rel \\<^sub>r int_rel\list_rel)\ + subgoal + apply (intro ext) + apply (case_tac x; case_tac xa) + apply (auto simp: relAPP_def p2rel_def pure_def) + done + subgoal H + apply (intro ext) + apply (case_tac x; case_tac xa) + by (simp add: list_assn_pure_conv) + subgoal + unfolding H + by (simp add: list_assn_pure_conv relAPP_def) + done + +lemma safe_pac_step_rel_assn[safe_constraint_rules]: + "is_pure K \ is_pure V \ is_pure R \ is_pure (pac_step_rel_assn K V R)" + by (auto simp: step_rewrite_pure(1)[symmetric] is_pure_conv) + + +lemma merge_poly_merge_poly: + \(merge_poly, merge_poly) + \ poly_rel \ poly_rel \ poly_rel\ + unfolding merge_poly_def + apply (intro fun_relI) + subgoal for a a' aa a'a + apply (induction \(\(a :: String.literal list \ int) + (b :: String.literal list \ int). fst a \ fst b)\ a aa + arbitrary: a' a'a + rule: merge.induct) + subgoal + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2 + simp: monomial_rel_order_map) + subgoal + by (auto elim!: list_relE3 list_relE) + subgoal + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2) + done + done + +lemmas [fcomp_norm_unfold] = + poly_assn_list[symmetric] + step_rewrite_pure(1) + +lemma merge_poly_merge_poly2: + \(a, b) \ poly_rel \ (a', b') \ poly_rel \ + (merge_poly a a', merge_poly b b') \ poly_rel\ + using merge_poly_merge_poly + unfolding fun_rel_def + by auto + +lemma list_rel_takeD: + \(a, b) \ \R\list_rel \ (n, n')\ Id \ (take n a, take n' b) \ \R\list_rel\ + by (simp add: list_rel_eq_listrel listrel_iff_nth relAPP_def) + +lemma list_rel_dropD: + \(a, b) \ \R\list_rel \ (n, n')\ Id \ (drop n a, drop n' b) \ \R\list_rel\ + by (simp add: list_rel_eq_listrel listrel_iff_nth relAPP_def) + +lemma merge_sort_poly[sepref_import_param]: + \(msort_poly_impl, merge_sort_poly) + \ poly_rel \ poly_rel\ + unfolding merge_sort_poly_def msort_poly_impl_def + apply (intro fun_relI) + subgoal for a a' + apply (induction \(\(a :: String.literal list \ int) + (b :: String.literal list \ int). fst a \ fst b)\ a + arbitrary: a' + rule: msort.induct) + subgoal + by auto + subgoal + by (auto elim!: list_relE3 list_relE) + subgoal premises p + using p + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2 + simp: merge_poly_def[symmetric] + intro!: list_rel_takeD list_rel_dropD + intro!: merge_poly_merge_poly2 p(1)[simplified] p(2)[simplified], + auto simp: list_rel_imp_same_length) + done + done + + + +lemmas [sepref_fr_rules] = merge_sort_poly[FCOMP merge_sort_poly_sort_poly_spec] + +sepref_definition partition_main_poly_impl + is \uncurry2 partition_main_poly\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a prod_assn poly_assn nat_assn \ + unfolding partition_main_poly_def partition_main_def + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + le_term_order_rel' + by sepref + +declare partition_main_poly_impl.refine[sepref_fr_rules] + +sepref_definition partition_between_poly_impl + is \uncurry2 partition_between_poly\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a prod_assn poly_assn nat_assn \ + unfolding partition_between_poly_def partition_between_ref_def + partition_main_poly_def[symmetric] + unfolding choose_pivot3_def + term_order_rel'_def[symmetric] + term_order_rel'_alt_def choose_pivot_def + lexord_eq_alt_def1 + by sepref + +declare partition_between_poly_impl.refine[sepref_fr_rules] + +sepref_definition quicksort_poly_impl + is \uncurry2 quicksort_poly\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a poly_assn\ + unfolding partition_main_poly_def quicksort_ref_def quicksort_poly_def + partition_between_poly_def[symmetric] + by sepref + +lemmas [sepref_fr_rules] = quicksort_poly_impl.refine + +sepref_register quicksort_poly +sepref_definition full_quicksort_poly_impl + is \full_quicksort_poly\ + :: \poly_assn\<^sup>k \\<^sub>a poly_assn\ + unfolding full_quicksort_poly_def full_quicksort_ref_def + quicksort_poly_def[symmetric] + le_term_order_rel'[symmetric] + term_order_rel'_def[symmetric] + List.null_def + by sepref + + +lemmas sort_poly_spec_hnr = + full_quicksort_poly_impl.refine[FCOMP full_quicksort_sort_poly_spec] + +declare merge_coeffs_impl.refine[sepref_fr_rules] + +sepref_definition normalize_poly_impl + is \normalize_poly\ + :: \poly_assn\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding normalize_poly_def + by sepref + +declare normalize_poly_impl.refine[sepref_fr_rules] + + +definition full_quicksort_vars where + \full_quicksort_vars = full_quicksort_ref (\x y. x = y \ (x, y) \ var_order_rel) id\ + + +definition quicksort_vars:: \nat \ nat \ string list \ (string list) nres\ where + \quicksort_vars x y z = quicksort_ref (\) id (x, y, z)\ + + +definition partition_between_vars :: \nat \ nat \ string list \ (string list \ nat) nres\ where + \partition_between_vars = partition_between_ref (\) id\ + +definition partition_main_vars :: \nat \ nat \ string list \ (string list \ nat) nres\ where + \partition_main_vars = partition_main (\) id\ + +lemma total_on_lexord_less_than_char_linear2: + \xs \ ys \ (xs, ys) \ lexord (less_than_char) \ + (ys, xs) \ lexord less_than_char\ + using lexord_linear[of \less_than_char\ xs ys] + using lexord_linear[of \less_than_char\] less_than_char_linear + apply (auto simp: Relation.total_on_def) + using lexord_irrefl[OF irrefl_less_than_char] + antisym_lexord[OF antisym_less_than_char irrefl_less_than_char] + apply (auto simp: antisym_def) + done + +lemma string_trans: + \(xa, ya) \ lexord {(x::char, y::char). x < y} \ + (ya, z) \ lexord {(x::char, y::char). x < y} \ + (xa, z) \ lexord {(x::char, y::char). x < y}\ + by (smt less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def) + +lemma full_quicksort_sort_vars_spec: + \(full_quicksort_vars, sort_coeff) \ \Id\list_rel \\<^sub>f \\Id\list_rel\nres_rel\ +proof - + have xs: \(xs, xs) \ \Id\list_rel\ and \\(\Id\list_rel) x = x\ for x xs + by auto + show ?thesis + apply (intro frefI nres_relI) + unfolding full_quicksort_vars_def + apply (rule full_quicksort_ref_full_quicksort[THEN fref_to_Down_curry, THEN order_trans]) + subgoal + by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def + dest: string_trans) + subgoal + using total_on_lexord_less_than_char_linear2[unfolded var_order_rel_def] + apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def less_char_def) + done + subgoal by fast + apply (rule xs) + apply (subst down_eq_id_list_rel) + unfolding sorted_wrt_map sort_coeff_def + apply (rule full_quicksort_correct_sorted[where R = \(\x y. x = y \ (x, y) \ var_order_rel)\ and h = \id\, + THEN order_trans]) + subgoal + by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def dest: string_trans) + subgoal for x y + using total_on_lexord_less_than_char_linear2[unfolded var_order_rel_def] + by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def + less_char_def) + subgoal + by (auto simp: rel2p_def p2rel_def rel2p_def[abs_def]) + done +qed + + +sepref_definition partition_main_vars_impl + is \uncurry2 partition_main_vars\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a (monom_assn)\<^sup>k \\<^sub>a prod_assn (monom_assn) nat_assn\ + unfolding partition_main_vars_def partition_main_def + var_order_rel_var_order + var_order'_def[symmetric] + term_order_rel'_alt_def + le_term_order_rel' + id_apply + by sepref + +declare partition_main_vars_impl.refine[sepref_fr_rules] + +sepref_definition partition_between_vars_impl + is \uncurry2 partition_between_vars\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \\<^sub>a prod_assn monom_assn nat_assn \ + unfolding partition_between_vars_def partition_between_ref_def + partition_main_vars_def[symmetric] + unfolding choose_pivot3_def + term_order_rel'_def[symmetric] + term_order_rel'_alt_def choose_pivot_def + le_term_order_rel' id_apply + by sepref + +declare partition_between_vars_impl.refine[sepref_fr_rules] + +sepref_definition quicksort_vars_impl + is \uncurry2 quicksort_vars\ + :: \nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \\<^sub>a monom_assn\ + unfolding partition_main_vars_def quicksort_ref_def quicksort_vars_def + partition_between_vars_def[symmetric] + by sepref + +lemmas [sepref_fr_rules] = quicksort_vars_impl.refine + +sepref_register quicksort_vars + + +lemma le_var_order_rel: + \(\) = (\x y. x = y \ (x, y) \ var_order_rel)\ + by (intro ext) + (auto simp add: less_list_def less_eq_list_def rel2p_def + p2rel_def lexordp_conv_lexord p2rel_def var_order_rel_def + lexordp_eq_conv_lexord lexordp_def) + +sepref_definition full_quicksort_vars_impl + is \full_quicksort_vars\ + :: \monom_assn\<^sup>k \\<^sub>a monom_assn\ + unfolding full_quicksort_vars_def full_quicksort_ref_def + quicksort_vars_def[symmetric] + le_var_order_rel[symmetric] + term_order_rel'_def[symmetric] + List.null_def + by sepref + + +lemmas sort_vars_spec_hnr = + full_quicksort_vars_impl.refine[FCOMP full_quicksort_sort_vars_spec] + +lemma string_rel_order_map: + \(x, a) \ string_rel \ + (y, aa) \ string_rel \ + x \ y \ a \ aa\ + unfolding string_rel_def less_eq_literal.rep_eq less_than_char_def + less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric] + by (auto simp: string_rel_def less_eq_literal.rep_eq less_than_char_def + less_eq_list_def char.lexordp_eq_conv_lexord lexordp_eq_refl + lexord_code lexordp_eq_conv_lexord + simp flip: less_char_def[abs_def]) + +lemma merge_monoms_merge_monoms: + \(merge_monoms, merge_monoms) \ monom_rel \ monom_rel \ monom_rel\ + unfolding merge_monoms_def + apply (intro fun_relI) + subgoal for a a' aa a'a + apply (induction \(\(a :: String.literal) + (b :: String.literal). a \ b)\ a aa + arbitrary: a' a'a + rule: merge.induct) + subgoal + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2 + simp: string_rel_order_map) + subgoal + by (auto elim!: list_relE3 list_relE) + subgoal + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2) + done + done + +lemma merge_monoms_merge_monoms2: + \(a, b) \ monom_rel \ (a', b') \ monom_rel \ + (merge_monoms a a', merge_monoms b b') \ monom_rel\ + using merge_monoms_merge_monoms + unfolding fun_rel_def merge_monoms_def + by auto + + +lemma msort_monoms_impl: + \(msort_monoms_impl, merge_monoms_poly) + \ monom_rel \ monom_rel\ + unfolding msort_monoms_impl_def merge_monoms_poly_def + apply (intro fun_relI) + subgoal for a a' + apply (induction \(\(a :: String.literal) + (b :: String.literal). a \ b)\ a + arbitrary: a' + rule: msort.induct) + subgoal + by auto + subgoal + by (auto elim!: list_relE3 list_relE) + subgoal premises p + using p + by (auto elim!: list_relE3 list_relE4 list_relE list_relE2 + simp: merge_monoms_def[symmetric] intro!: list_rel_takeD list_rel_dropD + intro!: merge_monoms_merge_monoms2 p(1)[simplified] p(2)[simplified]) + (simp_all add: list_rel_imp_same_length) + done + done + +lemma merge_sort_monoms_sort_monoms_spec: + \(RETURN o merge_monoms_poly, sort_coeff) \ \Id\list_rel \\<^sub>f \\Id\list_rel\nres_rel\ + unfolding merge_monoms_poly_def sort_coeff_def + by (intro frefI nres_relI) + (auto intro!: sorted_msort simp: sorted_wrt_map rel2p_def + le_term_order_rel' transp_def rel2p_def[abs_def] + simp flip: le_var_order_rel) + +sepref_register sort_coeff +lemma [sepref_fr_rules]: + \(return o msort_monoms_impl, sort_coeff) \ monom_assn\<^sup>k \\<^sub>a monom_assn\ + using msort_monoms_impl[sepref_param, FCOMP merge_sort_monoms_sort_monoms_spec] + by auto + +sepref_definition sort_all_coeffs_impl + is \sort_all_coeffs\ + :: \poly_assn\<^sup>k \\<^sub>a poly_assn\ + unfolding sort_all_coeffs_def + HOL_list.fold_custom_empty + by sepref + +declare sort_all_coeffs_impl.refine[sepref_fr_rules] + +lemma merge_coeffs0_alt_def: + \(RETURN o merge_coeffs0) p = + REC\<^sub>T(\f p. + (case p of + [] \ RETURN [] + | [p] => if snd p = 0 then RETURN [] else RETURN [p] + | ((xs, n) # (ys, m) # p) \ + (if xs = ys + then if n + m \ 0 then f ((xs, n + m) # p) else f p + else if n = 0 then + do {p \ f ((ys, m) # p); + RETURN p} + else do {p \ f ((ys, m) # p); + RETURN ((xs, n) # p)}))) + p\ + apply (subst eq_commute) + apply (induction p rule: merge_coeffs0.induct) + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) (auto simp: let_to_bind_conv) + done + +text \Again, Sepref does not understand what is going here.\ +sepref_definition merge_coeffs0_impl + is \RETURN o merge_coeffs0\ + :: \poly_assn\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding merge_coeffs0_alt_def + HOL_list.fold_custom_empty + apply sepref_dbg_preproc + apply sepref_dbg_cons_init + apply sepref_dbg_id + apply sepref_dbg_monadify + apply sepref_dbg_opt_init + apply (rule WTF_RF | sepref_dbg_trans_step)+ + apply sepref_dbg_opt + apply sepref_dbg_cons_solve + apply sepref_dbg_cons_solve + apply sepref_dbg_constraints + done + + +declare merge_coeffs0_impl.refine[sepref_fr_rules] + +sepref_definition fully_normalize_poly_impl + is \full_normalize_poly\ + :: \poly_assn\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding full_normalize_poly_def + by sepref + +declare fully_normalize_poly_impl.refine[sepref_fr_rules] + + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Checker_MLton.thy b/thys/PAC_Checker/PAC_Checker_MLton.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker_MLton.thy @@ -0,0 +1,34 @@ +(* + File: PAC_Checker_MLton.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker_MLton + imports PAC_Checker_Synthesis +begin + +export_code PAC_checker_l_impl PAC_update_impl PAC_empty_impl the_error is_cfailed is_cfound + int_of_integer Del Add Mult nat_of_integer String.implode remap_polys_l_impl + fully_normalize_poly_impl union_vars_poly_impl empty_vars_impl + full_checker_l_impl check_step_impl CSUCCESS + Extension hashcode_literal' version + in SML_imp module_name PAC_Checker + file_prefix "checker" + +text \Here is how to compile it:\ +compile_generated_files _ + external_files + \code/parser.sml\ + \code/pasteque.sml\ + \code/pasteque.mlb\ + where \fn dir => + let + val exec = Generated_Files.execute (Path.append dir (Path.basic "code")); + val _ = + exec \Compilation\ + (File.bash_path \<^path>\$ISABELLE_MLTON\ ^ " " ^ + "-const 'MLton.safe false' -verbose 1 -default-type int64 -output pasteque " ^ + "-codegen native -inline 700 -cc-opt -O3 pasteque.mlb"); + in () end\ + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Checker_Relation.thy b/thys/PAC_Checker/PAC_Checker_Relation.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker_Relation.thy @@ -0,0 +1,389 @@ +(* + File: PAC_Checker_Relation.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker_Relation + imports PAC_Checker WB_Sort "Native_Word.Uint64" +begin + +section \Various Refinement Relations\ + +text \When writing this, it was not possible to share the definition with the IsaSAT version.\ +definition uint64_nat_rel :: "(uint64 \ nat) set" where + \uint64_nat_rel = br nat_of_uint64 (\_. True)\ + +abbreviation uint64_nat_assn where + \uint64_nat_assn \ pure uint64_nat_rel\ + +instantiation uint32 :: hashable +begin +definition hashcode_uint32 :: \uint32 \ uint32\ where + \hashcode_uint32 n = n\ + +definition def_hashmap_size_uint32 :: \uint32 itself \ nat\ where + \def_hashmap_size_uint32 = (\_. 16)\ + \ \same as @{typ nat}\ +instance + by standard (simp add: def_hashmap_size_uint32_def) +end + +instantiation uint64 :: hashable +begin +definition hashcode_uint64 :: \uint64 \ uint32\ where + \hashcode_uint64 n = (uint32_of_nat (nat_of_uint64 ((n) AND ((2 :: uint64)^32 -1))))\ + +definition def_hashmap_size_uint64 :: \uint64 itself \ nat\ where + \def_hashmap_size_uint64 = (\_. 16)\ + \ \same as @{typ nat}\ +instance + by standard (simp add: def_hashmap_size_uint64_def) +end + +lemma word_nat_of_uint64_Rep_inject[simp]: \nat_of_uint64 ai = nat_of_uint64 bi \ ai = bi\ + by transfer simp + +instance uint64 :: heap + by standard (auto simp: inj_def exI[of _ nat_of_uint64]) + +instance uint64 :: semiring_numeral + by standard + +lemma nat_of_uint64_012[simp]: \nat_of_uint64 0 = 0\ \nat_of_uint64 2 = 2\ \nat_of_uint64 1 = 1\ + by (transfer, auto)+ + +definition uint64_of_nat_conv where + [simp]: \uint64_of_nat_conv (x :: nat) = x\ +lemma less_upper_bintrunc_id: \n < 2 ^b \ n \ 0 \ bintrunc b n = n\ + unfolding uint32_of_nat_def + by (simp add: no_bintr_alt1) + +lemma nat_of_uint64_uint64_of_nat_id: \n < 2^64 \ nat_of_uint64 (uint64_of_nat n) = n\ + unfolding uint64_of_nat_def + apply simp + apply transfer + apply (auto simp: unat_def) + apply transfer + by (auto simp: less_upper_bintrunc_id) + +lemma [sepref_fr_rules]: + \(return o uint64_of_nat, RETURN o uint64_of_nat_conv) \ [\a. a < 2 ^64]\<^sub>a nat_assn\<^sup>k \ uint64_nat_assn\ + by sepref_to_hoare + (sep_auto simp: uint64_nat_rel_def br_def nat_of_uint64_uint64_of_nat_id) + +definition string_rel :: \(String.literal \ string) set\ where + \string_rel = {(x, y). y = String.explode x}\ + +abbreviation string_assn :: \string \ String.literal \ assn\ where + \string_assn \ pure string_rel\ + +lemma eq_string_eq: + \((=), (=)) \ string_rel \ string_rel \ bool_rel\ + by (auto intro!: frefI simp: string_rel_def String.less_literal_def + less_than_char_def rel2p_def literal.explode_inject) + +lemmas eq_string_eq_hnr = + eq_string_eq[sepref_import_param] + +definition string2_rel :: \(string \ string) set\ where + \string2_rel \ \Id\list_rel\ + +abbreviation string2_assn :: \string \ string \ assn\ where + \string2_assn \ pure string2_rel\ + +abbreviation monom_rel where + \monom_rel \ \string_rel\list_rel\ + +abbreviation monom_assn where + \monom_assn \ list_assn string_assn\ + +abbreviation monomial_rel where + \monomial_rel \ monom_rel \\<^sub>r int_rel\ + +abbreviation monomial_assn where + \monomial_assn \ monom_assn \\<^sub>a int_assn\ + +abbreviation poly_rel where + \poly_rel \ \monomial_rel\list_rel\ + + +abbreviation poly_assn where + \poly_assn \ list_assn monomial_assn\ + +lemma poly_assn_alt_def: + \poly_assn = pure poly_rel\ + by (simp add: list_assn_pure_conv) + +abbreviation polys_assn where + \polys_assn \ hm_fmap_assn uint64_nat_assn poly_assn\ + +lemma string_rel_string_assn: + \(\ ((c, a) \ string_rel)) = string_assn a c\ + by (auto simp: pure_app_eq) + +lemma single_valued_string_rel: + \single_valued string_rel\ + by (auto simp: single_valued_def string_rel_def) + +lemma IS_LEFT_UNIQUE_string_rel: + \IS_LEFT_UNIQUE string_rel\ + by (auto simp: IS_LEFT_UNIQUE_def single_valued_def string_rel_def + literal.explode_inject) + +lemma IS_RIGHT_UNIQUE_string_rel: + \IS_RIGHT_UNIQUE string_rel\ + by (auto simp: single_valued_def string_rel_def + literal.explode_inject) + +lemma single_valued_monom_rel: \single_valued monom_rel\ + by (rule list_rel_sv) + (auto intro!: frefI simp: string_rel_def + rel2p_def single_valued_def p2rel_def) + +lemma single_valued_monomial_rel: + \single_valued monomial_rel\ + using single_valued_monom_rel + by (auto intro!: frefI simp: + rel2p_def single_valued_def p2rel_def) + +lemma single_valued_monom_rel': \IS_LEFT_UNIQUE monom_rel\ + unfolding IS_LEFT_UNIQUE_def inv_list_rel_eq string2_rel_def + by (rule list_rel_sv)+ + (auto intro!: frefI simp: string_rel_def + rel2p_def single_valued_def p2rel_def literal.explode_inject) + + +lemma single_valued_monomial_rel': + \IS_LEFT_UNIQUE monomial_rel\ + using single_valued_monom_rel' + unfolding IS_LEFT_UNIQUE_def inv_list_rel_eq + by (auto intro!: frefI simp: + rel2p_def single_valued_def p2rel_def) + +lemma [safe_constraint_rules]: + \Sepref_Constraints.CONSTRAINT single_valued string_rel\ + \Sepref_Constraints.CONSTRAINT IS_LEFT_UNIQUE string_rel\ + by (auto simp: CONSTRAINT_def single_valued_def + string_rel_def IS_LEFT_UNIQUE_def literal.explode_inject) + +lemma eq_string_monom_hnr[sepref_fr_rules]: + \(uncurry (return oo (=)), uncurry (RETURN oo (=))) \ monom_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \\<^sub>a bool_assn\ + using single_valued_monom_rel' single_valued_monom_rel + unfolding list_assn_pure_conv + by sepref_to_hoare + (sep_auto simp: list_assn_pure_conv string_rel_string_assn + single_valued_def IS_LEFT_UNIQUE_def + dest!: mod_starD + simp flip: inv_list_rel_eq) + + +definition term_order_rel' where + [simp]: \term_order_rel' x y = ((x, y) \ term_order_rel)\ + +lemma term_order_rel[def_pat_rules]: + \(\)$(x,y)$term_order_rel \ term_order_rel'$x$y\ + by auto + +lemma term_order_rel_alt_def: + \term_order_rel = lexord (p2rel char.lexordp)\ + by (auto simp: p2rel_def char.lexordp_conv_lexord var_order_rel_def intro!: arg_cong[of _ _ lexord]) + + +instantiation char :: linorder +begin + definition less_char where [symmetric, simp]: "less_char = PAC_Polynomials_Term.less_char" + definition less_eq_char where [symmetric, simp]: "less_eq_char = PAC_Polynomials_Term.less_eq_char" +instance + apply standard + using char.linorder_axioms + by (auto simp: class.linorder_def class.order_def class.preorder_def + less_eq_char_def less_than_char_def class.order_axioms_def + class.linorder_axioms_def p2rel_def less_char_def) +end + + +instantiation list :: (linorder) linorder +begin + definition less_list where "less_list = lexordp (<)" + definition less_eq_list where "less_eq_list = lexordp_eq" + +instance +proof standard + have [dest]: \\x y :: 'a :: linorder list. (x, y) \ lexord {(x, y). x < y} \ + lexordp_eq y x \ False\ + by (metis lexordp_antisym lexordp_conv_lexord lexordp_eq_conv_lexord) + have [simp]: \\x y :: 'a :: linorder list. lexordp_eq x y \ + \ lexordp_eq y x \ + (x, y) \ lexord {(x, y). x < y}\ + using lexordp_conv_lexord lexordp_conv_lexordp_eq by blast + show + \(x < y) = Restricted_Predicates.strict (\) x y\ + \x \ x\ + \x \ y \ y \ z \ x \ z\ + \x \ y \ y \ x \ x = y\ + \x \ y \ y \ x\ + for x y z :: \'a :: linorder list\ + by (auto simp: less_list_def less_eq_list_def List.lexordp_def + lexordp_conv_lexord lexordp_into_lexordp_eq lexordp_antisym + antisym_def lexordp_eq_refl lexordp_eq_linear intro: lexordp_eq_trans + dest: lexordp_eq_antisym) +qed + +end + + +lemma term_order_rel'_alt_def_lexord: + \term_order_rel' x y = ord_class.lexordp x y\ and + term_order_rel'_alt_def: + \term_order_rel' x y \ x < y\ +proof - + show + \term_order_rel' x y = ord_class.lexordp x y\ + \term_order_rel' x y \ x < y\ + unfolding less_than_char_of_char[symmetric, abs_def] + by (auto simp: lexordp_conv_lexord less_eq_list_def + less_list_def lexordp_def var_order_rel_def + rel2p_def term_order_rel_alt_def p2rel_def) +qed + +lemma list_rel_list_rel_order_iff: + assumes \(a, b) \ \string_rel\list_rel\ \(a', b') \ \string_rel\list_rel\ + shows \a < a' \ b < b'\ +proof + have H: \(a, b) \ \string_rel\list_rel \ + (a, cs) \ \string_rel\list_rel \ b = cs\ for cs + using single_valued_monom_rel' IS_RIGHT_UNIQUE_string_rel + unfolding string2_rel_def + by (subst (asm)list_rel_sv_iff[symmetric]) + (auto simp: single_valued_def) + assume \a < a'\ + then consider + u u' where \a' = a @ u # u'\ | + u aa v w aaa where \a = u @ aa # v\ \a' = u @ aaa # w\ \aa < aaa\ + by (subst (asm) less_list_def) + (auto simp: lexord_def List.lexordp_def + list_rel_append1 list_rel_split_right_iff) + then show \b < b'\ + proof cases + case 1 + then show \b < b'\ + using assms + by (subst less_list_def) + (auto simp: lexord_def List.lexordp_def + list_rel_append1 list_rel_split_right_iff dest: H) + next + case 2 + then obtain u' aa' v' w' aaa' where + \b = u' @ aa' # v'\ \b' = u' @ aaa' # w'\ + \(aa, aa') \ string_rel\ + \(aaa, aaa') \ string_rel\ + using assms + by (smt list_rel_append1 list_rel_split_right_iff single_valued_def single_valued_monom_rel) + with \aa < aaa\ have \aa' < aaa'\ + by (auto simp: string_rel_def less_literal.rep_eq less_list_def + lexordp_conv_lexord lexordp_def char.lexordp_conv_lexord + simp flip: lexord_code less_char_def + PAC_Polynomials_Term.less_char_def) + then show \b < b'\ + using \b = u' @ aa' # v'\ \b' = u' @ aaa' # w'\ + by (subst less_list_def) + (fastforce simp: lexord_def List.lexordp_def + list_rel_append1 list_rel_split_right_iff) + qed +next + have H: \(a, b) \ \string_rel\list_rel \ + (a', b) \ \string_rel\list_rel \ a = a'\ for a a' b + using single_valued_monom_rel' + by (auto simp: single_valued_def IS_LEFT_UNIQUE_def + simp flip: inv_list_rel_eq) + assume \b < b'\ + then consider + u u' where \b' = b @ u # u'\ | + u aa v w aaa where \b = u @ aa # v\ \b' = u @ aaa # w\ \aa < aaa\ + by (subst (asm) less_list_def) + (auto simp: lexord_def List.lexordp_def + list_rel_append1 list_rel_split_right_iff) + then show \a < a'\ + proof cases + case 1 + then show \a < a'\ + using assms + by (subst less_list_def) + (auto simp: lexord_def List.lexordp_def + list_rel_append2 list_rel_split_left_iff dest: H) + next + case 2 + then obtain u' aa' v' w' aaa' where + \a = u' @ aa' # v'\ \a' = u' @ aaa' # w'\ + \(aa', aa) \ string_rel\ + \(aaa', aaa) \ string_rel\ + using assms + by (auto simp: lexord_def List.lexordp_def + list_rel_append2 list_rel_split_left_iff dest: H) + with \aa < aaa\ have \aa' < aaa'\ + by (auto simp: string_rel_def less_literal.rep_eq less_list_def + lexordp_conv_lexord lexordp_def char.lexordp_conv_lexord + simp flip: lexord_code less_char_def + PAC_Polynomials_Term.less_char_def) + then show \a < a'\ + using \a = u' @ aa' # v'\ \a' = u' @ aaa' # w'\ + by (subst less_list_def) + (fastforce simp: lexord_def List.lexordp_def + list_rel_append1 list_rel_split_right_iff) + qed +qed + + +lemma string_rel_le[sepref_import_param]: + shows \((<), (<)) \ \string_rel\list_rel \ \string_rel\list_rel \ bool_rel\ + by (auto intro!: fun_relI simp: list_rel_list_rel_order_iff) + +(* TODO Move *) +lemma [sepref_import_param]: + assumes \CONSTRAINT IS_LEFT_UNIQUE R\ \CONSTRAINT IS_RIGHT_UNIQUE R\ + shows \(remove1, remove1) \ R \ \R\list_rel \ \R\list_rel\ + apply (intro fun_relI) + subgoal premises p for x y xs ys + using p(2) p(1) assms + by (induction xs ys rule: list_rel_induct) + (auto simp: IS_LEFT_UNIQUE_def single_valued_def) + done + +instantiation pac_step :: (heap, heap, heap) heap +begin + +instance +proof standard + obtain f :: \'a \ nat\ where + f: \inj f\ + by blast + obtain g :: \nat \ nat \ nat \ nat \ nat \ nat\ where + g: \inj g\ + by blast + obtain h :: \'b \ nat\ where + h: \inj h\ + by blast + obtain i :: \'c \ nat\ where + i: \inj i\ + by blast + have [iff]: \g a = g b \ a = b\\h a'' = h b'' \ a'' = b''\ \f a' = f b' \ a' = b'\ + \i a''' = i b''' \ a''' = b'''\ for a b a' b' a'' b'' a''' b''' + using f g h i unfolding inj_def by blast+ + let ?f = \\x :: ('a, 'b, 'c) pac_step. + g (case x of + Add a b c d \ (0, i a, i b, i c, f d) + | Del a \ (1, i a, 0, 0, 0) + | Mult a b c d \ (2, i a, f b, i c, f d) + | Extension a b c \ (3, i a, f c, 0, h b))\ + have \inj ?f\ + apply (auto simp: inj_def) + apply (case_tac x; case_tac y) + apply auto + done + then show \\f :: ('a, 'b, 'c) pac_step \ nat. inj f\ + by blast +qed + +end + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Checker_Specification.thy b/thys/PAC_Checker/PAC_Checker_Specification.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker_Specification.thy @@ -0,0 +1,853 @@ +(* + File: PAC_Checker_Specification.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker_Specification + imports PAC_Specification + Refine_Imperative_HOL.IICF + Finite_Map_Multiset +begin + +section \Checker Algorithm\ + + +text \ + +In this level of refinement, we define the first level of the +implementation of the checker, both with the specification as +on ideals and the first version of the loop. + +\ + +subsection \Specification\ + +datatype status = + is_failed: FAILED | + is_success: SUCCESS | + is_found: FOUND + +lemma is_success_alt_def: + \is_success a \ a = SUCCESS\ + by (cases a) auto + +datatype ('a, 'b, 'lbls) pac_step = + Add (pac_src1: 'lbls) (pac_src2: 'lbls) (new_id: 'lbls) (pac_res: 'a) | + Mult (pac_src1: 'lbls) (pac_mult: 'a) (new_id: 'lbls) (pac_res: 'a) | + Extension (new_id: 'lbls) (new_var: 'b) (pac_res: 'a) | + Del (pac_src1: 'lbls) + +type_synonym pac_state = \(nat set \ int_poly multiset)\ + +definition PAC_checker_specification + :: \int_poly \ int_poly multiset \ (status \ nat set \ int_poly multiset) nres\ +where + \PAC_checker_specification spec A = SPEC(\(b, \, B). + (\is_failed b \ restricted_ideal_to\<^sub>I (\(vars ` set_mset A) \ vars spec) B \ restricted_ideal_to\<^sub>I (\(vars ` set_mset A) \ vars spec) A) \ + (is_found b \ spec \ pac_ideal (set_mset A)))\ + +definition PAC_checker_specification_spec + :: \int_poly \ pac_state \ (status \ pac_state) \ bool\ +where + \PAC_checker_specification_spec spec = (\(\, A) (b, B). (\is_failed b \ \(vars ` set_mset A) \ \) \ + (is_success b \ PAC_Format\<^sup>*\<^sup>* (\, A) B) \ + (is_found b \ PAC_Format\<^sup>*\<^sup>* (\, A) B \ spec \ pac_ideal (set_mset A)))\ + +abbreviation PAC_checker_specification2 + :: \int_poly \ (nat set \ int_poly multiset) \ (status \ (nat set \ int_poly multiset)) nres\ +where + \PAC_checker_specification2 spec A \ SPEC(PAC_checker_specification_spec spec A)\ + + +definition PAC_checker_specification_step_spec + :: \pac_state \ int_poly \ pac_state \ (status \ pac_state) \ bool\ +where + \PAC_checker_specification_step_spec = (\(\\<^sub>0, A\<^sub>0) spec (\, A) (b, B). + (is_success b \ + \(vars ` set_mset A\<^sub>0) \ \\<^sub>0 \ + \(vars ` set_mset A) \ \ \ PAC_Format\<^sup>*\<^sup>* (\\<^sub>0, A\<^sub>0) (\, A) \ PAC_Format\<^sup>*\<^sup>* (\, A) B) \ + (is_found b \ + \(vars ` set_mset A\<^sub>0) \ \\<^sub>0 \ + \(vars ` set_mset A) \ \ \ PAC_Format\<^sup>*\<^sup>* (\\<^sub>0, A\<^sub>0) (\, A) \ PAC_Format\<^sup>*\<^sup>* (\, A) B \ + spec \ pac_ideal (set_mset A\<^sub>0)))\ + +abbreviation PAC_checker_specification_step2 + :: \pac_state \ int_poly \ pac_state \ (status \ pac_state) nres\ +where + \PAC_checker_specification_step2 A\<^sub>0 spec A \ SPEC(PAC_checker_specification_step_spec A\<^sub>0 spec A)\ + + +definition normalize_poly_spec :: \_\ where + \normalize_poly_spec p = SPEC (\r. p - r \ ideal polynomial_bool \ vars r \ vars p)\ + +lemma normalize_poly_spec_alt_def: + \normalize_poly_spec p = SPEC (\r. r - p \ ideal polynomial_bool \ vars r \ vars p)\ + unfolding normalize_poly_spec_def + by (auto dest: ideal.span_neg) + +definition mult_poly_spec :: \int mpoly \ int mpoly \ int mpoly nres\ where + \mult_poly_spec p q = SPEC (\r. p * q - r \ ideal polynomial_bool)\ + +definition check_add :: \(nat, int mpoly) fmap \ nat set \ nat \ nat \ nat \ int mpoly \ bool nres\ where + \check_add A \ p q i r = + SPEC(\b. b \ p \# dom_m A \ q \# dom_m A \ i \# dom_m A \ vars r \ \ \ + the (fmlookup A p) + the (fmlookup A q) - r \ ideal polynomial_bool)\ + +definition check_mult :: \(nat, int mpoly) fmap \ nat set \ nat \ int mpoly \ nat \ int mpoly \ bool nres\ where + \check_mult A \ p q i r = + SPEC(\b. b \ p \# dom_m A \i \# dom_m A \ vars q \ \ \ vars r \ \ \ + the (fmlookup A p) * q - r \ ideal polynomial_bool)\ + +definition check_extension :: \(nat, int mpoly) fmap \ nat set \ nat \ nat \ int mpoly \ (bool) nres\ where + \check_extension A \ i v p = + SPEC(\b. b \ (i \# dom_m A \ + (v \ \ \ + (p+Var v)\<^sup>2 - (p+Var v) \ ideal polynomial_bool \ + vars (p+Var v) \ \)))\ + +fun merge_status where + \merge_status (FAILED) _ = FAILED\ | + \merge_status _ (FAILED) = FAILED\ | + \merge_status FOUND _ = FOUND\ | + \merge_status _ FOUND = FOUND\ | + \merge_status _ _ = SUCCESS\ + +type_synonym fpac_step = \nat set \ (nat, int_poly) fmap\ + +definition check_del :: \(nat, int mpoly) fmap \ nat \ bool nres\ where + \check_del A p = + SPEC(\b. b \ True)\ + + +subsection \Algorithm\ + +definition PAC_checker_step + :: \int_poly \ (status \ fpac_step) \ (int_poly, nat, nat) pac_step \ + (status \ fpac_step) nres\ +where + \PAC_checker_step = (\spec (stat, (\, A)) st. case st of + Add _ _ _ _ \ + do { + r \ normalize_poly_spec (pac_res st); + eq \ check_add A \ (pac_src1 st) (pac_src2 st) (new_id st) r; + st' \ SPEC(\st'. (\is_failed st' \ is_found st' \ r - spec \ ideal polynomial_bool)); + if eq + then RETURN (merge_status stat st', + \, fmupd (new_id st) r A) + else RETURN (FAILED, (\, A)) + } + | Del _ \ + do { + eq \ check_del A (pac_src1 st); + if eq + then RETURN (stat, (\, fmdrop (pac_src1 st) A)) + else RETURN (FAILED, (\, A)) + } + | Mult _ _ _ _ \ + do { + r \ normalize_poly_spec (pac_res st); + q \ normalize_poly_spec (pac_mult st); + eq \ check_mult A \ (pac_src1 st) q (new_id st) r; + st' \ SPEC(\st'. (\is_failed st' \ is_found st' \ r - spec \ ideal polynomial_bool)); + if eq + then RETURN (merge_status stat st', + \, fmupd (new_id st) r A) + else RETURN (FAILED, (\, A)) + } + | Extension _ _ _ \ + do { + r \ normalize_poly_spec (pac_res st - Var (new_var st)); + (eq) \ check_extension A \ (new_id st) (new_var st) r; + if eq + then do { + RETURN (stat, + insert (new_var st) \, fmupd (new_id st) (r) A)} + else RETURN (FAILED, (\, A)) + } + )\ + +definition polys_rel :: \((nat, int mpoly)fmap \ _) set\ where +\polys_rel = {(A, B). B = (ran_m A)}\ + +definition polys_rel_full :: \((nat set \ (nat, int mpoly)fmap) \ _) set\ where + \polys_rel_full = {((\, A), (\' , B)). (A, B) \ polys_rel \ \ = \'}\ + +lemma polys_rel_update_remove: + \x13 \#dom_m A \ x11 \# dom_m A \ x12 \# dom_m A \ x11 \ x12 \ (A,B) \ polys_rel \ + (fmupd x13 r (fmdrop x11 (fmdrop x12 A)), + add_mset r B - {#the (fmlookup A x11), the (fmlookup A x12)#}) + \ polys_rel\ + \x13 \#dom_m A \ x11 \# dom_m A \ (A,B) \ polys_rel \ + (fmupd x13 r (fmdrop x11 A),add_mset r B - {#the (fmlookup A x11)#}) + \ polys_rel\ + \x13 \#dom_m A \ (A,B) \ polys_rel \ + (fmupd x13 r A, add_mset r B) \ polys_rel\ + \x13 \#dom_m A \ (A,B) \ polys_rel \ + (fmdrop x13 A, remove1_mset (the (fmlookup A x13)) B) \ polys_rel\ + using distinct_mset_dom[of A] + apply (auto simp: polys_rel_def ran_m_mapsto_upd ran_m_mapsto_upd_notin + ran_m_fmdrop) + apply (subst ran_m_mapsto_upd_notin) + apply (auto dest: in_diffD dest!: multi_member_split simp: ran_m_fmdrop ran_m_fmdrop_If distinct_mset_remove1_All ran_m_def + add_mset_eq_add_mset removeAll_notin + split: if_splits intro!: image_mset_cong) + done + +lemma polys_rel_in_dom_inD: + \(A, B) \ polys_rel \ + x12 \# dom_m A \ + the (fmlookup A x12) \# B\ + by (auto simp: polys_rel_def) + +lemma PAC_Format_add_and_remove: + \r - x14 \ More_Modules.ideal polynomial_bool \ + (A, B) \ polys_rel \ + x12 \# dom_m A \ + x13 \# dom_m A \ + vars r \ \ \ + 2 * the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + PAC_Format\<^sup>*\<^sup>* (\, B) (\, remove1_mset (the (fmlookup A x12)) (add_mset r B))\ + \r - x14 \ More_Modules.ideal polynomial_bool \ + (A, B) \ polys_rel \ + the (fmlookup A x11) + the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + x11 \# dom_m A \ + x12 \# dom_m A \ + vars r \ \ \ + PAC_Format\<^sup>*\<^sup>* (\, B) (\, add_mset r B)\ + \r - x14 \ More_Modules.ideal polynomial_bool \ + (A, B) \ polys_rel \ + x11 \# dom_m A \ + x12 \# dom_m A \ + the (fmlookup A x11) + the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + vars r \ \ \ + x11 \ x12 \ + PAC_Format\<^sup>*\<^sup>* (\, B) + (\, add_mset r B - {#the (fmlookup A x11), the (fmlookup A x12)#})\ + \(A, B) \ polys_rel \ + r - x34 \ More_Modules.ideal polynomial_bool \ + x11 \# dom_m A \ + the (fmlookup A x11) * x32 - r \ More_Modules.ideal polynomial_bool \ + vars x32 \ \ \ + vars r \ \ \ + PAC_Format\<^sup>*\<^sup>* (\, B) (\, add_mset r B)\ + \(A, B) \ polys_rel \ + r - x34 \ More_Modules.ideal polynomial_bool \ + x11 \# dom_m A \ + the (fmlookup A x11) * x32 - r \ More_Modules.ideal polynomial_bool \ + vars x32 \ \ \ + vars r \ \ \ + PAC_Format\<^sup>*\<^sup>* (\, B) (\, remove1_mset (the (fmlookup A x11)) (add_mset r B))\ + \(A, B) \ polys_rel \ + x12 \# dom_m A \ + PAC_Format\<^sup>*\<^sup>* (\, B) (\, remove1_mset (the (fmlookup A x12)) B)\ + \(A, B) \ polys_rel \ + (p' + Var x)\<^sup>2 - (p' + Var x) \ ideal polynomial_bool \ + x \ \ \ + x \ vars(p' + Var x) \ + vars(p' + Var x) \ \ \ + PAC_Format\<^sup>*\<^sup>* (\, B) + (insert x \, add_mset p' B)\ + subgoal + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.add[of \the (fmlookup A x12)\ B \the (fmlookup A x12)\]) + apply (auto dest: polys_rel_in_dom_inD) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.del[of \the (fmlookup A x12)\]) + apply (auto dest: polys_rel_in_dom_inD) + done + subgoal H2 + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.add[of \the (fmlookup A x11)\ B \the (fmlookup A x12)\]) + apply (auto dest: polys_rel_in_dom_inD) + done + subgoal + apply (rule rtranclp_trans) + apply (rule H2; assumption) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.del[of \the (fmlookup A x12)\]) + apply (auto dest: polys_rel_in_dom_inD) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.del[of \the (fmlookup A x11)\]) + apply (auto dest: polys_rel_in_dom_inD) + apply (auto simp: polys_rel_def ran_m_def add_mset_eq_add_mset dest!: multi_member_split) + done + subgoal H2 + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.mult[of \the (fmlookup A x11)\ B \x32\ r]) + apply (auto dest: polys_rel_in_dom_inD) + done + subgoal + apply (rule rtranclp_trans) + apply (rule H2; assumption) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.del[of \the (fmlookup A x11)\]) + apply (auto dest: polys_rel_in_dom_inD) + done + subgoal + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.del[of \the (fmlookup A x12)\ B]) + apply (auto dest: polys_rel_in_dom_inD) + done + subgoal + apply (rule converse_rtranclp_into_rtranclp) + apply (rule PAC_Format.extend_pos[of \p' + Var x\ _ x]) + using coeff_monomila_in_varsD[of \p' - Var x\ x] + apply (auto dest: polys_rel_in_dom_inD simp: vars_in_right_only vars_subst_in_left_only) + apply (subgoal_tac \\ \ {x' \ vars (p'). x' \ \} = insert x \\) + apply simp + using coeff_monomila_in_varsD[of p' x] + apply (auto dest: vars_add_Var_subset vars_minus_Var_subset polys_rel_in_dom_inD simp: vars_subst_in_left_only_iff) + using vars_in_right_only vars_subst_in_left_only by force + done + + +abbreviation status_rel :: \(status \ status) set\ where + \status_rel \ Id\ + +lemma is_merge_status[simp]: + \is_failed (merge_status a st') \ is_failed a \ is_failed st'\ + \is_found (merge_status a st') \ \is_failed a \ \is_failed st' \ (is_found a \ is_found st')\ + \is_success (merge_status a st') \ (is_success a \ is_success st')\ + by (cases a; cases st'; auto; fail)+ + +lemma status_rel_merge_status: + \(merge_status a b, SUCCESS) \ status_rel \ + (a = FAILED) \ (b = FAILED) \ + a = FOUND \ (b = FOUND)\ + by (cases a; cases b; auto) + +lemma Ex_status_iff: + \(\a. P a) \ P SUCCESS \ P FOUND \ (P (FAILED))\ + apply auto + apply (case_tac a; auto) + done + +lemma is_failed_alt_def: + \is_failed st' \ \is_success st' \ \is_found st'\ + by (cases st') auto + +lemma merge_status_eq_iff[simp]: + \merge_status a SUCCESS = SUCCESS \ a = SUCCESS\ + \merge_status a SUCCESS = FOUND \ a = FOUND\ + \merge_status SUCCESS a = SUCCESS \ a = SUCCESS\ + \merge_status SUCCESS a = FOUND \ a = FOUND\ + \merge_status SUCCESS a = FAILED \ a = FAILED\ + \merge_status a SUCCESS = FAILED \ a = FAILED\ + \merge_status FOUND a = FAILED \ a = FAILED\ + \merge_status a FOUND = FAILED \ a = FAILED\ + \merge_status a FOUND = SUCCESS \ False\ + \merge_status a b = FOUND \ (a = FOUND \ b = FOUND) \ (a \ FAILED \ b \ FAILED)\ + apply (cases a; auto; fail)+ + apply (cases a; cases b; auto; fail)+ + done + +lemma fmdrop_irrelevant: \x11 \# dom_m A \ fmdrop x11 A = A\ + by (simp add: fmap_ext in_dom_m_lookup_iff) + +lemma PAC_checker_step_PAC_checker_specification2: + fixes a :: \status\ + assumes AB: \((\, A),(\\<^sub>B, B)) \ polys_rel_full\ and + \\is_failed a\ and + [simp,intro]: \a = FOUND \ spec \ pac_ideal (set_mset A\<^sub>0)\ and + A\<^sub>0B: \PAC_Format\<^sup>*\<^sup>* (\\<^sub>0, A\<^sub>0) (\, B)\ and + spec\<^sub>0: \vars spec \ \\<^sub>0\ and + vars_A\<^sub>0: \\ (vars ` set_mset A\<^sub>0) \ \\<^sub>0\ + shows \PAC_checker_step spec (a, (\, A)) st \ \ (status_rel \\<^sub>r polys_rel_full) (PAC_checker_specification_step2 (\\<^sub>0, A\<^sub>0) spec (\, B))\ +proof - + have + \\\<^sub>B = \\and + [simp, intro]:\(A, B) \ polys_rel\ + using AB + by (auto simp: polys_rel_full_def) + have H0: \2 * the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + r \ pac_ideal + (insert (the (fmlookup A x12)) + ((\x. the (fmlookup A x)) ` set_mset Aa))\ for x12 r Aa + by (metis (no_types, lifting) ab_semigroup_mult_class.mult.commute + diff_in_polynomial_bool_pac_idealI + ideal.span_base pac_idealI3 set_image_mset set_mset_add_mset_insert union_single_eq_member)+ + then have H0': \\Aa. 2 * the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + r - spec \ More_Modules.ideal polynomial_bool \ + spec \ pac_ideal (insert (the (fmlookup A x12)) ((\x. the (fmlookup A x)) ` set_mset Aa))\ + for r x12 + by (metis (no_types, lifting) diff_in_polynomial_bool_pac_idealI) + + have H1: \ x12 \# dom_m A \ + 2 * the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + r - spec \ More_Modules.ideal polynomial_bool \ + vars spec \ vars r \ + spec \ pac_ideal (set_mset B)\ for x12 r + using \(A,B) \ polys_rel\ + ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg, + of \the (fmlookup A x12)\ _ \the (fmlookup A x12)\], + of \set_mset B \ polynomial_bool\ \2 * the (fmlookup A x12) - r\] + unfolding polys_rel_def + by (auto dest!: multi_member_split simp: ran_m_def + intro: H0') + have H2': \the (fmlookup A x11) + the (fmlookup A x12) - r \ More_Modules.ideal polynomial_bool \ + B = add_mset (the (fmlookup A x11)) {#the (fmlookup A x). x \# Aa#} \ + (the (fmlookup A x11) + the (fmlookup A x12) - r + \ More_Modules.ideal + (insert (the (fmlookup A x11)) + ((\x. the (fmlookup A x)) ` set_mset Aa \ polynomial_bool)) \ + - r + \ More_Modules.ideal + (insert (the (fmlookup A x11)) + ((\x. the (fmlookup A x)) ` set_mset Aa \ polynomial_bool))) \ + r \ pac_ideal (insert (the (fmlookup A x11)) ((\x. the (fmlookup A x)) ` set_mset Aa))\ + for r x12 x11 A Aa + by (metis (mono_tags, lifting) Un_insert_left diff_diff_eq2 diff_in_polynomial_bool_pac_idealI diff_zero + ideal.span_diff ideal.span_neg minus_diff_eq pac_idealI1 pac_ideal_def set_image_mset + set_mset_add_mset_insert union_single_eq_member) + have H2: \x11 \# dom_m A \ + x12 \# dom_m A \ + the (fmlookup A x11) + the (fmlookup A x12) - r + \ More_Modules.ideal polynomial_bool \ + r - spec \ More_Modules.ideal polynomial_bool \ + spec \ pac_ideal (set_mset B)\ for x12 r x11 + using \(A,B) \ polys_rel\ + ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg, + of \the (fmlookup A x11)\ _ \the (fmlookup A x12)\], + of \set_mset B \ polynomial_bool\ \the (fmlookup A x11) + the (fmlookup A x12) - r\] + unfolding polys_rel_def + by (subgoal_tac \r \ pac_ideal (set_mset B)\) + (auto dest!: multi_member_split simp: ran_m_def ideal.span_base + intro: diff_in_polynomial_bool_pac_idealI simp: H2') + + have H3': \the (fmlookup A x12) * q - r \ More_Modules.ideal polynomial_bool \ + r - spec \ More_Modules.ideal polynomial_bool \ + r \ pac_ideal (insert (the (fmlookup A x12)) ((\x. the (fmlookup A x)) ` set_mset Aa))\ + for Aa x12 r q + by (metis (no_types, lifting) ab_semigroup_mult_class.mult.commute diff_in_polynomial_bool_pac_idealI + ideal.span_base pac_idealI3 set_image_mset set_mset_add_mset_insert union_single_eq_member) + + have H3: \x12 \# dom_m A \ + the (fmlookup A x12) * q - r \ More_Modules.ideal polynomial_bool \ + r - spec \ More_Modules.ideal polynomial_bool \ + spec \ pac_ideal (set_mset B)\ for x12 r q + using \(A,B) \ polys_rel\ + ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg, + of \the (fmlookup A x12)\ _ \the (fmlookup A x12)\], + of \set_mset B \ polynomial_bool\ \2 * the (fmlookup A x12) - r\] + unfolding polys_rel_def + by (subgoal_tac \r \ pac_ideal (set_mset B)\) + (auto dest!: multi_member_split simp: ran_m_def H3' + intro: diff_in_polynomial_bool_pac_idealI) + + have [intro]: \spec \ pac_ideal (set_mset B) \ spec \ pac_ideal (set_mset A\<^sub>0)\ and + vars_B: \\ (vars ` set_mset B) \ \\and + vars_B: \\ (vars ` set_mset (ran_m A)) \ \\ + using rtranclp_PAC_Format_subset_ideal[OF A\<^sub>0B vars_A\<^sub>0] spec\<^sub>0 \(A, B) \ polys_rel\[unfolded polys_rel_def, simplified] + by (smt in_mono mem_Collect_eq restricted_ideal_to_def)+ + + have eq_successI: \st' \ FAILED \ + st' \ FOUND \ st' = SUCCESS\ for st' + by (cases st') auto + have vars_diff_inv: \vars (Var x2 - r) = vars (r - Var x2 :: int mpoly)\ for x2 r + using vars_uminus[of \Var x2 - r\] + by (auto simp del: vars_uminus) + have vars_add_inv: \vars (Var x2 + r) = vars (r + Var x2 :: int mpoly)\ for x2 r + unfolding add.commute[of \Var x2\ r] .. + + have [iff]: \a \ FAILED\ and + [intro]: \a \ SUCCESS \ a = FOUND\ and + [simp]: \merge_status a FOUND = FOUND\ + using assms(2) by (cases a; auto)+ + note [[goals_limit=1]] + show ?thesis + unfolding PAC_checker_step_def PAC_checker_specification_step_spec_def + normalize_poly_spec_alt_def check_mult_def check_add_def + check_extension_def polys_rel_full_def + apply (cases st) + apply clarsimp_all + subgoal for x11 x12 x13 x14 + apply (refine_vcg lhs_step_If) + subgoal for r eqa st' + using assms vars_B apply - + apply (rule RETURN_SPEC_refine) + apply (rule_tac x = \(merge_status a st',\,add_mset r B)\ in exI) + by (auto simp: polys_rel_update_remove ran_m_mapsto_upd_notin + intro: PAC_Format_add_and_remove H2 dest: rtranclp_PAC_Format_subset_ideal) + subgoal + by (rule RETURN_SPEC_refine) + (auto simp: Ex_status_iff dest: rtranclp_PAC_Format_subset_ideal) + done + subgoal for x11 x12 x13 x14 + apply (refine_vcg lhs_step_If) + subgoal for r q eqa st' + using assms vars_B apply - + apply (rule RETURN_SPEC_refine) + apply (rule_tac x = \(merge_status a st',\,add_mset r B)\ in exI) + by (auto intro: polys_rel_update_remove intro: PAC_Format_add_and_remove(3-) H3 + dest: rtranclp_PAC_Format_subset_ideal) + subgoal + by (rule RETURN_SPEC_refine) + (auto simp: Ex_status_iff) + done + subgoal for x31 x32 x34 + apply (refine_vcg lhs_step_If) + subgoal for r x + using assms vars_B apply - + apply (rule RETURN_SPEC_refine) + apply (rule_tac x = \(a,insert x32 \, add_mset r B)\ in exI) + apply (auto simp: intro!: polys_rel_update_remove PAC_Format_add_and_remove(5-) + dest: rtranclp_PAC_Format_subset_ideal) + done + subgoal + by (rule RETURN_SPEC_refine) + (auto simp: Ex_status_iff) + done + subgoal for x11 + unfolding check_del_def + apply (refine_vcg lhs_step_If) + subgoal for eq + using assms vars_B apply - + apply (rule RETURN_SPEC_refine) + apply (cases \x11 \# dom_m A\) + subgoal + apply (rule_tac x = \(a,\, remove1_mset (the (fmlookup A x11)) B)\ in exI) + apply (auto simp: polys_rel_update_remove PAC_Format_add_and_remove + is_failed_def is_success_def is_found_def + dest!: eq_successI + split: if_splits + dest: rtranclp_PAC_Format_subset_ideal + intro: PAC_Format_add_and_remove H3) + done + subgoal + apply (rule_tac x = \(a,\, B)\ in exI) + apply (auto simp: fmdrop_irrelevant + is_failed_def is_success_def is_found_def + dest!: eq_successI + split: if_splits + dest: rtranclp_PAC_Format_subset_ideal + intro: PAC_Format_add_and_remove) + done + done + subgoal + by (rule RETURN_SPEC_refine) + (auto simp: Ex_status_iff) + done + done +qed + + +definition PAC_checker + :: \int_poly \ fpac_step \ status \ (int_poly, nat, nat) pac_step list \ + (status \ fpac_step) nres\ +where + \PAC_checker spec A b st = do { + (S, _) \ WHILE\<^sub>T + (\((b :: status, A :: fpac_step), st). \is_failed b \ st \ []) + (\((bA), st). do { + ASSERT(st \ []); + S \ PAC_checker_step spec (bA) (hd st); + RETURN (S, tl st) + }) + ((b, A), st); + RETURN S + }\ + + +lemma PAC_checker_specification_spec_trans: + \PAC_checker_specification_spec spec A (st, x2) \ + PAC_checker_specification_step_spec A spec x2 (st', x1a) \ + PAC_checker_specification_spec spec A (st', x1a)\ + unfolding PAC_checker_specification_spec_def + PAC_checker_specification_step_spec_def + apply auto +using is_failed_alt_def apply blast+ +done + +lemma RES_SPEC_eq: + \RES \ = SPEC(\P. P \ \)\ + by auto + +lemma is_failed_is_success_completeD: + \\ is_failed x \ \is_success x \ is_found x\ + by (cases x) auto + +lemma PAC_checker_PAC_checker_specification2: + \(A, B) \ polys_rel_full \ + \is_failed a \ + (a = FOUND \ spec \ pac_ideal (set_mset (snd B))) \ + \(vars ` set_mset (ran_m (snd A))) \ fst B \ + vars spec \ fst B \ + PAC_checker spec A a st \ \ (status_rel \\<^sub>r polys_rel_full) (PAC_checker_specification2 spec B)\ + unfolding PAC_checker_def conc_fun_RES + apply (subst RES_SPEC_eq) + apply (refine_vcg WHILET_rule[where + I = \\((bB), st). bB \ (status_rel \\<^sub>r polys_rel_full)\ `` + Collect (PAC_checker_specification_spec spec B)\ + and R = \measure (\(_, st). Suc (length st))\]) + subgoal by auto + subgoal apply (auto simp: PAC_checker_specification_spec_def) + apply (cases B; cases A) + apply (auto simp:polys_rel_def polys_rel_full_def Image_iff) + done + subgoal by auto + subgoal + apply auto + apply (rule + PAC_checker_step_PAC_checker_specification2[of _ _ _ _ _ _ _ \fst B\, THEN order_trans]) + apply assumption + apply assumption + apply (auto intro: PAC_checker_specification_spec_trans simp: conc_fun_RES) + apply (auto simp: PAC_checker_specification_spec_def polys_rel_full_def polys_rel_def + dest: PAC_Format_subset_ideal + dest: is_failed_is_success_completeD; fail)+ + by (auto simp: Image_iff intro: PAC_checker_specification_spec_trans + simp: polys_rel_def polys_rel_full_def) + subgoal + by auto + done + +definition remap_polys_polynomial_bool :: \int mpoly \ nat set \ (nat, int_poly) fmap \ (status \ fpac_step) nres\ where +\remap_polys_polynomial_bool spec = (\\ A. + SPEC(\(st, \', A'). (\is_failed st \ + dom_m A = dom_m A' \ + (\i \# dom_m A. the (fmlookup A i) - the (fmlookup A' i) \ ideal polynomial_bool) \ + \(vars ` set_mset (ran_m A)) \ \' \ + \(vars ` set_mset (ran_m A')) \ \') \ + (st = FOUND \ spec \# ran_m A')))\ + +definition remap_polys_change_all :: \int mpoly \ nat set \ (nat, int_poly) fmap \ (status \ fpac_step) nres\ where +\remap_polys_change_all spec = (\\ A. SPEC (\(st, \', A'). + (\is_failed st \ + pac_ideal (set_mset (ran_m A)) = pac_ideal (set_mset (ran_m A')) \ + \(vars ` set_mset (ran_m A)) \ \' \ + \(vars ` set_mset (ran_m A')) \ \') \ + (st = FOUND \ spec \# ran_m A')))\ + +lemma fmap_eq_dom_iff: + \A = A' \ dom_m A = dom_m A' \ (\i \# dom_m A. the (fmlookup A i) = the (fmlookup A' i))\ + by (metis fmap_ext in_dom_m_lookup_iff option.expand) + +lemma ideal_remap_incl: + \finite A' \ (\a'\A'. \a\A. a-a' \ B) \ ideal (A' \ B) \ ideal (A \ B)\ + apply (induction A' rule: finite_induct) + apply (auto intro: ideal.span_mono) + using ideal.span_mono sup_ge2 apply blast + proof - + fix x :: 'a and F :: "'a set" and xa :: 'a and a :: 'a + assume a1: "a \ A" + assume a2: "a - x \ B" + assume a3: "xa \ More_Modules.ideal (insert x (F \ B))" + assume a4: "More_Modules.ideal (F \ B) \ More_Modules.ideal (A \ B)" + have "x \ More_Modules.ideal (A \ B)" + using a2 a1 by (metis (no_types, lifting) Un_upper1 Un_upper2 add_diff_cancel_left' diff_add_cancel + ideal.module_axioms ideal.span_diff in_mono module.span_superset) + then show "xa \ More_Modules.ideal (A \ B)" + using a4 a3 ideal.span_insert_subset by blast + qed + +lemma pac_ideal_remap_eq: + \dom_m b = dom_m ba \ + \i\#dom_m ba. + the (fmlookup b i) - the (fmlookup ba i) + \ More_Modules.ideal polynomial_bool \ + pac_ideal ((\x. the (fmlookup b x)) ` set_mset (dom_m ba)) = pac_ideal ((\x. the (fmlookup ba x)) ` set_mset (dom_m ba))\ + unfolding pac_ideal_alt_def + apply standard + subgoal + apply (rule ideal_remap_incl) + apply (auto dest!: multi_member_split + dest: ideal.span_neg) + apply (drule ideal.span_neg) + apply auto + done + subgoal + by (rule ideal_remap_incl) + (auto dest!: multi_member_split) + done + +lemma remap_polys_polynomial_bool_remap_polys_change_all: + \remap_polys_polynomial_bool spec \ A \ remap_polys_change_all spec \ A\ + unfolding remap_polys_polynomial_bool_def remap_polys_change_all_def + apply (simp add: ideal.span_zero fmap_eq_dom_iff ideal.span_eq) + apply (auto dest: multi_member_split simp: ran_m_def ideal.span_base pac_ideal_remap_eq + add_mset_eq_add_mset + eq_commute[of \add_mset _ _\ \dom_m (A :: (nat, int mpoly)fmap)\ for A]) + done + + +definition remap_polys :: \int mpoly \ nat set \ (nat, int_poly) fmap \ (status \ fpac_step) nres\ where + \remap_polys spec = (\\ A. do{ + dom \ SPEC(\dom. set_mset (dom_m A) \ dom \ finite dom); + + failed \ SPEC(\_::bool. True); + if failed + then do { + RETURN (FAILED, \, fmempty) + } + else do { + (b, N) \ FOREACH dom + (\i (b, \, A'). + if i \# dom_m A + then do { + p \ SPEC(\p. the (fmlookup A i) - p \ ideal polynomial_bool \ vars p \ vars (the (fmlookup A i))); + eq \ SPEC(\eq. eq \ p = spec); + \ \ SPEC(\\'. \ \ vars (the (fmlookup A i)) \ \'); + RETURN(b \ eq, \, fmupd i p A') + } else RETURN (b, \, A')) + (False, \, fmempty); + RETURN (if b then FOUND else SUCCESS, N) + } + })\ + +lemma remap_polys_spec: + \remap_polys spec \ A \ remap_polys_polynomial_bool spec \ A\ + unfolding remap_polys_def remap_polys_polynomial_bool_def + apply (refine_vcg FOREACH_rule[where + I = \\dom (b, \, A'). + set_mset (dom_m A') = set_mset (dom_m A) - dom \ + (\i \ set_mset (dom_m A) - dom. the (fmlookup A i) - the (fmlookup A' i) \ ideal polynomial_bool) \ + \(vars ` set_mset (ran_m (fmrestrict_set (set_mset (dom_m A')) A))) \ \ \ + \(vars ` set_mset (ran_m A')) \ \ \ + (b \ spec \# ran_m A')\]) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal + by auto + subgoal by auto + subgoal using ideal.span_add by auto + subgoal by auto + subgoal by auto + subgoal by clarsimp auto + subgoal + supply[[goals_limit=1]] + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq) + subgoal + supply[[goals_limit=1]] + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq) + subgoal + by (auto simp: ran_m_mapsto_upd_notin) + subgoal + by auto + subgoal + by auto + subgoal + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq) + subgoal + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq) + subgoal + by auto + subgoal + by (auto simp: distinct_set_mset_eq_iff[symmetric] distinct_mset_dom) + subgoal + by (auto simp: distinct_set_mset_eq_iff[symmetric] distinct_mset_dom) + subgoal + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq + fmlookup_restrict_set_id') + subgoal + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq) + subgoal + by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq + fmlookup_restrict_set_id') + done + + +subsection \Full Checker\ + +definition full_checker + :: \int_poly \ (nat, int_poly) fmap \ (int_poly, nat,nat) pac_step list \ (status \ _) nres\ + where + \full_checker spec0 A pac = do { + spec \ normalize_poly_spec spec0; + (st, \, A) \ remap_polys_change_all spec {} A; + if is_failed st then + RETURN (st, \, A) + else do { + \ \ SPEC(\\'. \ \ vars spec0 \ \'); + PAC_checker spec (\, A) st pac + } +}\ + +lemma restricted_ideal_to_mono: + \restricted_ideal_to\<^sub>I \ I \ restricted_ideal_to\<^sub>I \' J \ + \ \ \ \ + restricted_ideal_to\<^sub>I \ I \ restricted_ideal_to\<^sub>I \ J\ + by (auto simp: restricted_ideal_to_def) + +lemma pac_ideal_idemp: \pac_ideal (pac_ideal A) = pac_ideal A\ + by (metis dual_order.antisym ideal.span_subset_spanI ideal.span_superset le_sup_iff pac_ideal_def) + +lemma full_checker_spec: + assumes \(A, A') \ polys_rel\ + shows + \full_checker spec A pac \ \{((st, G), (st', G')). (st, st') \ status_rel \ + (st \ FAILED \ (G, G') \ polys_rel_full)} + (PAC_checker_specification spec (A'))\ +proof - + have H: \set_mset b \ pac_ideal (set_mset (ran_m A)) \ + x \ pac_ideal (set_mset b) \ x \ pac_ideal (set_mset A')\ for b x + using assms apply - + by (drule pac_ideal_mono) (auto simp: polys_rel_def pac_ideal_idemp) + have 1: \x \ {(st, \', A'). + ( \ is_failed st \ pac_ideal (set_mset (ran_m x2)) = + pac_ideal (set_mset (ran_m A')) \ + \ (vars ` set_mset (ran_m ABC)) \ \' \ + \ (vars ` set_mset (ran_m A')) \ \') \ + (st = FOUND \ speca \# ran_m A')} \ + x = (st, x') \ x' = (\, Aa) \((\', Aa), \', ran_m Aa) \ polys_rel_full\ for Aa speca x2 st x \' \ x' ABC + by (auto simp: polys_rel_def polys_rel_full_def) + have H1: \\a aa b xa x x1a x1 x2 speca. + vars spec \ x1b \ + \ (vars ` set_mset (ran_m A)) \ x1b \ + \ (vars ` set_mset (ran_m x2a)) \ x1b \ + restricted_ideal_to\<^sub>I x1b b \ restricted_ideal_to\<^sub>I x1b (ran_m x2a) \ + xa \ restricted_ideal_to\<^sub>I (\ (vars ` set_mset (ran_m A)) \ vars spec) b \ + xa \ restricted_ideal_to\<^sub>I (\ (vars ` set_mset (ran_m A)) \ vars spec) (ran_m x2a)\ + for x1b b xa x2a + by (drule restricted_ideal_to_mono[of _ _ _ _ \\ (vars ` set_mset (ran_m A)) \ vars spec\]) + auto + have H2: \\a aa b speca x2 x1a x1b x2a. + spec - speca \ More_Modules.ideal polynomial_bool \ + vars spec \ x1b \ + \ (vars ` set_mset (ran_m A)) \ x1b \ + \ (vars ` set_mset (ran_m x2a)) \ x1b \ + speca \ pac_ideal (set_mset (ran_m x2a)) \ + restricted_ideal_to\<^sub>I x1b b \ restricted_ideal_to\<^sub>I x1b (ran_m x2a) \ + spec \ pac_ideal (set_mset (ran_m x2a))\ + by (metis (no_types, lifting) group_eq_aux ideal.span_add ideal.span_base in_mono + pac_ideal_alt_def sup.cobounded2) + + show ?thesis + supply[[goals_limit=1]] + unfolding full_checker_def normalize_poly_spec_def + PAC_checker_specification_def remap_polys_change_all_def + apply (refine_vcg PAC_checker_PAC_checker_specification2[THEN order_trans, of _ _] + lhs_step_If) + subgoal by (auto simp: is_failed_def RETURN_RES_refine_iff) + apply (rule 1; assumption) + subgoal + using fmap_ext assms by (auto simp: polys_rel_def ran_m_def) + subgoal + by auto + subgoal + by auto + subgoal for speca x1 x2 x x1a x2a x1b + apply (rule ref_two_step[OF conc_fun_R_mono]) + apply auto[] + using assms + by (auto simp add: PAC_checker_specification_spec_def conc_fun_RES polys_rel_def H1 H2 + polys_rel_full_def + dest!: rtranclp_PAC_Format_subset_ideal dest: is_failed_is_success_completeD) + done +qed + + +lemma full_checker_spec': + shows + \(uncurry2 full_checker, uncurry2 (\spec A _. PAC_checker_specification spec A)) \ + (Id \\<^sub>r polys_rel) \\<^sub>r Id \\<^sub>f \{((st, G), (st', G')). (st, st') \ status_rel \ + (st \ FAILED \ (G, G') \ polys_rel_full)}\nres_rel\ + using full_checker_spec + by (auto intro!: frefI nres_relI) + +end + diff --git a/thys/PAC_Checker/PAC_Checker_Synthesis.thy b/thys/PAC_Checker/PAC_Checker_Synthesis.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Checker_Synthesis.thy @@ -0,0 +1,924 @@ +(* + File: PAC_Checker_Synthesis.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Checker_Synthesis + imports PAC_Checker WB_Sort PAC_Checker_Relation + PAC_Checker_Init More_Loops PAC_Version +begin + +section \Code Synthesis of the Complete Checker\ + +text \We here combine refine the full checker, using the initialisation provided in another file and +adding more efficient data structures (mostly replacing the set of variables by a more efficient +hash map).\ + +abbreviation vars_assn where + \vars_assn \ hs.assn string_assn\ + +fun vars_of_monom_in where + \vars_of_monom_in [] _ = True\ | + \vars_of_monom_in (x # xs) \ \ x \ \ \ vars_of_monom_in xs \\ + +fun vars_of_poly_in where + \vars_of_poly_in [] _ = True\ | + \vars_of_poly_in ((x, _) # xs) \ \ vars_of_monom_in x \ \ vars_of_poly_in xs \\ + +lemma vars_of_monom_in_alt_def: + \vars_of_monom_in xs \ \ set xs \ \\ + by (induction xs) + auto + +lemma vars_llist_alt_def: + \vars_llist xs \ \ \ vars_of_poly_in xs \\ + by (induction xs) + (auto simp: vars_llist_def vars_of_monom_in_alt_def) + +lemma vars_of_monom_in_alt_def2: + \vars_of_monom_in xs \ \ fold (\x b. b \ x \ \) xs True\ + apply (subst foldr_fold[symmetric]) + subgoal by auto + subgoal by (induction xs) auto + done + +sepref_definition vars_of_monom_in_impl + is \uncurry (RETURN oo vars_of_monom_in)\ + :: \(list_assn string_assn)\<^sup>k *\<^sub>a vars_assn\<^sup>k \\<^sub>a bool_assn\ + unfolding vars_of_monom_in_alt_def2 + by sepref + +declare vars_of_monom_in_impl.refine[sepref_fr_rules] + +lemma vars_of_poly_in_alt_def2: + \vars_of_poly_in xs \ \ fold (\(x, _) b. b \ vars_of_monom_in x \) xs True\ + apply (subst foldr_fold[symmetric]) + subgoal by auto + subgoal by (induction xs) auto + done + + +sepref_definition vars_of_poly_in_impl + is \uncurry (RETURN oo vars_of_poly_in)\ + :: \(poly_assn)\<^sup>k *\<^sub>a vars_assn\<^sup>k \\<^sub>a bool_assn\ + unfolding vars_of_poly_in_alt_def2 + by sepref + +declare vars_of_poly_in_impl.refine[sepref_fr_rules] + + +definition union_vars_monom :: \string list \ string set \ string set\ where +\union_vars_monom xs \ = fold insert xs \\ + +definition union_vars_poly :: \llist_polynomial \ string set \ string set\ where +\union_vars_poly xs \ = fold (\(xs, _) \. union_vars_monom xs \) xs \\ + +lemma union_vars_monom_alt_def: + \union_vars_monom xs \ = \ \ set xs\ + unfolding union_vars_monom_def + apply (subst foldr_fold[symmetric]) + subgoal for x y + by (cases x; cases y) auto + subgoal + by (induction xs) auto + done + +lemma union_vars_poly_alt_def: + \union_vars_poly xs \ = \ \ vars_llist xs\ + unfolding union_vars_poly_def + apply (subst foldr_fold[symmetric]) + subgoal for x y + by (cases x; cases y) + (auto simp: union_vars_monom_alt_def) + subgoal + by (induction xs) + (auto simp: vars_llist_def union_vars_monom_alt_def) + done + +sepref_definition union_vars_monom_impl + is \uncurry (RETURN oo union_vars_monom)\ + :: \monom_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d \\<^sub>a vars_assn\ + unfolding union_vars_monom_def + by sepref + +declare union_vars_monom_impl.refine[sepref_fr_rules] + +sepref_definition union_vars_poly_impl + is \uncurry (RETURN oo union_vars_poly)\ + :: \poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d \\<^sub>a vars_assn\ + unfolding union_vars_poly_def + by sepref + +declare union_vars_poly_impl.refine[sepref_fr_rules] + + +hide_const (open) Autoref_Fix_Rel.CONSTRAINT + +fun status_assn where + \status_assn _ CSUCCESS CSUCCESS = emp\ | + \status_assn _ CFOUND CFOUND = emp\ | + \status_assn R (CFAILED a) (CFAILED b) = R a b\ | + \status_assn _ _ _ = false\ + +lemma SUCCESS_hnr[sepref_fr_rules]: + \(uncurry0 (return CSUCCESS), uncurry0 (RETURN CSUCCESS)) \ unit_assn\<^sup>k \\<^sub>a status_assn R\ + by (sepref_to_hoare) + sep_auto + +lemma FOUND_hnr[sepref_fr_rules]: + \(uncurry0 (return CFOUND), uncurry0 (RETURN CFOUND)) \ unit_assn\<^sup>k \\<^sub>a status_assn R\ + by (sepref_to_hoare) + sep_auto + +lemma is_success_hnr[sepref_fr_rules]: + \CONSTRAINT is_pure R \ + ((return o is_cfound), (RETURN o is_cfound)) \ (status_assn R)\<^sup>k \\<^sub>a bool_assn\ + apply (sepref_to_hoare) + apply (rename_tac xi x; case_tac xi; case_tac x) + apply sep_auto+ + done + +lemma is_cfailed_hnr[sepref_fr_rules]: + \CONSTRAINT is_pure R \ + ((return o is_cfailed), (RETURN o is_cfailed)) \ (status_assn R)\<^sup>k \\<^sub>a bool_assn\ + apply (sepref_to_hoare) + apply (rename_tac xi x; case_tac xi; case_tac x) + apply sep_auto+ + done + +lemma merge_cstatus_hnr[sepref_fr_rules]: + \CONSTRAINT is_pure R \ + (uncurry (return oo merge_cstatus), uncurry (RETURN oo merge_cstatus)) \ + (status_assn R)\<^sup>k *\<^sub>a (status_assn R)\<^sup>k \\<^sub>a status_assn R\ + apply (sepref_to_hoare) + by (case_tac b; case_tac bi; case_tac a; case_tac ai; sep_auto simp: is_pure_conv pure_app_eq) + +sepref_definition add_poly_impl + is \add_poly_l\ + :: \(poly_assn \\<^sub>a poly_assn)\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding add_poly_l_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + by sepref + + +declare add_poly_impl.refine[sepref_fr_rules] + + +sepref_register mult_monomials +lemma mult_monoms_alt_def: + \(RETURN oo mult_monoms) x y = REC\<^sub>T + (\f (p, q). + case (p, q) of + ([], _) \ RETURN q + | (_, []) \ RETURN p + | (x # p, y # q) \ + (if x = y then do { + pq \ f (p, q); + RETURN (x # pq)} + else if (x, y) \ var_order_rel + then do { + pq \ f (p, y # q); + RETURN (x # pq)} + else do { + pq \ f (x # p, q); + RETURN (y # pq)})) + (x, y)\ + apply (subst eq_commute) + apply (induction x y rule: mult_monoms.induct) + subgoal for p + by (subst RECT_unfold, refine_mono) (auto split: list.splits) + subgoal for p + by (subst RECT_unfold, refine_mono) (auto split: list.splits) + subgoal for x p y q + by (subst RECT_unfold, refine_mono) (auto split: list.splits simp: let_to_bind_conv) + done + + +sepref_definition mult_monoms_impl + is \uncurry (RETURN oo mult_monoms)\ + :: \(monom_assn)\<^sup>k *\<^sub>a (monom_assn)\<^sup>k \\<^sub>a (monom_assn)\ + supply [[goals_limit=1]] + unfolding mult_poly_raw_def + HOL_list.fold_custom_empty + var_order'_def[symmetric] + term_order_rel'_alt_def + mult_monoms_alt_def + var_order_rel_var_order + by sepref + +declare mult_monoms_impl.refine[sepref_fr_rules] + +sepref_definition mult_monomials_impl + is \uncurry (RETURN oo mult_monomials)\ + :: \(monomial_assn)\<^sup>k *\<^sub>a (monomial_assn)\<^sup>k \\<^sub>a (monomial_assn)\ + supply [[goals_limit=1]] + unfolding mult_monomials_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + by sepref + + +lemma map_append_alt_def2: + \(RETURN o (map_append f b)) xs = REC\<^sub>T + (\g xs. case xs of [] \ RETURN b + | x # xs \ do { + y \ g xs; + RETURN (f x # y) + }) xs\ + apply (subst eq_commute) + apply (induction f b xs rule: map_append.induct) + subgoal by (subst RECT_unfold, refine_mono) auto + subgoal by (subst RECT_unfold, refine_mono) auto + done + + +definition map_append_poly_mult where + \map_append_poly_mult x = map_append (mult_monomials x)\ + +declare mult_monomials_impl.refine[sepref_fr_rules] + +sepref_definition map_append_poly_mult_impl + is \uncurry2 (RETURN ooo map_append_poly_mult)\ + :: \monomial_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a poly_assn\ + unfolding map_append_poly_mult_def + map_append_alt_def2 + by sepref + +declare map_append_poly_mult_impl.refine[sepref_fr_rules] + +text \TODO @{thm map_by_foldl} is the worst possible implementation of map!\ +sepref_definition mult_poly_raw_impl + is \uncurry (RETURN oo mult_poly_raw)\ + :: \poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + supply [[eta_contract = false, show_abbrevs=false]] + unfolding mult_poly_raw_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + foldl_conv_fold + fold_eq_nfoldli + map_append_poly_mult_def[symmetric] + map_append_alt_def[symmetric] + by sepref + +declare mult_poly_raw_impl.refine[sepref_fr_rules] + + +sepref_definition mult_poly_impl + is \uncurry mult_poly_full\ + :: \poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a poly_assn\ + supply [[goals_limit=1]] + unfolding mult_poly_full_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + by sepref + +declare mult_poly_impl.refine[sepref_fr_rules] + +lemma inverse_monomial: + \monom_rel\ \\<^sub>r int_rel = (monom_rel \\<^sub>r int_rel)\\ + by (auto) + +lemma eq_poly_rel_eq[sepref_import_param]: + \((=), (=)) \ poly_rel \ poly_rel \ bool_rel\ + using list_rel_sv[of \monomial_rel\, OF single_valued_monomial_rel] + using list_rel_sv[OF single_valued_monomial_rel'[unfolded IS_LEFT_UNIQUE_def inv_list_rel_eq]] + unfolding inv_list_rel_eq[symmetric] + by (auto intro!: frefI simp: + rel2p_def single_valued_def p2rel_def + simp del: inv_list_rel_eq) + +sepref_definition weak_equality_l_impl + is \uncurry weak_equality_l\ + :: \poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a bool_assn\ + supply [[goals_limit=1]] + unfolding weak_equality_l_def + by sepref + +declare weak_equality_l_impl.refine[sepref_fr_rules] +sepref_register add_poly_l mult_poly_full + +abbreviation raw_string_assn :: \string \ string \ assn\ where + \raw_string_assn \ list_assn id_assn\ + +definition show_nat :: \nat \ string\ where + \show_nat i = show i\ + +lemma [sepref_import_param]: + \(show_nat, show_nat) \ nat_rel \ \Id\list_rel\ + by (auto intro: fun_relI) + +lemma status_assn_pure_conv: + \status_assn (id_assn) a b = id_assn a b\ + by (cases a; cases b) + (auto simp: pure_def) + + +lemma [sepref_fr_rules]: + \(uncurry3 (\x y. return oo (error_msg_not_equal_dom x y)), uncurry3 check_not_equal_dom_err) \ + poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding show_nat_def[symmetric] list_assn_pure_conv + prod_assn_pure_conv check_not_equal_dom_err_def + by (sepref_to_hoare; sep_auto simp: error_msg_not_equal_dom_def) + + + +lemma [sepref_fr_rules]: + \(return o (error_msg_notin_dom o nat_of_uint64), RETURN o error_msg_notin_dom) + \ uint64_nat_assn\<^sup>k \\<^sub>a raw_string_assn\ + \(return o (error_msg_reused_dom o nat_of_uint64), RETURN o error_msg_reused_dom) + \ uint64_nat_assn\<^sup>k \\<^sub>a raw_string_assn\ + \(uncurry (return oo (\i. error_msg (nat_of_uint64 i))), uncurry (RETURN oo error_msg)) + \ uint64_nat_assn\<^sup>k *\<^sub>a raw_string_assn\<^sup>k \\<^sub>a status_assn raw_string_assn\ + \(uncurry (return oo error_msg), uncurry (RETURN oo error_msg)) + \ nat_assn\<^sup>k *\<^sub>a raw_string_assn\<^sup>k \\<^sub>a status_assn raw_string_assn\ + unfolding error_msg_notin_dom_def list_assn_pure_conv list_rel_id_simp + unfolding status_assn_pure_conv + unfolding show_nat_def[symmetric] + by (sepref_to_hoare; sep_auto simp: uint64_nat_rel_def br_def; fail)+ + +sepref_definition check_addition_l_impl + is \uncurry6 check_addition_l\ + :: \poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a + uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a status_assn raw_string_assn\ + supply [[goals_limit=1]] + unfolding mult_poly_full_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + check_addition_l_def + in_dom_m_lookup_iff + fmlookup'_def[symmetric] + vars_llist_alt_def + by sepref + +declare check_addition_l_impl.refine[sepref_fr_rules] + +sepref_register check_mult_l_dom_err + +definition check_mult_l_dom_err_impl where + \check_mult_l_dom_err_impl pd p ia i = + (if pd then ''The polynomial with id '' @ show (nat_of_uint64 p) @ '' was not found'' else '''') @ + (if ia then ''The id of the resulting id '' @ show (nat_of_uint64 i) @ '' was already given'' else '''')\ + +definition check_mult_l_mult_err_impl where + \check_mult_l_mult_err_impl p q pq r = + ''Multiplying '' @ show p @ '' by '' @ show q @ '' gives '' @ show pq @ '' and not '' @ show r\ + +lemma [sepref_fr_rules]: + \(uncurry3 ((\x y. return oo (check_mult_l_dom_err_impl x y))), + uncurry3 (check_mult_l_dom_err)) \ bool_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a bool_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_mult_l_dom_err_def check_mult_l_dom_err_impl_def list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + +lemma [sepref_fr_rules]: + \(uncurry3 ((\x y. return oo (check_mult_l_mult_err_impl x y))), + uncurry3 (check_mult_l_mult_err)) \ poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_mult_l_mult_err_def check_mult_l_mult_err_impl_def list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + +sepref_definition check_mult_l_impl + is \uncurry6 check_mult_l\ + :: \poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a status_assn raw_string_assn\ + supply [[goals_limit=1]] + unfolding check_mult_l_def + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + in_dom_m_lookup_iff + fmlookup'_def[symmetric] + vars_llist_alt_def + by sepref + +declare check_mult_l_impl.refine[sepref_fr_rules] + +definition check_ext_l_dom_err_impl :: \uint64 \ _\ where + \check_ext_l_dom_err_impl p = + ''There is already a polynomial with index '' @ show (nat_of_uint64 p)\ + +lemma [sepref_fr_rules]: + \(((return o (check_ext_l_dom_err_impl))), + (check_extension_l_dom_err)) \ uint64_nat_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_extension_l_dom_err_def check_ext_l_dom_err_impl_def list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + + +definition check_extension_l_no_new_var_err_impl :: \_ \ _\ where + \check_extension_l_no_new_var_err_impl p = + ''No new variable could be found in polynomial '' @ show p\ + +lemma [sepref_fr_rules]: + \(((return o (check_extension_l_no_new_var_err_impl))), + (check_extension_l_no_new_var_err)) \ poly_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_extension_l_no_new_var_err_impl_def check_extension_l_no_new_var_err_def + list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + +definition check_extension_l_side_cond_err_impl :: \_ \ _\ where + \check_extension_l_side_cond_err_impl v p r s = + ''Error while checking side conditions of extensions polynow, var is '' @ show v @ + '' polynomial is '' @ show p @ ''side condition p*p - p = '' @ show s @ '' and should be 0''\ + +lemma [sepref_fr_rules]: + \((uncurry3 (\x y. return oo (check_extension_l_side_cond_err_impl x y))), + uncurry3 (check_extension_l_side_cond_err)) \ string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_extension_l_side_cond_err_impl_def check_extension_l_side_cond_err_def + list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + +definition check_extension_l_new_var_multiple_err_impl :: \_ \ _\ where + \check_extension_l_new_var_multiple_err_impl v p = + ''Error while checking side conditions of extensions polynow, var is '' @ show v @ + '' but it either appears at least once in the polynomial or another new variable is created '' @ + show p @ '' but should not.''\ + +lemma [sepref_fr_rules]: + \((uncurry (return oo (check_extension_l_new_var_multiple_err_impl))), + uncurry (check_extension_l_new_var_multiple_err)) \ string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding check_extension_l_new_var_multiple_err_impl_def + check_extension_l_new_var_multiple_err_def + list_assn_pure_conv + apply sepref_to_hoare + apply sep_auto + done + + +sepref_register check_extension_l_dom_err fmlookup' + check_extension_l_side_cond_err check_extension_l_no_new_var_err + check_extension_l_new_var_multiple_err + +definition uminus_poly :: \llist_polynomial \ llist_polynomial\ where + \uminus_poly p' = map (\(a, b). (a, - b)) p'\ + +sepref_register uminus_poly +lemma [sepref_import_param]: + \(map (\(a, b). (a, - b)), uminus_poly) \ poly_rel \ poly_rel\ + unfolding uminus_poly_def + apply (intro fun_relI) + subgoal for p p' + by (induction p p' rule: list_rel_induct) + auto + done + +sepref_register vars_of_poly_in + weak_equality_l + +lemma [safe_constraint_rules]: + \Sepref_Constraints.CONSTRAINT single_valued (the_pure monomial_assn)\ and + single_valued_the_monomial_assn: + \single_valued (the_pure monomial_assn)\ + \single_valued ((the_pure monomial_assn)\)\ + unfolding IS_LEFT_UNIQUE_def[symmetric] + by (auto simp: step_rewrite_pure single_valued_monomial_rel single_valued_monomial_rel' Sepref_Constraints.CONSTRAINT_def) + +sepref_definition check_extension_l_impl + is \uncurry5 check_extension_l\ + :: \poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \\<^sub>a + status_assn raw_string_assn\ + supply option.splits[split] single_valued_the_monomial_assn[simp] + supply [[goals_limit=1]] + unfolding + HOL_list.fold_custom_empty + term_order_rel'_def[symmetric] + term_order_rel'_alt_def + in_dom_m_lookup_iff + fmlookup'_def[symmetric] + vars_llist_alt_def + check_extension_l_def + not_not + option.case_eq_if + uminus_poly_def[symmetric] + HOL_list.fold_custom_empty + by sepref + + +declare check_extension_l_impl.refine[sepref_fr_rules] + +sepref_definition check_del_l_impl + is \uncurry2 check_del_l\ + :: \poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k \\<^sub>a status_assn raw_string_assn\ + supply [[goals_limit=1]] + unfolding check_del_l_def + in_dom_m_lookup_iff + fmlookup'_def[symmetric] + by sepref + +lemmas [sepref_fr_rules] = check_del_l_impl.refine + +abbreviation pac_step_rel where + \pac_step_rel \ p2rel (\Id, \monomial_rel\list_rel, Id\ pac_step_rel_raw)\ + +sepref_register PAC_Polynomials_Operations.normalize_poly + pac_src1 pac_src2 new_id pac_mult case_pac_step check_mult_l + check_addition_l check_del_l check_extension_l + +lemma pac_step_rel_assn_alt_def2: + \hn_ctxt (pac_step_rel_assn nat_assn poly_assn id_assn) b bi = + hn_val + (p2rel + (\nat_rel, poly_rel, Id :: (string \ _) set\pac_step_rel_raw)) b bi\ + unfolding poly_assn_list hn_ctxt_def + by (induction nat_assn poly_assn \id_assn :: string \ _\ b bi rule: pac_step_rel_assn.induct) + (auto simp: p2rel_def hn_val_unfold pac_step_rel_raw.simps relAPP_def + pure_app_eq) + + +lemma is_AddD_import[sepref_fr_rules]: + assumes \CONSTRAINT is_pure K\ \CONSTRAINT is_pure V\ + shows + \(return o pac_res, RETURN o pac_res) \ [\x. is_Add x \ is_Mult x \ is_Extension x]\<^sub>a + (pac_step_rel_assn K V R)\<^sup>k \ V\ + \(return o pac_src1, RETURN o pac_src1) \ [\x. is_Add x \ is_Mult x \ is_Del x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \ K\ + \(return o new_id, RETURN o new_id) \ [\x. is_Add x \ is_Mult x \ is_Extension x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \ K\ + \(return o is_Add, RETURN o is_Add) \ (pac_step_rel_assn K V R)\<^sup>k \\<^sub>a bool_assn\ + \(return o is_Mult, RETURN o is_Mult) \ (pac_step_rel_assn K V R)\<^sup>k \\<^sub>a bool_assn\ + \(return o is_Del, RETURN o is_Del) \ (pac_step_rel_assn K V R)\<^sup>k \\<^sub>a bool_assn\ + \(return o is_Extension, RETURN o is_Extension) \ (pac_step_rel_assn K V R)\<^sup>k \\<^sub>a bool_assn\ + using assms + by (sepref_to_hoare; sep_auto simp: pac_step_rel_assn_alt_def is_pure_conv ent_true_drop pure_app_eq + split: pac_step.splits; fail)+ + +lemma [sepref_fr_rules]: + \CONSTRAINT is_pure K \ + (return o pac_src2, RETURN o pac_src2) \ [\x. is_Add x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \ K\ + \CONSTRAINT is_pure V \ + (return o pac_mult, RETURN o pac_mult) \ [\x. is_Mult x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \ V\ + \CONSTRAINT is_pure R \ + (return o new_var, RETURN o new_var) \ [\x. is_Extension x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \ R\ + by (sepref_to_hoare; sep_auto simp: pac_step_rel_assn_alt_def is_pure_conv ent_true_drop pure_app_eq + split: pac_step.splits; fail)+ + +lemma is_Mult_lastI: + \\ is_Add b \ \is_Mult b \ \is_Extension b \ is_Del b\ + by (cases b) auto + +sepref_register is_cfailed is_Del + +definition PAC_checker_l_step' :: _ where + \PAC_checker_l_step' a b c d = PAC_checker_l_step a (b, c, d)\ + +lemma PAC_checker_l_step_alt_def: + \PAC_checker_l_step a bcd e = (let (b,c,d) = bcd in PAC_checker_l_step' a b c d e)\ + unfolding PAC_checker_l_step'_def by auto + +sepref_decl_intf ('k) acode_status is "('k) code_status" +sepref_decl_intf ('k, 'b, 'lbl) apac_step is "('k, 'b, 'lbl) pac_step" + +sepref_register merge_cstatus full_normalize_poly new_var is_Add + +lemma poly_rel_the_pure: + \poly_rel = the_pure poly_assn\ and + nat_rel_the_pure: + \nat_rel = the_pure nat_assn\ and + WTF_RF: \pure (the_pure nat_assn) = nat_assn\ + unfolding poly_assn_list + by auto + +lemma [safe_constraint_rules]: + \CONSTRAINT IS_LEFT_UNIQUE uint64_nat_rel\ and + single_valued_uint64_nat_rel[safe_constraint_rules]: + \CONSTRAINT single_valued uint64_nat_rel\ + by (auto simp: IS_LEFT_UNIQUE_def single_valued_def uint64_nat_rel_def br_def) + +sepref_definition check_step_impl + is \uncurry4 PAC_checker_l_step'\ + :: \poly_assn\<^sup>k *\<^sub>a (status_assn raw_string_assn)\<^sup>d *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn\<^sup>d *\<^sub>a (pac_step_rel_assn (uint64_nat_assn) poly_assn (string_assn :: string \ _))\<^sup>d \\<^sub>a + status_assn raw_string_assn \\<^sub>a vars_assn \\<^sub>a polys_assn\ + supply [[goals_limit=1]] is_Mult_lastI[intro] single_valued_uint64_nat_rel[simp] + unfolding PAC_checker_l_step_def PAC_checker_l_step'_def + pac_step.case_eq_if Let_def + is_success_alt_def[symmetric] + uminus_poly_def[symmetric] + HOL_list.fold_custom_empty + by sepref + + +declare check_step_impl.refine[sepref_fr_rules] + +sepref_register PAC_checker_l_step PAC_checker_l_step' fully_normalize_poly_impl + +definition PAC_checker_l' where + \PAC_checker_l' p \ A status steps = PAC_checker_l p (\, A) status steps\ + +lemma PAC_checker_l_alt_def: + \PAC_checker_l p \A status steps = + (let (\, A) = \A in PAC_checker_l' p \ A status steps)\ + unfolding PAC_checker_l'_def by auto + +sepref_definition PAC_checker_l_impl + is \uncurry4 PAC_checker_l'\ + :: \poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn\<^sup>d *\<^sub>a (status_assn raw_string_assn)\<^sup>d *\<^sub>a + (list_assn (pac_step_rel_assn (uint64_nat_assn) poly_assn string_assn))\<^sup>k \\<^sub>a + status_assn raw_string_assn \\<^sub>a vars_assn \\<^sub>a polys_assn\ + supply [[goals_limit=1]] is_Mult_lastI[intro] + unfolding PAC_checker_l_def is_success_alt_def[symmetric] PAC_checker_l_step_alt_def + nres_bind_let_law[symmetric] PAC_checker_l'_def + apply (subst nres_bind_let_law) + by sepref + +declare PAC_checker_l_impl.refine[sepref_fr_rules] + +abbreviation polys_assn_input where + \polys_assn_input \ iam_fmap_assn nat_assn poly_assn\ + +definition remap_polys_l_dom_err_impl :: \_\ where + \remap_polys_l_dom_err_impl = + ''Error during initialisation. Too many polynomials where provided. If this happens,'' @ + ''please report the example to the authors, because something went wrong during '' @ + ''code generation (code generation to arrays is likely to be broken).''\ + +lemma [sepref_fr_rules]: + \((uncurry0 (return (remap_polys_l_dom_err_impl))), + uncurry0 (remap_polys_l_dom_err)) \ unit_assn\<^sup>k \\<^sub>a raw_string_assn\ + unfolding remap_polys_l_dom_err_def + remap_polys_l_dom_err_def + list_assn_pure_conv + by sepref_to_hoare sep_auto + +text \MLton is not able to optimise the calls to pow.\ +lemma pow_2_64: \(2::nat) ^ 64 = 18446744073709551616\ + by auto + +sepref_register upper_bound_on_dom op_fmap_empty + +sepref_definition remap_polys_l_impl + is \uncurry2 remap_polys_l2\ + :: \poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn_input\<^sup>d \\<^sub>a + status_assn raw_string_assn \\<^sub>a vars_assn \\<^sub>a polys_assn\ + supply [[goals_limit=1]] is_Mult_lastI[intro] indom_mI[dest] + unfolding remap_polys_l2_def op_fmap_empty_def[symmetric] while_eq_nfoldli[symmetric] + while_upt_while_direct pow_2_64 + in_dom_m_lookup_iff + fmlookup'_def[symmetric] + union_vars_poly_alt_def[symmetric] + apply (rewrite at \fmupd \\ uint64_of_nat_conv_def[symmetric]) + apply (subst while_upt_while_direct) + apply simp + apply (rewrite at \op_fmap_empty\ annotate_assn[where A=\polys_assn\]) + by sepref + +lemma remap_polys_l2_remap_polys_l: + \(uncurry2 remap_polys_l2, uncurry2 remap_polys_l) \ (Id \\<^sub>r \Id\set_rel) \\<^sub>r Id \\<^sub>f \Id\nres_rel\ + apply (intro frefI fun_relI nres_relI) + using remap_polys_l2_remap_polys_l by auto + +lemma [sepref_fr_rules]: + \(uncurry2 remap_polys_l_impl, + uncurry2 remap_polys_l) \ poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn_input\<^sup>d \\<^sub>a + status_assn raw_string_assn \\<^sub>a vars_assn \\<^sub>a polys_assn\ + using hfcomp_tcomp_pre[OF remap_polys_l2_remap_polys_l remap_polys_l_impl.refine] + by (auto simp: hrp_comp_def hfprod_def) + +sepref_register remap_polys_l + +sepref_definition full_checker_l_impl + is \uncurry2 full_checker_l\ + :: \poly_assn\<^sup>k *\<^sub>a polys_assn_input\<^sup>d *\<^sub>a (list_assn (pac_step_rel_assn (uint64_nat_assn) poly_assn string_assn))\<^sup>k \\<^sub>a + status_assn raw_string_assn \\<^sub>a vars_assn \\<^sub>a polys_assn\ + supply [[goals_limit=1]] is_Mult_lastI[intro] + unfolding full_checker_l_def hs.fold_custom_empty + union_vars_poly_alt_def[symmetric] + PAC_checker_l_alt_def + by sepref + +sepref_definition PAC_update_impl + is \uncurry2 (RETURN ooo fmupd)\ + :: \nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a (polys_assn_input)\<^sup>d \\<^sub>a polys_assn_input\ + unfolding comp_def + by sepref + +sepref_definition PAC_empty_impl + is \uncurry0 (RETURN fmempty)\ + :: \unit_assn\<^sup>k \\<^sub>a polys_assn_input\ + unfolding op_iam_fmap_empty_def[symmetric] pat_fmap_empty + by sepref + +sepref_definition empty_vars_impl + is \uncurry0 (RETURN {})\ + :: \unit_assn\<^sup>k \\<^sub>a vars_assn\ + unfolding hs.fold_custom_empty + by sepref + +text \This is a hack for performance. There is no need to recheck that that a char is valid when + working on chars coming from strings... It is not that important in most cases, but in our case + the preformance difference is really large.\ + + +definition unsafe_asciis_of_literal :: \_\ where + \unsafe_asciis_of_literal xs = String.asciis_of_literal xs\ + +definition unsafe_asciis_of_literal' :: \_\ where + [simp, symmetric, code]: \unsafe_asciis_of_literal' = unsafe_asciis_of_literal\ + +code_printing + constant unsafe_asciis_of_literal' \ + (SML) "!(List.map (fn c => let val k = Char.ord c in IntInf.fromInt k end) /o String.explode)" + +text \ + Now comes the big and ugly and unsafe hack. + + Basically, we try to avoid the conversion to IntInf when calculating the hash. The performance + gain is roughly 40\%, which is a LOT and definitively something we need to do. We are aware that the + SML semantic encourages compilers to optimise conversions, but this does not happen here, + corroborating our early observation on the verified SAT solver IsaSAT.x +\ +definition raw_explode where + [simp]: \raw_explode = String.explode\ +code_printing + constant raw_explode \ + (SML) "String.explode" + +definition \hashcode_literal' s \ + foldl (\h x. h * 33 + uint32_of_int (of_char x)) 5381 + (raw_explode s)\ + +lemmas [code] = + hashcode_literal_def[unfolded String.explode_code + unsafe_asciis_of_literal_def[symmetric]] + +definition uint32_of_char where + [symmetric, code_unfold]: \uint32_of_char x = uint32_of_int (int_of_char x)\ + + +code_printing + constant uint32_of_char \ + (SML) "!(Word32.fromInt /o (Char.ord))" + +lemma [code]: \hashcode s = hashcode_literal' s\ + unfolding hashcode_literal_def hashcode_list_def + apply (auto simp: unsafe_asciis_of_literal_def hashcode_list_def + String.asciis_of_literal_def hashcode_literal_def hashcode_literal'_def) + done + +text \We compile Pastèque in \<^file>\PAC_Checker_MLton.thy\.\ +export_code PAC_checker_l_impl PAC_update_impl PAC_empty_impl the_error is_cfailed is_cfound + int_of_integer Del Add Mult nat_of_integer String.implode remap_polys_l_impl + fully_normalize_poly_impl union_vars_poly_impl empty_vars_impl + full_checker_l_impl check_step_impl CSUCCESS + Extension hashcode_literal' version + in SML_imp module_name PAC_Checker + + +section \Correctness theorem\ + +context poly_embed +begin + +definition full_poly_assn where + \full_poly_assn = hr_comp poly_assn (fully_unsorted_poly_rel O mset_poly_rel)\ + +definition full_poly_input_assn where + \full_poly_input_assn = hr_comp + (hr_comp polys_assn_input + (\nat_rel, fully_unsorted_poly_rel O mset_poly_rel\fmap_rel)) + polys_rel\ + +definition fully_pac_assn where + \fully_pac_assn = (list_assn + (hr_comp (pac_step_rel_assn uint64_nat_assn poly_assn string_assn) + (p2rel + (\nat_rel, + fully_unsorted_poly_rel O + mset_poly_rel, var_rel\pac_step_rel_raw))))\ + +definition code_status_assn where + \code_status_assn = hr_comp (status_assn raw_string_assn) + code_status_status_rel\ + +definition full_vars_assn where + \full_vars_assn = hr_comp (hs.assn string_assn) + (\var_rel\set_rel)\ + +lemma polys_rel_full_polys_rel: + \polys_rel_full = Id \\<^sub>r polys_rel\ + by (auto simp: polys_rel_full_def) + +definition full_polys_assn :: \_\ where +\full_polys_assn = hr_comp (hr_comp polys_assn + (\nat_rel, + sorted_poly_rel O mset_poly_rel\fmap_rel)) + polys_rel\ + +text \ + +Below is the full correctness theorems. It basically states that: + + \<^enum> assuming that the input polynomials have no duplicate variables + + +Then: + +\<^enum> if the checker returns \<^term>\CFOUND\, the spec is in the ideal + and the PAC file is correct + +\<^enum> if the checker returns \<^term>\CSUCCESS\, the PAC file is correct (but +there is no information on the spec, aka checking failed) + +\<^enum> if the checker return \<^term>\CFAILED err\, then checking failed (and +\<^term>\err\ \<^emph>\might\ give you an indication of the error, but the correctness +theorem does not say anything about that). + + +The input parameters are: + +\<^enum> the specification polynomial represented as a list + +\<^enum> the input polynomials as hash map (as an array of option polynomial) + +\<^enum> a represention of the PAC proofs. + +\ + +lemma PAC_full_correctness: (* \htmllink{PAC-full-correctness} *) + \(uncurry2 full_checker_l_impl, + uncurry2 (\spec A _. PAC_checker_specification spec A)) + \ (full_poly_assn)\<^sup>k *\<^sub>a (full_poly_input_assn)\<^sup>d *\<^sub>a (fully_pac_assn)\<^sup>k \\<^sub>a hr_comp + (code_status_assn \\<^sub>a full_vars_assn \\<^sub>a hr_comp polys_assn + (\nat_rel, sorted_poly_rel O mset_poly_rel\fmap_rel)) + {((st, G), st', G'). + st = st' \ (st \ FAILED \ (G, G') \ Id \\<^sub>r polys_rel)}\ + using + full_checker_l_impl.refine[FCOMP full_checker_l_full_checker', + FCOMP full_checker_spec', + unfolded full_poly_assn_def[symmetric] + full_poly_input_assn_def[symmetric] + fully_pac_assn_def[symmetric] + code_status_assn_def[symmetric] + full_vars_assn_def[symmetric] + polys_rel_full_polys_rel + hr_comp_prod_conv + full_polys_assn_def[symmetric]] + hr_comp_Id2 + by auto + +text \ + +It would be more efficient to move the parsing to Isabelle, as this +would be more memory efficient (and also reduce the TCB). But now +comes the fun part: It cannot work. A stream (of a file) is consumed +by side effects. Assume that this would work. The code could look like: + +\<^term>\ + let next_token = read_file file + in f (next_token) +\ + +This code is equal to (in the HOL sense of equality): +\<^term>\ + let _ = read_file file; + next_token = read_file file + in f (next_token) +\ + +However, as an hypothetical \<^term>\read_file\ changes the underlying stream, we would get the next +token. Remark that this is already a weird point of ML compilers. Anyway, I see currently two +solutions to this problem: + +\<^enum> The meta-argument: use it only in the Refinement Framework in a setup where copies are +disallowed. Basically, this works because we can express the non-duplication constraints on the type +level. However, we cannot forbid people from expressing things directly at the HOL level. + +\<^enum> On the target language side, model the stream as the stream and the position. Reading takes two +arguments. First, the position to read. Second, the stream (and the current position) to read. If +the position to read does not match the current position, return an error. This would fit the +correctness theorem of the code generation (roughly ``if it terminates without exception, the answer +is the same''), but it is still unsatisfactory. +\ + +end + +definition \ :: \string \ nat\ where + \\ = (SOME \. bij \)\ + +lemma bij_\: \bij \\ + using someI[of \\\ :: string \ nat. bij \\] + unfolding \_def[symmetric] + using poly_embed_EX + by auto + +global_interpretation PAC: poly_embed where + \ = \ + apply standard + apply (use bij_\ in \auto simp: bij_def\) + done + + +text \The full correctness theorem is @{thm PAC.PAC_full_correctness}.\ + +end diff --git a/thys/PAC_Checker/PAC_Map_Rel.thy b/thys/PAC_Checker/PAC_Map_Rel.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Map_Rel.thy @@ -0,0 +1,321 @@ +(* + File: PAC_Map_Rel.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Map_Rel + imports + Refine_Imperative_HOL.IICF Finite_Map_Multiset +begin + + +section \Hash-Map for finite mappings\ + +text \ + +This function declares hash-maps for \<^typ>\('a, 'b)fmap\, that are nicer +to use especially here where everything is finite. + +\ +definition fmap_rel where + [to_relAPP]: + "fmap_rel K V \ {(m1, m2). + (\i j. i |\| fmdom m2 \ (j, i) \ K \ (the (fmlookup m1 j), the (fmlookup m2 i)) \ V) \ + fset (fmdom m1) \ Domain K \ fset (fmdom m2) \ Range K \ + (\i j. (i, j) \ K \ j |\| fmdom m2 \ i |\| fmdom m1)}" + + +lemma fmap_rel_alt_def: + \\K, V\fmap_rel \ + {(m1, m2). + (\i j. i \# dom_m m2 \ + (j, i) \ K \ (the (fmlookup m1 j), the (fmlookup m2 i)) \ V) \ + fset (fmdom m1) \ Domain K \ + fset (fmdom m2) \ Range K \ + (\i j. (i, j) \ K \ (j \# dom_m m2) = (i \# dom_m m1))} +\ + unfolding fmap_rel_def dom_m_def fmember.rep_eq + by auto + +lemma fmdom_empty_fmempty_iff[simp]: \fmdom m = {||} \ m = fmempty\ + by (metis fmdom_empty fmdrop_fset_fmdom fmdrop_fset_null) + +lemma fmap_rel_empty1_simp[simp]: + "(fmempty,m)\\K,V\fmap_rel \ m=fmempty" + apply (cases \fmdom m = {||}\) + apply (auto simp: fmap_rel_def)[] + by (auto simp add: fmember.rep_eq fmap_rel_def simp del: fmdom_empty_fmempty_iff) + +lemma fmap_rel_empty2_simp[simp]: + "(m,fmempty)\\K,V\fmap_rel \ m=fmempty" + apply (cases \fmdom m = {||}\) + apply (auto simp: fmap_rel_def)[] + by (fastforce simp add: fmember.rep_eq fmap_rel_def simp del: fmdom_empty_fmempty_iff) + +sepref_decl_intf ('k,'v) f_map is "('k, 'v) fmap" + +lemma [synth_rules]: "\INTF_OF_REL K TYPE('k); INTF_OF_REL V TYPE('v)\ + \ INTF_OF_REL (\K,V\fmap_rel) TYPE(('k,'v) f_map)" by simp + + +subsection \Operations\ +sepref_decl_op fmap_empty: "fmempty" :: "\K,V\fmap_rel" . + + +sepref_decl_op fmap_is_empty: "(=) fmempty" :: "\K,V\fmap_rel \ bool_rel" + apply (rule fref_ncI) + apply parametricity + apply (rule fun_relI; auto) + done + + +lemma fmap_rel_fmupd_fmap_rel: + \(A, B) \ \K, R\fmap_rel \ (p, p') \ K \ (q, q') \ R \ + (fmupd p q A, fmupd p' q' B) \ \K, R\fmap_rel\ + if "single_valued K" "single_valued (K\)" + using that + unfolding fmap_rel_alt_def + apply (case_tac \p' \# dom_m B\) + apply (auto simp add: all_conj_distrib IS_RIGHT_UNIQUED dest!: multi_member_split) + done + +sepref_decl_op fmap_update: "fmupd" :: "K \ V \ \K,V\fmap_rel \ \K,V\fmap_rel" + where "single_valued K" "single_valued (K\)" + apply (rule fref_ncI) + apply parametricity + apply (intro fun_relI) + by (rule fmap_rel_fmupd_fmap_rel) + +lemma remove1_mset_eq_add_mset_iff: + \remove1_mset a A = add_mset a A' \ A = add_mset a (add_mset a A')\ + by (metis add_mset_add_single add_mset_diff_bothsides diff_zero remove1_mset_eqE) + +lemma fmap_rel_fmdrop_fmap_rel: + \(fmdrop p A, fmdrop p' B) \ \K, R\fmap_rel\ + if single: "single_valued K" "single_valued (K\)" and + H0: \(A, B) \ \K, R\fmap_rel\ \(p, p') \ K\ +proof - + have H: \\Aa j. + \i. i \# dom_m B \ (\j. (j, i) \ K \ (the (fmlookup A j), the (fmlookup B i)) \ R) \ + remove1_mset p' (dom_m B) = add_mset p' Aa \ (j, p') \ K \ False\ + by (metis dom_m_fmdrop fmlookup_drop in_dom_m_lookup_iff union_single_eq_member) + have H2: \\i Aa j. + (p, p') \ K \ + \i. i \# dom_m B \ (\j. (j, i) \ K \ (the (fmlookup A j), the (fmlookup B i)) \ R) \ + \i j. (i, j) \ K \ (j \# dom_m B) = (i \# dom_m A) \ + remove1_mset p' (dom_m B) = add_mset i Aa \ + (j, i) \ K \ + (the (fmlookup A j), the (fmlookup B i)) \ R \ j \# remove1_mset p (dom_m A) \ + i \# remove1_mset p' (dom_m B)\ + \\i j Aa. + (p, p') \ K \ + single_valued K \ + single_valued (K\) \ + \i. i \# dom_m B \ (\j. (j, i) \ K \ (the (fmlookup A j), the (fmlookup B i)) \ R) \ + fset (fmdom A) \ Domain K \ + fset (fmdom B) \ Range K \ + \i j. (i, j) \ K \ (j \# dom_m B) = (i \# dom_m A) \ + (i, j) \ K \ remove1_mset p (dom_m A) = add_mset i Aa \ j \# remove1_mset p' (dom_m B)\ + using single + by (metis IS_RIGHT_UNIQUED converse.intros dom_m_fmdrop fmlookup_drop in_dom_m_lookup_iff + union_single_eq_member)+ + show \(fmdrop p A, fmdrop p' B) \ \K, R\fmap_rel\ + using that + unfolding fmap_rel_alt_def + by (auto simp add: all_conj_distrib IS_RIGHT_UNIQUED + dest!: multi_member_split dest: H H2) +qed + +sepref_decl_op fmap_delete: "fmdrop" :: "K \ \K,V\fmap_rel \ \K,V\fmap_rel" + where "single_valued K" "single_valued (K\)" + apply (rule fref_ncI) + apply parametricity + by (auto simp add: fmap_rel_fmdrop_fmap_rel) + +lemma fmap_rel_nat_the_fmlookup[intro]: + \(A, B) \ \S, R\fmap_rel \ (p, p') \ S \ p' \# dom_m B \ + (the (fmlookup A p), the (fmlookup B p')) \ R\ + by (auto simp: fmap_rel_alt_def distinct_mset_dom) + +lemma fmap_rel_in_dom_iff: + \(aa, a'a) \ \K, V\fmap_rel \ + (a, a') \ K \ + a' \# dom_m a'a \ + a \# dom_m aa\ + unfolding fmap_rel_alt_def + by auto + +lemma fmap_rel_fmlookup_rel: + \(a, a') \ K \ (aa, a'a) \ \K, V\fmap_rel \ + (fmlookup aa a, fmlookup a'a a') \ \V\option_rel\ + using fmap_rel_nat_the_fmlookup[of aa a'a K V a a'] + fmap_rel_in_dom_iff[of aa a'a K V a a'] + in_dom_m_lookup_iff[of a' a'a] + in_dom_m_lookup_iff[of a aa] + by (cases \a' \# dom_m a'a\) + (auto simp del: fmap_rel_nat_the_fmlookup) + + +sepref_decl_op fmap_lookup: "fmlookup" :: "\K,V\fmap_rel \ K \ \V\option_rel" + apply (rule fref_ncI) + apply parametricity + apply (intro fun_relI) + apply (rule fmap_rel_fmlookup_rel; assumption) + done + +lemma in_fdom_alt: "k\#dom_m m \ \is_None (fmlookup m k)" + apply (auto split: option.split intro: fmdom_notI simp: dom_m_def fmember.rep_eq) + apply (meson fmdom_notI notin_fset) + using notin_fset by fastforce + +sepref_decl_op fmap_contains_key: "\k m. k\#dom_m m" :: "K \ \K,V\fmap_rel \ bool_rel" + unfolding in_fdom_alt + apply (rule fref_ncI) + apply parametricity + apply (rule fmap_rel_fmlookup_rel; assumption) + done + + +subsection \Patterns\ + +lemma pat_fmap_empty[pat_rules]: "fmempty \ op_fmap_empty" by simp + +lemma pat_map_is_empty[pat_rules]: + "(=) $m$fmempty \ op_fmap_is_empty$m" + "(=) $fmempty$m \ op_fmap_is_empty$m" + "(=) $(dom_m$m)${#} \ op_fmap_is_empty$m" + "(=) ${#}$(dom_m$m) \ op_fmap_is_empty$m" + unfolding atomize_eq + by (auto dest: sym) + +lemma op_map_contains_key[pat_rules]: + "(\#) $ k $ (dom_m$m) \ op_fmap_contains_key$'k$'m" + by (auto intro!: eq_reflection) + + +subsection \Mapping to Normal Hashmaps\ + +abbreviation map_of_fmap :: \('k \ 'v option) \ ('k, 'v) fmap\ where + \map_of_fmap h \ Abs_fmap h\ + +definition map_fmap_rel where + \map_fmap_rel = br map_of_fmap (\a. finite (dom a))\ + +lemma fmdrop_set_None: + \(op_map_delete, fmdrop) \ Id \ map_fmap_rel \ map_fmap_rel\ + apply (auto simp: map_fmap_rel_def br_def) + apply (subst fmdrop.abs_eq) + apply (auto simp: eq_onp_def fmap.Abs_fmap_inject + map_drop_def map_filter_finite + intro!: ext) + apply (auto simp: map_filter_def) + done + +lemma map_upd_fmupd: + \(op_map_update, fmupd) \ Id \ Id \ map_fmap_rel \ map_fmap_rel\ + apply (auto simp: map_fmap_rel_def br_def) + apply (subst fmupd.abs_eq) + apply (auto simp: eq_onp_def fmap.Abs_fmap_inject + map_drop_def map_filter_finite map_upd_def + intro!: ext) + done + + +text \Technically @{term op_map_lookup} has the arguments in the wrong direction.\ +definition fmlookup' where + [simp]: \fmlookup' A k = fmlookup k A\ + + +lemma [def_pat_rules]: + \((\#)$k$(dom_m$A)) \ Not$(is_None$(fmlookup'$k$A))\ + by (simp add: fold_is_None in_fdom_alt) + +lemma op_map_lookup_fmlookup: + \(op_map_lookup, fmlookup') \ Id \ map_fmap_rel \ \Id\option_rel\ + by (auto simp: map_fmap_rel_def br_def fmap.Abs_fmap_inverse) + + +abbreviation hm_fmap_assn where + \hm_fmap_assn K V \ hr_comp (hm.assn K V) map_fmap_rel\ + +lemmas fmap_delete_hnr [sepref_fr_rules] = + hm.delete_hnr[FCOMP fmdrop_set_None] + +lemmas fmap_update_hnr [sepref_fr_rules] = + hm.update_hnr[FCOMP map_upd_fmupd] + + +lemmas fmap_lookup_hnr [sepref_fr_rules] = + hm.lookup_hnr[FCOMP op_map_lookup_fmlookup] + +lemma fmempty_empty: + \(uncurry0 (RETURN op_map_empty), uncurry0 (RETURN fmempty)) \ unit_rel \\<^sub>f \map_fmap_rel\nres_rel\ + by (auto simp: map_fmap_rel_def br_def fmempty_def frefI nres_relI) + +lemmas [sepref_fr_rules] = + hm.empty_hnr[FCOMP fmempty_empty, unfolded op_fmap_empty_def[symmetric]] + +abbreviation iam_fmap_assn where + \iam_fmap_assn K V \ hr_comp (iam.assn K V) map_fmap_rel\ + +lemmas iam_fmap_delete_hnr [sepref_fr_rules] = + iam.delete_hnr[FCOMP fmdrop_set_None] + +lemmas iam_ffmap_update_hnr [sepref_fr_rules] = + iam.update_hnr[FCOMP map_upd_fmupd] + + +lemmas iam_ffmap_lookup_hnr [sepref_fr_rules] = + iam.lookup_hnr[FCOMP op_map_lookup_fmlookup] + +definition op_iam_fmap_empty where + \op_iam_fmap_empty = fmempty\ + +lemma iam_fmempty_empty: + \(uncurry0 (RETURN op_map_empty), uncurry0 (RETURN op_iam_fmap_empty)) \ unit_rel \\<^sub>f \map_fmap_rel\nres_rel\ + by (auto simp: map_fmap_rel_def br_def fmempty_def frefI nres_relI op_iam_fmap_empty_def) + +lemmas [sepref_fr_rules] = + iam.empty_hnr[FCOMP fmempty_empty, unfolded op_iam_fmap_empty_def[symmetric]] + +definition upper_bound_on_dom where + \upper_bound_on_dom A = SPEC(\n. \i \#(dom_m A). i < n)\ + +lemma [sepref_fr_rules]: + \((Array.len), upper_bound_on_dom) \ (iam_fmap_assn nat_assn V)\<^sup>k \\<^sub>a nat_assn\ +proof - + have [simp]: \finite (dom b) \ i \ fset (fmdom (map_of_fmap b)) \ i \ dom b\ for i b + by (subst fmdom.abs_eq) + (auto simp: eq_onp_def fset.Abs_fset_inverse) + have 2: \nat_rel = the_pure (nat_assn)\ and + 3: \nat_assn = pure nat_rel\ + by auto + have [simp]: \the_pure (\a c :: nat. \ (c = a)) = nat_rel\ + apply (subst 2) + apply (subst 3) + apply (subst pure_def) + apply auto + done + + have [simp]: \(iam_of_list l, b) \ the_pure (\a c :: nat. \ (c = a)) \ \the_pure V\option_rel \ + b i = Some y \ i < length l\ for i b l y + by (auto dest!: fun_relD[of _ _ _ _ i i] simp: option_rel_def + iam_of_list_def split: if_splits) + show ?thesis + by sepref_to_hoare + (sep_auto simp: upper_bound_on_dom_def hr_comp_def iam.assn_def map_rel_def + map_fmap_rel_def is_iam_def br_def dom_m_def) +qed + + +lemma fmap_rel_nat_rel_dom_m[simp]: + \(A, B) \ \nat_rel, R\fmap_rel \ dom_m A = dom_m B\ + by (subst distinct_set_mset_eq_iff[symmetric]) + (auto simp: fmap_rel_alt_def distinct_mset_dom + simp del: fmap_rel_nat_the_fmlookup) + +lemma ref_two_step': + \A \ B \ \ R A \ \ R B\ + using ref_two_step by auto + +end diff --git a/thys/PAC_Checker/PAC_More_Poly.thy b/thys/PAC_Checker/PAC_More_Poly.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_More_Poly.thy @@ -0,0 +1,926 @@ +(* + File: PAC_More_Poly.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_More_Poly + imports "HOL-Library.Poly_Mapping" "HOL-Algebra.Polynomials" "Polynomials.MPoly_Type_Class" + "HOL-Algebra.Module" "HOL-Library.Countable_Set" +begin + + +section \Overview\ + +text \ + +One solution to check circuit of multipliers is to use algebraic method, like producing proofs on +polynomials. We are here interested in checking PAC proofs on the Boolean ring. The idea is the +following: each variable represents an input or the output of a gate and we want to prove the +bitwise multiplication of the input bits yields the output, namely the bitwise representation of the +multiplication of the input (modulo \<^term>\(2::nat)^n\ where \<^term>\n::nat\ is the number of bits of the +circuit). + +Algebraic proof systems typically reason over polynomials in a ring $\set K[X]$, +where the variables $X$ represent Boolean values. +The aim of an algebraic proof is to derive whether a polynomial $f$ can be derived from a given set of polynomials +$G = \{g_1,\dots,g_l\} \subseteq \set K[X]$ together with the Boolean value constraints +$B(X) = \{x^2_i-x_i \mid x_i \in X\}$. In algebraic terms this means to show that the polynomial \<^latex>\\(f \in \langle G \cup B(X)\rangle\)\. + +In our setting we set $\set K = \set Z$ and we treat the Boolean value constraints implicitly, i.e., +we consider proofs in the ring \<^latex>\\(\set Z[X]/\langle B(X)\rangle\)\ to admit shorter proofs + + + +The checker takes as input 3 files: + \<^enum> an input file containing all polynomials that are initially present; + \<^enum> a target (or specification) polynomial ; + \<^enum> a ``proof'' file to check that contains the proof in PAC format that shows that the specification + is in the ideal generated by the polynomials present initially. + + +Each step of the proof is either an addition of two polynomials previously derived, a multiplication +from a previously derived polynomial and an arbitrary polynomial, and the deletion a derived +polynomial. + +One restriction on the proofs compared to generic PAC proofs is that \<^term>\(x::nat)^2 = x\ in the +Boolean ring we are considering. + +The checker can produce two outputs: valid (meaning that each derived polynomial in the proof has +been correctly derived and the specification polynomial was also derived at some point [either in +the proof or as input]) or invalid (without proven information what went wrong). + + +The development is organised as follows: + \<^item> \<^file>\PAC_Specification.thy\ (this file) contains the specification as described above on ideals + without any peculiarities on the PAC proof format + \<^item> \<^file>\PAC_Checker_Specification.thy\ specialises to the PAC format and enters the nondeterminism + monad to prepare the subsequent refinements. + \<^item> \<^file>\PAC_Checker.thy\ contains the refined version where polynomials are represented as lists. + \<^item> \<^file>\PAC_Checker_Synthesis.thy\ contains the efficient implementation with imperative data + structure like a hash set. + \<^item> \<^file>\PAC_Checker_MLton.thy\ contains the code generation and the command to compile the file with + the ML compiler MLton. + + +Here is an example of a proof and an input file (taken from the appendix of our FMCAD +paper~\cite{KaufmannFleuryBiere-FMCAD20}, available at \<^url>\http://fmv.jku.at/pacheck_pasteque\): +\<^verbatim>\ + + 1 x*y; 3 = fz, -z+1; + 2 y*z-y-z+1; 4 * 3, y-1, -fz*y+fz-y*z+y+z-1; + 5 + 2, 4, -fz*y+fz; + 2 d; + 4 d; + 6 * 1, fz, fz*x*y; + -x*z+x; 1 d; + 7 * 5, x, -fz*x*y+fz*x; + 8 + 6, 7, fz*x; + 9 * 3, x, -fz*x-x*z+x; + 10 + 8, 9, -x*z+x; +\ + +Each line starts with a number that is used to index the (conclusion) polynomial. In the proof, +there are four kind of steps: + \<^enum> \<^verbatim>\3 = fz, -z+1;\ is an extension that introduces a new variable (in this case \<^verbatim>\fz\); + \<^enum> \<^verbatim>\4 * 3, y-1, -fz*y+fz-y*z+y+z-1;\ is a multiplication of the existing polynomial with + index 3 by the arbitrary polynomial \<^verbatim>\y-1\ and generates the new polynomial + \<^verbatim>\-fz*y+fz-y*z+y+z-1\ with index 4; + \<^enum> \<^verbatim>\5 + 2, 4, -fz*y+fz;\ is an addition of the existing polynomials with + index 2 and 4 and generates the new polynomial \<^verbatim>\-fz*y+fz\ with index 5; + \<^enum> \<^verbatim>\1 d;\ deletes the polynomial with index 1 and it cannot be reused in subsequent steps. + + + +Remark that unlike DRAT checker, we do forward checking and check every derived polynomial. The +target polynomial can also be part of the input file. +\ + +section \Libraries\ + +subsection \More Polynomials\ + +text \ + + Here are more theorems on polynomials. Most of these facts are + extremely trivial and should probably be generalised and moved to + the Isabelle distribution. +\ + +lemma Const\<^sub>0_add: + \Const\<^sub>0 (a + b) = Const\<^sub>0 a + Const\<^sub>0 b\ + by transfer + (simp add: Const\<^sub>0_def single_add) + +lemma Const_mult: + \Const (a * b) = Const a * Const b\ + by transfer (simp add: Const\<^sub>0_def times_monomial_monomial) + +lemma Const\<^sub>0_mult: + \Const\<^sub>0 (a * b) = Const\<^sub>0 a * Const\<^sub>0 b\ + by transfer (simp add: Const\<^sub>0_def times_monomial_monomial) + +lemma Const0[simp]: + \Const 0 = 0\ + by transfer (simp add: Const\<^sub>0_def) + +lemma (in -) Const_uminus[simp]: + \Const (-n) = - Const n\ + by transfer (auto simp: Const\<^sub>0_def monomial_uminus) + +lemma [simp]: \Const\<^sub>0 0 = 0\ + \MPoly 0 = 0\ + by (auto simp: Const\<^sub>0_def zero_mpoly_def) + +lemma Const_add: + \Const (a + b) = Const a + Const b\ + by transfer (simp add: Const\<^sub>0_def single_add) + +instance mpoly :: (comm_semiring_1) comm_semiring_1 + by standard + +lemma degree_uminus[simp]: + \degree (-A) x' = degree A x'\ + by (auto simp: degree_def uminus_mpoly.rep_eq) + +lemma degree_sum_notin: + \x' \ vars B \ degree (A + B) x' = degree A x'\ + apply (auto simp: degree_def) + apply (rule arg_cong[of _ _ Max]) + apply standard+ + apply (auto simp: plus_mpoly.rep_eq UN_I UnE image_iff in_keys_iff subsetD vars_def lookup_add + dest: keys_add intro: in_keys_plusI1 cong: ball_cong_simp) + done + +lemma degree_notin_vars: + \x \ (vars B) \ degree (B :: 'a :: {monoid_add} mpoly) x = 0\ + using degree_sum_notin[of x B 0] + by auto + +lemma not_in_vars_coeff0: + \x \ vars p \ MPoly_Type.coeff p (monomial (Suc 0) x) = 0\ + by (subst not_not[symmetric], subst coeff_keys[symmetric]) + (auto simp: vars_def) + +lemma keys_add': + "p \ keys (f + g) \ p \ keys f \ keys g" + by transfer auto + +lemma keys_mapping_sum_add: + \finite A \ keys (mapping_of (\v \ A. f v)) \ \(keys ` mapping_of ` f ` UNIV)\ + by (induction A rule: finite_induct) + (auto simp add: zero_mpoly.rep_eq plus_mpoly.rep_eq + keys_plus_ninv_comm_monoid_add dest: keys_add') + +lemma vars_sum_vars_union: + fixes f :: \int mpoly \ int mpoly\ + assumes \finite {v. f v \ 0}\ + shows \vars (\v | f v \ 0. f v * v) \ \(vars ` {v. f v \ 0}) \ \(vars ` f ` {v. f v \ 0})\ + (is \?A \ ?B\) +proof + fix p + assume \p \ vars (\v | f v \ 0. f v * v)\ + then obtain x where \x \ keys (mapping_of (\v | f v \ 0. f v * v))\ and + p: \p \ keys x\ + by (auto simp: vars_def times_mpoly.rep_eq simp del: keys_mult) + then have \x \ (\x. keys (mapping_of (f x) * mapping_of x))\ + using keys_mapping_sum_add[of \{v. f v \ 0}\ \\x. f x * x\] assms + by (auto simp: vars_def times_mpoly.rep_eq) + then have \x \ (\x. {a+b| a b. a \ keys (mapping_of (f x)) \ b \ keys (mapping_of x)})\ + using Union_mono[OF ] keys_mult by fast + then show \p \ ?B\ + using p by (force simp: vars_def zero_mpoly.rep_eq dest!: keys_add') +qed + + +lemma vars_in_right_only: + "x \ vars q \ x \ vars p \ x \ vars (p+q)" + unfolding vars_def keys_def plus_mpoly.rep_eq lookup_plus_fun + apply clarify + subgoal for xa + by (auto simp: vars_def keys_def plus_mpoly.rep_eq + lookup_plus_fun intro!: exI[of _ xa] dest!: spec[of _ xa]) + done + +lemma [simp]: + \vars 0 = {}\ + by (simp add: vars_def zero_mpoly.rep_eq) + + +lemma vars_Un_nointer: + \keys (mapping_of p) \ keys (mapping_of q) = {} \ vars (p + q) = vars p \ vars q\ + by (auto simp: vars_def plus_mpoly.rep_eq simp flip: More_MPoly_Type.keys_add dest!: keys_add') + +lemmas [simp] = zero_mpoly.rep_eq + +lemma polynomial_sum_monoms: + fixes p :: \'a :: {comm_monoid_add,cancel_comm_monoid_add} mpoly\ + shows + \p = (\x\keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\ + \keys (mapping_of p) \ I \ finite I \ p = (\x\I. MPoly_Type.monom x (MPoly_Type.coeff p x))\ +proof - + define J where \J \ keys (mapping_of p)\ + define a where \a x \ coeff p x\ for x + have \finite (keys (mapping_of p))\ + by auto + have \p = (\x\I. MPoly_Type.monom x (MPoly_Type.coeff p x))\ + if \finite I\ and \keys (mapping_of p) \ I\ + for I + using that + unfolding a_def + proof (induction I arbitrary: p rule: finite_induct) + case empty + then have \p = 0\ + using empty coeff_all_0 coeff_keys by blast + then show ?case using empty by (auto simp: zero_mpoly.rep_eq) + next + case (insert x F) note fin = this(1) and xF = this(2) and IH = this(3) and + incl = this(4) + let ?p = \p - MPoly_Type.monom x (MPoly_Type.coeff p x)\ + have H: \\xa. x \ F \ xa \ F \ + MPoly_Type.monom xa (MPoly_Type.coeff (p - MPoly_Type.monom x (MPoly_Type.coeff p x)) xa) = + MPoly_Type.monom xa (MPoly_Type.coeff p xa)\ + by (metis (mono_tags, hide_lams) add_diff_cancel_right' remove_term_coeff + remove_term_sum when_def) + have \?p = (\xa\F. MPoly_Type.monom xa (MPoly_Type.coeff ?p xa))\ + apply (rule IH) + using incl apply - + by standard (smt Diff_iff Diff_insert_absorb add_diff_cancel_right' + remove_term_keys remove_term_sum subsetD xF) + also have \... = (\xa\F. MPoly_Type.monom xa (MPoly_Type.coeff p xa))\ + by (use xF in \auto intro!: sum.cong simp: H\) + finally show ?case + apply (subst (asm) remove_term_sum[of x p, symmetric]) + apply (subst remove_term_sum[of x p, symmetric]) + using xF fin by (auto simp: ac_simps) + qed + from this[of I] this[of J] show + \p = (\x\keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\ + \keys (mapping_of p) \ I \ finite I \ p = (\x\I. MPoly_Type.monom x (MPoly_Type.coeff p x))\ + by (auto simp: J_def) +qed + + +lemma vars_mult_monom: + fixes p :: \int mpoly\ + shows \vars (p * (monom (monomial (Suc 0) x') 1)) = (if p = 0 then {} else insert x' (vars p))\ +proof - + + let ?v = \monom (monomial (Suc 0) x') 1\ + have + p: \p = (\x\keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\ (is \_ = (\x \ ?I. ?f x)\) + using polynomial_sum_monoms(1)[of p] . + have pv: \p * ?v = (\x \ ?I. ?f x * ?v)\ + by (subst p) (auto simp: field_simps sum_distrib_left) + define I where \I \ ?I\ + have in_keysD: \x \ keys (mapping_of (\x\I. MPoly_Type.monom x (h x))) \ x \ I\ + if \finite I\ for I and h :: \_ \ int\ and x + using that by (induction rule: finite_induct) + (force simp: monom.rep_eq empty_iff insert_iff keys_single coeff_monom + simp: coeff_keys simp flip: coeff_add + simp del: coeff_add)+ + have in_keys: \keys (mapping_of (\x\I. MPoly_Type.monom x (h x))) = (\x \ I. (if h x = 0 then {} else {x}))\ + if \finite I\ for I and h :: \_ \ int\ and x + supply in_keysD[dest] + using that by (induction rule: finite_induct) + (auto simp: plus_mpoly.rep_eq MPoly_Type_Class.keys_plus_eqI) + + have H[simp]: \vars ((\x\I. MPoly_Type.monom x (h x))) = (\x\I. (if h x = 0 then {} else keys x))\ + if \finite I\ for I and h :: \_ \ int\ + using that by (auto simp: vars_def in_keys) + + have sums: \(\x\I. + MPoly_Type.monom (x + a') (c x)) = + (\x\ (\x. x + a') ` I. + MPoly_Type.monom x (c (x - a')))\ + if \finite I\ for I a' c q + using that apply (induction rule: finite_induct) + subgoal by auto + subgoal + unfolding image_insert by (subst sum.insert) auto + done + have non_zero_keysEx: \p \ 0 \ \a. a \ keys (mapping_of p)\ for p :: \int mpoly\ + using mapping_of_inject by (fastforce simp add: ex_in_conv) + have \finite I\ \keys (mapping_of p) \ I\ + unfolding I_def by auto + then show + \vars (p * (monom (monomial (Suc 0) x') 1)) = (if p = 0 then {} else insert x' (vars p))\ + apply (subst pv, subst I_def[symmetric], subst mult_monom) + apply (auto simp: mult_monom sums I_def) + using Poly_Mapping.keys_add vars_def apply fastforce + apply (auto dest!: non_zero_keysEx) + apply (rule_tac x= \a + monomial (Suc 0) x'\ in bexI) + apply (auto simp: coeff_keys) + apply (simp add: in_keys_iff lookup_add) + apply (auto simp: vars_def) + apply (rule_tac x= \xa + monomial (Suc 0) x'\ in bexI) + apply (auto simp: coeff_keys) + apply (simp add: in_keys_iff lookup_add) + done +qed + + + term \(x', u, lookup u x', A)\ +lemma in_mapping_mult_single: + \x \ (\x. lookup x x') ` keys (A * (Var\<^sub>0 x' :: (nat \\<^sub>0 nat) \\<^sub>0 'b :: {monoid_mult,zero_neq_one,semiring_0})) \ + x > 0 \ x - 1 \ (\x. lookup x x') ` keys (A)\ + apply (standard+; clarify) + subgoal + apply (auto elim!: in_keys_timesE simp: lookup_add) + apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff) + done + subgoal + apply (auto elim!: in_keys_timesE simp: lookup_add) + apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff) + done + subgoal for xa + apply (auto elim!: in_keys_timesE simp: lookup_add) + apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff lookup_add + intro!: exI[of _ \xa + Poly_Mapping.single x' 1\]) + done + done + +lemma Max_Suc_Suc_Max: + \finite A \ A \ {} \ Max (insert 0 (Suc ` A)) = + Suc (Max (insert 0 A))\ + by (induction rule: finite_induct) + (auto simp: hom_Max_commute) + +lemma [simp]: + \keys (Var\<^sub>0 x' :: ('a \\<^sub>0 nat) \\<^sub>0 'b :: {zero_neq_one}) = {Poly_Mapping.single x' 1}\ + by (auto simp: Var\<^sub>0_def) + + +lemma degree_mult_Var: + \degree (A * Var x') x' = (if A = 0 then 0 else Suc (degree A x'))\ for A :: \int mpoly\ +proof - + have [simp]: \A \ 0 \ + Max (insert 0 ((\x. Suc (lookup x x')) ` keys (mapping_of A))) = + Max (insert (Suc 0) ((\x. Suc (lookup x x')) ` keys (mapping_of A)))\ + unfolding image_image[of Suc \\x. lookup x x'\, symmetric] image_insert[symmetric] + by (subst Max_Suc_Suc_Max, use mapping_of_inject in fastforce, use mapping_of_inject in fastforce)+ + (simp add: Max.hom_commute) + have \A \ 0 \ + Max (insert 0 + ((\x. lookup x x') ` + keys (mapping_of A * mapping_of (Var x')))) = + Suc (Max (insert 0 ((\m. lookup m x') ` keys (mapping_of A))))\ + by (subst arg_cong[of _ \insert 0 + (Suc ` ((\x. lookup x x') ` keys (mapping_of A)))\ Max]) + (auto simp: image_image Var.rep_eq lookup_plus_fun in_mapping_mult_single + hom_Max_commute Max_Suc_Suc_Max + elim!: in_keys_timesE split: if_splits) + then show ?thesis + by (auto simp: degree_def times_mpoly.rep_eq + intro!: arg_cong[of _ \insert 0 + (Suc ` ((\x. lookup x x') ` keys (mapping_of A)))\ Max]) +qed + +lemma degree_mult_Var': + \degree (Var x' * A) x' = (if A = 0 then 0 else Suc (degree A x'))\ for A :: \int mpoly\ + by (simp add: degree_mult_Var semiring_normalization_rules(7)) + +lemma degree_times_le: + \degree (A * B) x \ degree A x + degree B x\ + by (auto simp: degree_def times_mpoly.rep_eq + max_def lookup_add add_mono + dest!: set_rev_mp[OF _ Poly_Mapping.keys_add] + elim!: in_keys_timesE) + +lemma monomial_inj: + "monomial c s = monomial (d::'b::zero_neq_one) t \ (c = 0 \ d = 0) \ (c = d \ s = t)" + by (fastforce simp add: monomial_inj Poly_Mapping.single_def + poly_mapping.Abs_poly_mapping_inject when_def fun_eq_iff + cong: if_cong + split: if_splits) + +lemma MPoly_monomial_power': + \MPoly (monomial 1 x') ^ (n+1) = MPoly (monomial (1) (((\x. x + x') ^^ n) x'))\ + by (induction n) + (auto simp: times_mpoly.abs_eq mult_single ac_simps) + +lemma MPoly_monomial_power: + \n > 0 \ MPoly (monomial 1 x') ^ (n) = MPoly (monomial (1) (((\x. x + x') ^^ (n - 1)) x'))\ + using MPoly_monomial_power'[of _ \n-1\] + by auto + + +lemma vars_uminus[simp]: + \vars (-p) = vars p\ + by (auto simp: vars_def uminus_mpoly.rep_eq) + +lemma coeff_uminus[simp]: + \MPoly_Type.coeff (-p) x = -MPoly_Type.coeff p x\ + by (auto simp: coeff_def uminus_mpoly.rep_eq) + +definition decrease_key::"'a \ ('a \\<^sub>0 'b::{monoid_add, minus,one}) \ ('a \\<^sub>0 'b)" where + "decrease_key k0 f = Abs_poly_mapping (\k. if k = k0 \ lookup f k \ 0 then lookup f k - 1 else lookup f k)" + +lemma remove_key_lookup: + "lookup (decrease_key k0 f) k = (if k = k0 \ lookup f k \ 0 then lookup f k - 1 else lookup f k)" + unfolding decrease_key_def using finite_subset apply (simp add: ) + apply (subst lookup_Abs_poly_mapping) + apply (auto intro: finite_subset[of _ \{x. lookup f x \ 0}\]) + apply (subst lookup_Abs_poly_mapping) + apply (auto intro: finite_subset[of _ \{x. lookup f x \ 0}\]) + done + +lemma polynomial_split_on_var: + fixes p :: \'a :: {comm_monoid_add,cancel_comm_monoid_add,semiring_0,comm_semiring_1} mpoly\ + obtains q r where + \p = monom (monomial (Suc 0) x') 1 * q + r\ and + \x' \ vars r\ +proof - + have [simp]: \{x \ keys (mapping_of p). x' \ keys x} \ + {x \ keys (mapping_of p). x' \ keys x} = keys (mapping_of p)\ + by auto + have + \p = (\x\keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\ (is \_ = (\x \ ?I. ?f x)\) + using polynomial_sum_monoms(1)[of p] . + also have \... = (\x\ {x \ ?I. x' \ keys x}. ?f x) + (\x\ {x \ ?I. x' \ keys x}. ?f x)\ (is \_ = ?pX + ?qX\) + by (subst comm_monoid_add_class.sum.union_disjoint[symmetric]) auto + finally have 1: \p = ?pX + ?qX\ . + have H: \0 < lookup x x' \ (\k. (if x' = k then Suc 0 else 0) + + (if k = x' \ 0 < lookup x k then lookup x k - 1 + else lookup x k)) = lookup x\ for x x' + by auto + have [simp]: \finite {x. 0 < (Suc 0 when x' = x)}\ for x' :: nat and x + by (smt bounded_nat_set_is_finite lessI mem_Collect_eq neq0_conv when_cong when_neq_zero) + have H: \x' \ keys x \ monomial (Suc 0) x' + Abs_poly_mapping (\k. if k = x' \ 0 < lookup x k then lookup x k - 1 else lookup x k) = x\ + for x and x' :: nat + apply (simp only: keys_def single.abs_eq) + apply (subst plus_poly_mapping.abs_eq) + by (auto simp: eq_onp_def when_def H + intro!: finite_subset[of \{xa. (xa = x' \ 0 < lookup x xa \ Suc 0 < lookup x x') \ + (xa \ x' \ 0 < lookup x xa)}\ \{xa. 0 < lookup x xa}\]) + + have [simp]: \x' \ keys x \ + MPoly_Type.monom (monomial (Suc 0) x' + decrease_key x' x) n = + MPoly_Type.monom x n\ for x n and x' + apply (subst mpoly.mapping_of_inject[symmetric], subst poly_mapping.lookup_inject[symmetric]) + unfolding mapping_of_monom lookup_single + apply (auto intro!: ext simp: decrease_key_def when_def H) + done + have pX: \?pX = monom (monomial (Suc 0) x') 1 * (\x\ {x \ ?I. x' \ keys x}. MPoly_Type.monom (decrease_key x' x) (MPoly_Type.coeff p x))\ + (is \_ = _ * ?pX'\) + by (subst sum_distrib_left, subst mult_monom) + (auto intro!: sum.cong) + have \x' \ vars ?qX\ + using vars_setsum[of \{x. x \ keys (mapping_of p) \ x' \ keys x}\ \?f\] + by (auto dest!: vars_monom_subset[unfolded subset_eq Ball_def, rule_format]) + then show ?thesis + using that[of ?pX' ?qX] + unfolding pX[symmetric] 1[symmetric] + by blast +qed + + +lemma polynomial_split_on_var2: + fixes p :: \int mpoly\ + assumes \x' \ vars s\ + obtains q r where + \p = (monom (monomial (Suc 0) x') 1 - s) * q + r\ and + \x' \ vars r\ +proof - + have eq[simp]: \monom (monomial (Suc 0) x') 1 = Var x'\ + by (simp add: Var.abs_eq Var\<^sub>0_def monom.abs_eq) + have \\m \ n. \P::int mpoly. degree P x' < m \ (\A B. P = (Var x' - s) * A + B \ x' \ vars B)\ for n + proof (induction n) + case 0 + then show ?case by auto + next + case (Suc n) + then have IH: \m\n \ MPoly_Type.degree P x' < m \ + (\A B. P = (Var x' - s) * A + B \ x' \ vars B)\ for m P + by fast + show ?case + proof (intro allI impI) + fix m and P :: \int mpoly\ + assume \m \ Suc n\ and deg: \MPoly_Type.degree P x' < m\ + consider + \m \ n\ | + \m = Suc n\ + using \m \ Suc n\ by linarith + then show \\A B. P = (Var x' - s) * A + B \ x' \ vars B\ + proof cases + case 1 + then show \?thesis\ + using Suc deg by blast + next + case [simp]: 2 + obtain A B where + P: \P = Var x' * A + B\ and + \x' \ vars B\ + using polynomial_split_on_var[of P x'] unfolding eq by blast + have P': \P = (Var x' - s) * A + (s * A + B)\ + by (auto simp: field_simps P) + have \A = 0 \ degree (s * A) x' < degree P x'\ + using deg \x' \ vars B\ \x' \ vars s\ degree_times_le[of s A x'] deg + unfolding P + by (auto simp: degree_sum_notin degree_mult_Var' degree_mult_Var degree_notin_vars + split: if_splits) + then obtain A' B' where + sA: \s*A = (Var x' - s) * A' + B'\ and + \x' \ vars B'\ + using IH[of \m-1\ \s*A\] deg \x' \ vars B\ that[of 0 0] + by (cases \0 < n\) (auto dest!: vars_in_right_only) + have \P = (Var x' - s) * (A + A') + (B' + B)\ + unfolding P' sA by (auto simp: field_simps) + moreover have \x' \ vars (B' + B)\ + using \x' \ vars B'\ \x' \ vars B\ + by (meson UnE subset_iff vars_add) + ultimately show ?thesis + by fast + qed + qed + qed + then show ?thesis + using that unfolding eq + by blast +qed + +lemma finit_whenI[intro]: + \finite {x. (0 :: nat) < (y x)} \ finite {x. 0 < (y x when x \ x')}\ + apply (rule finite_subset) + defer apply assumption + apply (auto simp: when_def) + done + +lemma polynomial_split_on_var_diff_sq2: + fixes p :: \int mpoly\ + obtains q r s where + \p = monom (monomial (Suc 0) x') 1 * q + r + s * (monom (monomial (Suc 0) x') 1^2 - monom (monomial (Suc 0) x') 1)\ and + \x' \ vars r\ and + \x' \ vars q\ +proof - + let ?v = \monom (monomial (Suc 0) x') 1 :: int mpoly\ + have H: \n < m \ n > 0 \ \q. ?v^n = ?v + q * (?v^2 - ?v)\ for n m :: nat + proof (induction m arbitrary: n) + case 0 + then show ?case by auto + next + case (Suc m n) note IH = this(1-) + consider + \n < m\ | + \m = n\ \n > 1\ | + \n = 1\ + using IH + by (cases \n < m\; cases n) auto + then show ?case + proof cases + case 1 + then show ?thesis using IH by auto + next + case 2 + have eq: \?v^(n) = ((?v :: int mpoly) ^ (n-2)) * (?v^2-?v) + ?v^(n-1)\ + using 2 by (auto simp: field_simps power_eq_if + ideal.scale_right_diff_distrib) + obtain q where + q: \?v^(n-1) = ?v + q * (?v^2 - ?v)\ + using IH(1)[of \n-1\] 2 + by auto + show ?thesis + using q unfolding eq + by (auto intro!: exI[of _ \?v ^ (n - 2) + q\] simp: distrib_right) + next + case 3 + then show \?thesis\ + by auto + qed + qed + have H: \n>0 \ \q. ?v^n = ?v + q * (?v^2-?v)\ for n + using H[of n \n+1\] + by auto + obtain qr :: \nat \ int mpoly\ where + qr: \n > 0 \ ?v^n = ?v + qr n * (?v^2-?v)\ for n + using H by metis + have vn: \(if lookup x x' = 0 then 1 else Var x' ^ lookup x x') = + (if lookup x x' = 0 then 1 else ?v) + (if lookup x x' = 0 then 0 else 1) * qr (lookup x x') * (?v^2-?v)\ for x + by (simp add: qr[symmetric] Var_def Var\<^sub>0_def monom.abs_eq[symmetric] cong: if_cong) + + have q: \p = (\x\keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\ + by (rule polynomial_sum_monoms(1)[of p]) + have [simp]: + \lookup x x' = 0 \ + Abs_poly_mapping (\k. lookup x k when k \ x') = x\ for x + by (cases x, auto simp: poly_mapping.Abs_poly_mapping_inject) + (auto intro!: ext simp: when_def) + have [simp]: \finite {x. 0 < (a when x' = x)}\ for a :: nat + by (metis (no_types, lifting) infinite_nat_iff_unbounded less_not_refl lookup_single lookup_single_not_eq mem_Collect_eq) + + have [simp]: \((\x. x + monomial (Suc 0) x') ^^ (n)) + (monomial (Suc 0) x') = Abs_poly_mapping (\k. (if k = x' then n+1 else 0))\ for n + by (induction n) + (auto simp: single_def Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def cong:if_cong) + have [simp]: \0 < lookup x x' \ + Abs_poly_mapping (\k. lookup x k when k \ x') + + Abs_poly_mapping (\k. if k = x' then lookup x x' - Suc 0 + 1 else 0) = + x\ for x + apply (cases x, auto simp: poly_mapping.Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def) + apply (subst plus_poly_mapping.abs_eq) + apply (auto simp: poly_mapping.Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def) + apply (subst Abs_poly_mapping_inject) + apply auto + done + define f where + \f x = (MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)) * + (if lookup x x' = 0 then 1 else Var x' ^ (lookup x x'))\ for x + have f_alt_def: \f x = MPoly_Type.monom x (MPoly_Type.coeff p x)\ for x + by (auto simp: f_def monom_def remove_key_def Var_def MPoly_monomial_power Var\<^sub>0_def + mpoly.MPoly_inject monomial_inj times_mpoly.abs_eq + times_mpoly.abs_eq mult_single) + have p: \p = (\x\keys (mapping_of p). + MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) * + (if lookup x x' = 0 then 1 else ?v)) + + (\x\keys (mapping_of p). + MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) * + (if lookup x x' = 0 then 0 + else 1) * qr (lookup x x')) * + (?v\<^sup>2 - ?v)\ + (is \_ = ?a + ?v2v\) + apply (subst q) + unfolding f_alt_def[symmetric, abs_def] f_def vn semiring_class.distrib_left + comm_semiring_1_class.semiring_normalization_rules(18) semiring_0_class.sum_distrib_right + by (simp add: semiring_class.distrib_left + sum.distrib) + + have I: \keys (mapping_of p) = {x \ keys (mapping_of p). lookup x x' = 0} \ {x \ keys (mapping_of p). lookup x x' \ 0}\ + by auto + + have \p = (\x | x \ keys (mapping_of p) \ lookup x x' = 0. + MPoly_Type.monom x (MPoly_Type.coeff p x)) + + (\x | x \ keys (mapping_of p) \ lookup x x' \ 0. + MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)) * + (MPoly_Type.monom (monomial (Suc 0) x') 1) + + (\x | x \ keys (mapping_of p) \ lookup x x' \ 0. + MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) * + qr (lookup x x')) * + (?v\<^sup>2 - ?v)\ + (is \p = ?A + ?B * _ + ?C * _\) + unfolding semiring_0_class.sum_distrib_right[of _ _ \(MPoly_Type.monom (monomial (Suc 0) x') 1)\] + apply (subst p) + apply (subst (2)I) + apply (subst I) + apply (subst comm_monoid_add_class.sum.union_disjoint) + apply auto[3] + apply (subst comm_monoid_add_class.sum.union_disjoint) + apply auto[3] + apply (subst (4) sum.cong[OF refl, of _ _ \\x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) * + qr (lookup x x')\]) + apply (auto; fail) + apply (subst (3) sum.cong[OF refl, of _ _ \\x. 0\]) + apply (auto; fail) + apply (subst (2) sum.cong[OF refl, of _ _ \\x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) * + (MPoly_Type.monom (monomial (Suc 0) x') 1)\]) + apply (auto; fail) + apply (subst (1) sum.cong[OF refl, of _ _ \\x. MPoly_Type.monom x (MPoly_Type.coeff p x)\]) + by (auto simp: f_def simp flip: f_alt_def) + + moreover have \x' \ vars ?A\ + using vars_setsum[of \{x \ keys (mapping_of p). lookup x x' = 0}\ + \\x. MPoly_Type.monom x (MPoly_Type.coeff p x)\] + apply auto + apply (drule set_rev_mp, assumption) + apply (auto dest!: lookup_eq_zero_in_keys_contradict) + by (meson lookup_eq_zero_in_keys_contradict subsetD vars_monom_subset) + moreover have \x' \ vars ?B\ + using vars_setsum[of \{x \ keys (mapping_of p). lookup x x' \ 0}\ + \\x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)\] + apply auto + apply (drule set_rev_mp, assumption) + apply (auto dest!: lookup_eq_zero_in_keys_contradict) + apply (drule subsetD[OF vars_monom_subset]) + apply (auto simp: remove_key_keys[symmetric]) + done + ultimately show ?thesis apply - + apply (rule that[of ?B ?A ?C]) + apply (auto simp: ac_simps) + done +qed + + +lemma polynomial_decomp_alien_var: + fixes q A b :: \int mpoly\ + assumes + q: \q = A * (monom (monomial (Suc 0) x') 1) + b\ and + x: \x' \ vars q\ \x' \ vars b\ + shows + \A = 0\ and + \q = b\ +proof - + let ?A = \A * (monom (monomial (Suc 0) x') 1)\ + have \?A = q - b\ + using arg_cong[OF q, of \\a. a - b\] + by auto + moreover have \x' \ vars (q - b)\ + using x vars_in_right_only + by fastforce + ultimately have \x' \ vars (?A)\ + by simp + then have \?A = 0\ + by (auto simp: vars_mult_monom split: if_splits) + moreover have \?A = 0 \ A = 0\ + by (metis empty_not_insert mult_zero_left vars_mult_monom) + ultimately show \A = 0\ + by blast + then show \q = b\ + using q by auto +qed + +lemma polynomial_decomp_alien_var2: + fixes q A b :: \int mpoly\ + assumes + q: \q = A * (monom (monomial (Suc 0) x') 1 + p) + b\ and + x: \x' \ vars q\ \x' \ vars b\ \x' \ vars p\ + shows + \A = 0\ and + \q = b\ +proof - + let ?x = \monom (monomial (Suc 0) x') 1\ + have x'[simp]: \?x = Var x'\ + by (simp add: Var.abs_eq Var\<^sub>0_def monom.abs_eq) + have \\n Ax A'. A = ?x * Ax + A' \ x' \ vars A' \ degree Ax x' = n\ + using polynomial_split_on_var[of A x'] by metis + from wellorder_class.exists_least_iff[THEN iffD1, OF this] obtain Ax A' n where + A: \A = Ax * ?x + A'\ and + \x' \ vars A'\ and + n: \MPoly_Type.degree Ax x' = n\ and + H: \\m Ax A'. m < n \ + A \ Ax * MPoly_Type.monom (monomial (Suc 0) x') 1 + A' \ + x' \ vars A' \ MPoly_Type.degree Ax x' \ m\ + unfolding wellorder_class.exists_least_iff[of \\n. \Ax A'. A = Ax * ?x + A' \ x' \ vars A' \ + degree Ax x' = n\] + by (auto simp: field_simps) + + have \q = (A + Ax * p) * monom (monomial (Suc 0) x') 1 + (p * A' + b)\ + unfolding q A by (auto simp: field_simps) + moreover have \x' \ vars q\ \x' \ vars (p * A' + b)\ + using x \x' \ vars A'\ + by (smt UnE add.assoc add.commute calculation subset_iff vars_in_right_only vars_mult)+ + ultimately have \A + Ax * p = 0\ \q = p * A' + b\ + by (rule polynomial_decomp_alien_var)+ + + have A': \A' = -Ax * ?x - Ax * p\ + using \A + Ax * p = 0\ unfolding A + by (metis (no_types, lifting) add_uminus_conv_diff eq_neg_iff_add_eq_0 minus_add_cancel + mult_minus_left) + + have \A = - (Ax * p)\ + using A unfolding A' + apply auto + done + + obtain Axx Ax' where + Ax: \Ax = ?x * Axx + Ax'\ and + \x' \ vars Ax'\ + using polynomial_split_on_var[of Ax x'] by metis + + have \A = ?x * (- Axx * p) + (- Ax' * p)\ + unfolding \A = - (Ax * p)\ Ax + by (auto simp: field_simps) + + moreover have \x' \ vars (-Ax' * p)\ + using \x' \ vars Ax'\ by (metis (no_types, hide_lams) UnE add.right_neutral + add_minus_cancel assms(4) subsetD vars_in_right_only vars_mult) + moreover have \Axx \ 0 \ MPoly_Type.degree (- Axx * p) x' < degree Ax x'\ + using degree_times_le[of Axx p x'] x + by (auto simp: Ax degree_sum_notin \x' \ vars Ax'\ degree_mult_Var' + degree_notin_vars) + ultimately have [simp]: \Axx = 0\ + using H[of \MPoly_Type.degree (- Axx * p) x'\ \- Axx * p\ \- Ax' * p\] + by (auto simp: n) + then have [simp]: \Ax' = Ax\ + using Ax by auto + + show \A = 0\ + using A \A = - (Ax * p)\ \x' \ vars (- Ax' * p)\ \x' \ vars A'\ polynomial_decomp_alien_var(1) by force + then show \q = b\ + using q by auto +qed + +lemma vars_unE: \x \ vars (a * b) \ (x \ vars a \ thesis) \ (x \ vars b \ thesis) \ thesis\ + using vars_mult[of a b] by auto + + +lemma in_keys_minusI1: + assumes "t \ keys p" and "t \ keys q" + shows "t \ keys (p - q)" + using assms unfolding in_keys_iff lookup_minus by simp + +lemma in_keys_minusI2: + fixes t :: \'a\ and q :: \'a \\<^sub>0 'b :: {cancel_comm_monoid_add,group_add}\ + assumes "t \ keys q" and "t \ keys p" + shows "t \ keys (p - q)" + using assms unfolding in_keys_iff lookup_minus by simp + + +lemma in_vars_addE: + \x \ vars (p + q) \ (x \ vars p \ thesis) \ (x \ vars q \ thesis) \ thesis\ + by (meson UnE in_mono vars_add) + +lemma lookup_monomial_If: + \lookup (monomial v k) = (\k'. if k = k' then v else 0)\ + by (intro ext) (auto simp: lookup_single_not_eq) + +lemma vars_mult_Var: + \vars (Var x * p) = (if p = 0 then {} else insert x (vars p))\ for p :: \int mpoly\ +proof - + have \p \ 0 \ + \xa. (\k. xa = monomial (Suc 0) x + k) \ + lookup (mapping_of p) (xa - monomial (Suc 0) x) \ 0 \ + 0 < lookup xa x\ + by (metis (no_types, hide_lams) One_nat_def ab_semigroup_add_class.add.commute + add_diff_cancel_right' aux lookup_add lookup_single_eq mapping_of_inject + neq0_conv one_neq_zero plus_eq_zero_2 zero_mpoly.rep_eq) + then show ?thesis + apply (auto simp: vars_def times_mpoly.rep_eq Var.rep_eq + elim!: in_keys_timesE dest: keys_add') + apply (auto simp: keys_def lookup_times_monomial_left Var.rep_eq Var\<^sub>0_def adds_def + lookup_add eq_diff_eq'[symmetric]) + done +qed + +lemma keys_mult_monomial: + \keys (monomial (n :: int) k * mapping_of a) = (if n = 0 then {} else ((+) k) ` keys (mapping_of a))\ +proof - + have [simp]: \(\aa. (if k = aa then n else 0) * + (\q. lookup (mapping_of a) q when k + xa = aa + q)) = + (\aa. (if k = aa then n * (\q. lookup (mapping_of a) q when k + xa = aa + q) else 0))\ + for xa + by (smt Sum_any.cong mult_not_zero) + show ?thesis + apply (auto simp: vars_def times_mpoly.rep_eq Const.rep_eq times_poly_mapping.rep_eq + Const\<^sub>0_def elim!: in_keys_timesE split: if_splits) + apply (auto simp: lookup_monomial_If prod_fun_def + keys_def times_poly_mapping.rep_eq) + done +qed + +lemma vars_mult_Const: + \vars (Const n * a) = (if n = 0 then {} else vars a)\ for a :: \int mpoly\ + by (auto simp: vars_def times_mpoly.rep_eq Const.rep_eq keys_mult_monomial + Const\<^sub>0_def elim!: in_keys_timesE split: if_splits) + +lemma coeff_minus: "coeff p m - coeff q m = coeff (p-q) m" + by (simp add: coeff_def lookup_minus minus_mpoly.rep_eq) + +lemma Const_1_eq_1: \Const (1 :: int) = (1 :: int mpoly)\ + by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq) + +lemma [simp]: + \vars (1 :: int mpoly) = {}\ + by (auto simp: vars_def one_mpoly.rep_eq Const_1_eq_1) + + +subsection \More Ideals\ + +lemma + fixes A :: \(('x \\<^sub>0 nat) \\<^sub>0 'a::comm_ring_1) set\ + assumes \p \ ideal A\ + shows \p * q \ ideal A\ + by (metis assms ideal.span_scale semiring_normalization_rules(7)) + + +text \The following theorem is very close to @{thm ideal.span_insert}, except that it +is more useful if we need to take an element of \<^term>\More_Modules.ideal (insert a S)\.\ +lemma ideal_insert': + \More_Modules.ideal (insert a S) = {y. \x k. y = x + k * a \ x \ More_Modules.ideal S}\ + apply (auto simp: ideal.span_insert + intro: exI[of _ \_ - k * a\]) + apply (rule_tac x = \x - k * a\ in exI) + apply auto + apply (rule_tac x = \k\ in exI) + apply auto + done + +lemma ideal_mult_right_in: + \a \ ideal A \ a * b \ More_Modules.ideal A\ + by (metis ideal.span_scale mult.commute) + +lemma ideal_mult_right_in2: + \a \ ideal A \ b * a \ More_Modules.ideal A\ + by (metis ideal.span_scale) + + +lemma [simp]: \vars (Var x :: 'a :: {zero_neq_one} mpoly) = {x}\ + by (auto simp: vars_def Var.rep_eq Var\<^sub>0_def) + +lemma vars_minus_Var_subset: + \vars (p' - Var x :: 'a :: {ab_group_add,one,zero_neq_one} mpoly) \ \ \ vars p' \ insert x \\ + using vars_add[of \p' - Var x\ \Var x\] + by auto + +lemma vars_add_Var_subset: + \vars (p' + Var x :: 'a :: {ab_group_add,one,zero_neq_one} mpoly) \ \ \ vars p' \ insert x \\ + using vars_add[of \p' + Var x\ \-Var x\] + by auto + +lemma coeff_monomila_in_varsD: + \coeff p (monomial (Suc 0) x) \ 0 \ x \ vars (p :: int mpoly)\ + by (auto simp: coeff_def vars_def keys_def + intro!: exI[of _ \monomial (Suc 0) x\]) + +lemma coeff_MPoly_monomial[simp]: + \(MPoly_Type.coeff (MPoly (monomial a m)) m) = a\ + by (metis MPoly_Type.coeff_def lookup_single_eq monom.abs_eq monom.rep_eq) + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Polynomials.thy b/thys/PAC_Checker/PAC_Polynomials.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Polynomials.thy @@ -0,0 +1,490 @@ +theory PAC_Polynomials + imports PAC_Specification Finite_Map_Multiset +begin + + +section \Polynomials of strings\ + +text \ + + Isabelle's definition of polynomials only work with variables of type + \<^typ>\nat\. Therefore, we introduce a version that uses strings by using an injective function + that converts a string to a natural number. It exists because strings are countable. Remark that + the whole development is independent of the function. + +\ + +subsection \Polynomials and Variables\ + +lemma poly_embed_EX: + \\\. bij (\ :: string \ nat)\ + by (rule countableE_infinite[of \UNIV :: string set\]) + (auto intro!: infinite_UNIV_listI) + +text \Using a multiset instead of a list has some advantage from an abstract point of view. First, + we can have monomials that appear several times and the coefficient can also be zero. Basically, + we can represent un-normalised polynomials, which is very useful to talk about intermediate states + in our program. +\ +type_synonym term_poly = \string multiset\ +type_synonym mset_polynomial = + \(term_poly * int) multiset\ + +definition normalized_poly :: \mset_polynomial \ bool\ where + \normalized_poly p \ + distinct_mset (fst `# p) \ + 0 \# snd `# p\ + +lemma normalized_poly_simps[simp]: + \normalized_poly {#}\ + \normalized_poly (add_mset t p) \ snd t \ 0 \ + fst t \# fst `# p \ normalized_poly p\ + by (auto simp: normalized_poly_def) + +lemma normalized_poly_mono: + \normalized_poly B \ A \# B \ normalized_poly A\ + unfolding normalized_poly_def + by (auto intro: distinct_mset_mono image_mset_subseteq_mono) + +definition mult_poly_by_monom :: \term_poly * int \ mset_polynomial \ mset_polynomial\ where + \mult_poly_by_monom = (\ys q. image_mset (\xs. (fst xs + fst ys, snd ys * snd xs)) q)\ + + +definition mult_poly_raw :: \mset_polynomial \ mset_polynomial \ mset_polynomial\ where + \mult_poly_raw p q = + (sum_mset ((\y. mult_poly_by_monom y q) `# p))\ + + +definition remove_powers :: \mset_polynomial \ mset_polynomial\ where + \remove_powers xs = image_mset (apfst remdups_mset) xs\ + + +definition all_vars_mset :: \mset_polynomial \ string multiset\ where + \all_vars_mset p = \# (fst `# p)\ + +abbreviation all_vars :: \mset_polynomial \ string set\ where + \all_vars p \ set_mset (all_vars_mset p)\ + +definition add_to_coefficient :: \_ \ mset_polynomial \ mset_polynomial\ where + \add_to_coefficient = (\(a, n) b. {#(a', _) \# b. a' \ a#} + + (if n + sum_mset (snd `# {#(a', _) \# b. a' = a#}) = 0 then {#} + else {#(a, n + sum_mset (snd `# {#(a', _) \# b. a' = a#}))#}))\ + +definition normalize_poly :: \mset_polynomial \ mset_polynomial\ where + \normalize_poly p = fold_mset add_to_coefficient {#} p\ + +lemma add_to_coefficient_simps: + \n + sum_mset (snd `# {#(a', _) \# b. a' = a#}) \ 0 \ + add_to_coefficient (a, n) b = {#(a', _) \# b. a' \ a#} + + {#(a, n + sum_mset (snd `# {#(a', _) \# b. a' = a#}))#}\ + \n + sum_mset (snd `# {#(a', _) \# b. a' = a#}) = 0 \ + add_to_coefficient (a, n) b = {#(a', _) \# b. a' \ a#}\ and + add_to_coefficient_simps_If: + \add_to_coefficient (a, n) b = {#(a', _) \# b. a' \ a#} + + (if n + sum_mset (snd `# {#(a', _) \# b. a' = a#}) = 0 then {#} + else {#(a, n + sum_mset (snd `# {#(a', _) \# b. a' = a#}))#})\ + by (auto simp: add_to_coefficient_def) + +interpretation comp_fun_commute \add_to_coefficient\ +proof - + have [simp]: + \a \ aa \ + ((case x of (a', _) \ a' \ aa) \ (case x of (a', _) \ a' = a)) \ + (case x of (a', _) \ a' = a)\ for a' aa a x + by auto + show \comp_fun_commute add_to_coefficient\ + unfolding add_to_coefficient_def + by standard + (auto intro!: ext simp: filter_filter_mset ac_simps add_eq_0_iff + intro: filter_mset_cong) +qed + +lemma normalized_poly_normalize_poly[simp]: + \normalized_poly (normalize_poly p)\ + unfolding normalize_poly_def + apply (induction p) + subgoal by auto + subgoal for x p + by (cases x) + (auto simp: add_to_coefficient_simps_If + intro: normalized_poly_mono) + done + + +subsection \Addition\ + +inductive add_poly_p :: \mset_polynomial \ mset_polynomial \ mset_polynomial \ mset_polynomial \ mset_polynomial \ mset_polynomial \ bool\ where +add_new_coeff_r: + \add_poly_p (p, add_mset x q, r) (p, q, add_mset x r)\ | +add_new_coeff_l: + \add_poly_p (add_mset x p, q, r) (p, q, add_mset x r)\ | +add_same_coeff_l: + \add_poly_p (add_mset (x, n) p, q, add_mset (x, m) r) (p, q, add_mset (x, n + m) r)\ | +add_same_coeff_r: + \add_poly_p (p, add_mset (x, n) q, add_mset (x, m) r) (p, q, add_mset (x, n + m) r)\ | +rem_0_coeff: + \add_poly_p (p, q, add_mset (x, 0) r) (p, q, r)\ + +inductive_cases add_poly_pE: \add_poly_p S T\ + +lemmas add_poly_p_induct = + add_poly_p.induct[split_format(complete)] + +lemma add_poly_p_empty_l: + \add_poly_p\<^sup>*\<^sup>* (p, q, r) ({#}, q, p + r)\ + apply (induction p arbitrary: r) + subgoal by auto + subgoal + by (metis (no_types, lifting) add_new_coeff_l r_into_rtranclp + rtranclp_trans union_mset_add_mset_left union_mset_add_mset_right) + done + +lemma add_poly_p_empty_r: + \add_poly_p\<^sup>*\<^sup>* (p, q, r) (p, {#}, q + r)\ + apply (induction q arbitrary: r) + subgoal by auto + subgoal + by (metis (no_types, lifting) add_new_coeff_r r_into_rtranclp + rtranclp_trans union_mset_add_mset_left union_mset_add_mset_right) + done + +lemma add_poly_p_sym: + \add_poly_p (p, q, r) (p', q', r') \ add_poly_p (q, p, r) (q', p', r')\ + apply (rule iffI) + subgoal + by (cases rule: add_poly_p.cases, assumption) + (auto intro: add_poly_p.intros) + subgoal + by (cases rule: add_poly_p.cases, assumption) + (auto intro: add_poly_p.intros) + done + +lemma wf_if_measure_in_wf: + \wf R \ (\a b. (a, b) \ S \ (\ a, \ b)\R) \ wf S\ + by (metis in_inv_image wfE_min wfI_min wf_inv_image) + +lemma lexn_n: + \n > 0 \ (x # xs, y # ys) \ lexn r n \ + (length xs = n-1 \ length ys = n-1) \ ((x, y) \ r \ (x = y \ (xs, ys) \ lexn r (n - 1)))\ + apply (cases n) + apply simp + by (auto simp: map_prod_def image_iff lex_prod_def) + +lemma wf_add_poly_p: + \wf {(x, y). add_poly_p y x}\ + by (rule wf_if_measure_in_wf[where R = \lexn less_than 3\ and + \ = \\(a,b,c). [size a , size b, size c]\]) + (auto simp: add_poly_p.simps wf_lexn + simp: lexn_n simp del: lexn.simps(2)) + +lemma mult_poly_by_monom_simps[simp]: + \mult_poly_by_monom t {#} = {#}\ + \mult_poly_by_monom t (ps + qs) = mult_poly_by_monom t ps + mult_poly_by_monom t qs\ + \mult_poly_by_monom a (add_mset p ps) = add_mset (fst a + fst p, snd a * snd p) (mult_poly_by_monom a ps)\ +proof - + interpret comp_fun_commute \(\xs. add_mset (xs + t))\ for t + by standard auto + show + \mult_poly_by_monom t (ps + qs) = mult_poly_by_monom t ps + mult_poly_by_monom t qs\ for t + by (induction ps) + (auto simp: mult_poly_by_monom_def) + show + \mult_poly_by_monom a (add_mset p ps) = add_mset (fst a + fst p, snd a * snd p) (mult_poly_by_monom a ps)\ + \mult_poly_by_monom t {#} = {#}\for t + by (auto simp: mult_poly_by_monom_def) +qed + +inductive mult_poly_p :: \mset_polynomial \ mset_polynomial \ mset_polynomial \ mset_polynomial \ mset_polynomial \ bool\ + for q :: mset_polynomial where +mult_step: + \mult_poly_p q (add_mset (xs, n) p, r) (p, (\(ys, m). (remdups_mset (xs + ys), n * m)) `# q + r)\ + + +lemmas mult_poly_p_induct = mult_poly_p.induct[split_format(complete)] + +subsection \Normalisation\ + +inductive normalize_poly_p :: \mset_polynomial \ mset_polynomial \ bool\where +rem_0_coeff[simp, intro]: + \normalize_poly_p p q \ normalize_poly_p (add_mset (xs, 0) p) q\ | +merge_dup_coeff[simp, intro]: + \normalize_poly_p p q \ normalize_poly_p (add_mset (xs, m) (add_mset (xs, n) p)) (add_mset (xs, m + n) q)\ | +same[simp, intro]: + \normalize_poly_p p p\ | +keep_coeff[simp, intro]: + \normalize_poly_p p q \ normalize_poly_p (add_mset x p) (add_mset x q)\ + + +subsection \Correctness\ +text \ + This locales maps string polynomials to real polynomials. +\ +locale poly_embed = + fixes \ :: \string \ nat\ + assumes \_inj: \inj \\ +begin + +definition poly_of_vars :: "term_poly \ ('a :: {comm_semiring_1}) mpoly" where + \poly_of_vars xs = fold_mset (\a b. Var (\ a) * b) (1 :: 'a mpoly) xs\ + +lemma poly_of_vars_simps[simp]: + shows + \poly_of_vars (add_mset x xs) = Var (\ x) * (poly_of_vars xs :: ('a :: {comm_semiring_1}) mpoly)\ (is ?A) and + \poly_of_vars (xs + ys) = poly_of_vars xs * (poly_of_vars ys :: ('a :: {comm_semiring_1}) mpoly)\ (is ?B) +proof - + interpret comp_fun_commute \(\a b. (b :: 'a :: {comm_semiring_1} mpoly) * Var (\ a))\ + by standard + (auto simp: algebra_simps ac_simps + Var_def times_monomial_monomial intro!: ext) + + show ?A + by (auto simp: poly_of_vars_def comp_fun_commute_axioms fold_mset_fusion + ac_simps) + show ?B + apply (auto simp: poly_of_vars_def ac_simps) + by (simp add: local.comp_fun_commute_axioms local.fold_mset_fusion + semiring_normalization_rules(18)) +qed + + +definition mononom_of_vars where + \mononom_of_vars \ (\(xs, n). (+) (Const n * poly_of_vars xs))\ + +interpretation comp_fun_commute \mononom_of_vars\ + by standard + (auto simp: algebra_simps ac_simps mononom_of_vars_def + Var_def times_monomial_monomial intro!: ext) + +lemma [simp]: + \poly_of_vars {#} = 1\ + by (auto simp: poly_of_vars_def) + +lemma mononom_of_vars_add[simp]: + \NO_MATCH 0 b \ mononom_of_vars xs b = Const (snd xs) * poly_of_vars (fst xs) + b\ + by (cases xs) + (auto simp: ac_simps mononom_of_vars_def) + +definition polynomial_of_mset :: \mset_polynomial \ _\ where + \polynomial_of_mset p = sum_mset (mononom_of_vars `# p) 0\ + +lemma polynomial_of_mset_append[simp]: + \polynomial_of_mset (xs + ys) = polynomial_of_mset xs + polynomial_of_mset ys\ + by (auto simp: ac_simps Const_def polynomial_of_mset_def) + +lemma polynomial_of_mset_Cons[simp]: + \polynomial_of_mset (add_mset x ys) = Const (snd x) * poly_of_vars (fst x) + polynomial_of_mset ys\ + by (cases x) + (auto simp: ac_simps polynomial_of_mset_def mononom_of_vars_def) + +lemma polynomial_of_mset_empty[simp]: + \polynomial_of_mset {#} = 0\ + by (auto simp: polynomial_of_mset_def) + +lemma polynomial_of_mset_mult_poly_by_monom[simp]: + \polynomial_of_mset (mult_poly_by_monom x ys) = + (Const (snd x) * poly_of_vars (fst x) * polynomial_of_mset ys)\ + by (induction ys) + (auto simp: Const_mult algebra_simps) + +lemma polynomial_of_mset_mult_poly_raw[simp]: + \polynomial_of_mset (mult_poly_raw xs ys) = polynomial_of_mset xs * polynomial_of_mset ys\ + unfolding mult_poly_raw_def + by (induction xs arbitrary: ys) + (auto simp: Const_mult algebra_simps) + +lemma polynomial_of_mset_uminus: + \polynomial_of_mset {#case x of (a, b) \ (a, - b). x \# za#} = + - polynomial_of_mset za\ + by (induction za) + auto + + +lemma X2_X_polynomial_bool_mult_in: + \Var (x1) * (Var (x1) * p) - Var (x1) * p \ More_Modules.ideal polynomial_bool\ + using ideal_mult_right_in[OF X2_X_in_pac_ideal[of x1 \{}\, unfolded pac_ideal_def], of p] + by (auto simp: right_diff_distrib ac_simps power2_eq_square) + + +lemma polynomial_of_list_remove_powers_polynomial_bool: + \(polynomial_of_mset xs) - polynomial_of_mset (remove_powers xs) \ ideal polynomial_bool\ +proof (induction xs) + case empty + then show \?case\ by (auto simp: remove_powers_def ideal.span_zero) +next + case (add x xs) + have H1: \x1 \# x2 \ + Var (\ x1) * poly_of_vars x2 - p \ More_Modules.ideal polynomial_bool \ + poly_of_vars x2 - p \ More_Modules.ideal polynomial_bool + \ for x1 x2 p + apply (subst (2) ideal.span_add_eq[symmetric, + of \Var (\ x1) * poly_of_vars x2 - poly_of_vars x2\]) + apply (drule multi_member_split) + apply (auto simp: X2_X_polynomial_bool_mult_in) + done + + have diff: \poly_of_vars (x) - poly_of_vars (remdups_mset (x)) \ ideal polynomial_bool\ for x + by (induction x) + (auto simp: remove_powers_def ideal.span_zero H1 + simp flip: right_diff_distrib intro!: ideal.span_scale) + have [simp]: \polynomial_of_mset xs - + polynomial_of_mset (apfst remdups_mset `# xs) + \ More_Modules.ideal polynomial_bool \ + poly_of_vars ys * poly_of_vars ys - + poly_of_vars ys * poly_of_vars (remdups_mset ys) + \ More_Modules.ideal polynomial_bool \ + polynomial_of_mset xs + Const y * poly_of_vars ys - + (polynomial_of_mset (apfst remdups_mset `# xs) + + Const y * poly_of_vars (remdups_mset ys)) + \ More_Modules.ideal polynomial_bool\ for y ys + by (metis add_diff_add diff ideal.scale_right_diff_distrib ideal.span_add ideal.span_scale) + show ?case + using add + apply (cases x) + subgoal for ys y + using ideal_mult_right_in2[OF diff, of \poly_of_vars ys\ ys] + by (auto simp: remove_powers_def right_diff_distrib + ideal.span_diff ideal.span_add field_simps) + done +qed + +lemma add_poly_p_polynomial_of_mset: + \add_poly_p (p, q, r) (p', q', r') \ + polynomial_of_mset r + (polynomial_of_mset p + polynomial_of_mset q) = + polynomial_of_mset r' + (polynomial_of_mset p' + polynomial_of_mset q')\ + apply (induction rule: add_poly_p_induct) + subgoal + by auto + subgoal + by auto + subgoal + by (auto simp: algebra_simps Const_add) + subgoal + by (auto simp: algebra_simps Const_add) + subgoal + by (auto simp: algebra_simps Const_add) + done + +lemma rtranclp_add_poly_p_polynomial_of_mset: + \add_poly_p\<^sup>*\<^sup>* (p, q, r) (p', q', r') \ + polynomial_of_mset r + (polynomial_of_mset p + polynomial_of_mset q) = + polynomial_of_mset r' + (polynomial_of_mset p' + polynomial_of_mset q')\ + by (induction rule: rtranclp_induct[of add_poly_p \(_, _, _)\ \(_, _, _)\, split_format(complete), of for r]) + (auto dest: add_poly_p_polynomial_of_mset) + + +lemma rtranclp_add_poly_p_polynomial_of_mset_full: + \add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r') \ + polynomial_of_mset r' = (polynomial_of_mset p + polynomial_of_mset q)\ + by (drule rtranclp_add_poly_p_polynomial_of_mset) + (auto simp: ac_simps add_eq_0_iff) + +lemma poly_of_vars_remdups_mset: + \poly_of_vars (remdups_mset (xs)) - (poly_of_vars xs) + \ More_Modules.ideal polynomial_bool\ + apply (induction xs) + subgoal by (auto simp: ideal.span_zero) + subgoal for x xs + apply (cases \x \# xs\) + apply (metis (no_types, lifting) X2_X_polynomial_bool_mult_in diff_add_cancel diff_diff_eq2 + ideal.span_diff insert_DiffM poly_of_vars_simps(1) remdups_mset_singleton_sum) + by (metis (no_types, lifting) ideal.span_scale poly_of_vars_simps(1) remdups_mset_singleton_sum + right_diff_distrib) + done + +lemma polynomial_of_mset_mult_map: + \polynomial_of_mset + {#case x of (ys, n) \ (remdups_mset (ys + xs), n * m). x \# q#} - + Const m * (poly_of_vars xs * polynomial_of_mset q) + \ More_Modules.ideal polynomial_bool\ + (is \?P q \ _\) +proof (induction q) + case empty + then show ?case by (auto simp: algebra_simps ideal.span_zero) +next + case (add x q) + then have uP: \-?P q \ More_Modules.ideal polynomial_bool\ + using ideal.span_neg by blast + have \ Const b * (Const m * poly_of_vars (remdups_mset (a + xs))) - + Const b * (Const m * (poly_of_vars a * poly_of_vars xs)) + \ More_Modules.ideal polynomial_bool\ for a b + by (auto simp: Const_mult simp flip: right_diff_distrib' poly_of_vars_simps + intro!: ideal.span_scale poly_of_vars_remdups_mset) + then show ?case + apply (subst ideal.span_add_eq2[symmetric, OF uP]) + apply (cases x) + apply (auto simp: field_simps Const_mult simp flip: + intro!: ideal.span_scale poly_of_vars_remdups_mset) + done +qed + +lemma mult_poly_p_mult_ideal: + \mult_poly_p q (p, r) (p', r') \ + (polynomial_of_mset p' * polynomial_of_mset q + polynomial_of_mset r') - (polynomial_of_mset p * polynomial_of_mset q + polynomial_of_mset r) + \ ideal polynomial_bool\ +proof (induction rule: mult_poly_p_induct) + case (mult_step xs n p r) + show ?case + by (auto simp: algebra_simps polynomial_of_mset_mult_map) +qed + +lemma rtranclp_mult_poly_p_mult_ideal: + \(mult_poly_p q)\<^sup>*\<^sup>* (p, r) (p', r') \ + (polynomial_of_mset p' * polynomial_of_mset q + polynomial_of_mset r') - (polynomial_of_mset p * polynomial_of_mset q + polynomial_of_mset r) + \ ideal polynomial_bool\ + apply (induction p' r' rule: rtranclp_induct[of \mult_poly_p q\ \(p, r)\ \(p', q')\ for p' q', split_format(complete)]) + subgoal + by (auto simp: ideal.span_zero) + subgoal for a b aa ba + apply (drule mult_poly_p_mult_ideal) + apply (drule ideal.span_add) + apply assumption + by (auto simp: group_add_class.diff_add_eq_diff_diff_swap + add.inverse_distrib_swap ac_simps add_diff_eq + simp flip: diff_add_eq_diff_diff_swap) + done + +lemma rtranclp_mult_poly_p_mult_ideal_final: + \(mult_poly_p q)\<^sup>*\<^sup>* (p, {#}) ({#}, r) \ + (polynomial_of_mset r) - (polynomial_of_mset p * polynomial_of_mset q) + \ ideal polynomial_bool\ + by (drule rtranclp_mult_poly_p_mult_ideal) auto + +lemma normalize_poly_p_poly_of_mset: + \normalize_poly_p p q \ polynomial_of_mset p = polynomial_of_mset q\ + apply (induction rule: normalize_poly_p.induct) + apply (auto simp: Const_add algebra_simps) + done + + +lemma rtranclp_normalize_poly_p_poly_of_mset: + \normalize_poly_p\<^sup>*\<^sup>* p q \ polynomial_of_mset p = polynomial_of_mset q\ + by (induction rule: rtranclp_induct) + (auto simp: normalize_poly_p_poly_of_mset) + +end + + +text \It would be nice to have the property in the other direction too, but this requires a deep +dive into the definitions of polynomials.\ +locale poly_embed_bij = poly_embed + + fixes V N + assumes \_bij: \bij_betw \ V N\ +begin + +definition \' :: \nat \ string\ where + \\' = the_inv_into V \\ + +lemma \'_\[simp]: + \x \ V \ \' (\ x) = x\ + using \_bij unfolding \'_def + by (meson bij_betw_imp_inj_on the_inv_into_f_f) + +lemma \_\'[simp]: + \x \ N \ \ (\' x) = x\ + using \_bij unfolding \'_def + by (meson f_the_inv_into_f_bij_betw) + +end + +end + diff --git a/thys/PAC_Checker/PAC_Polynomials_Operations.thy b/thys/PAC_Checker/PAC_Polynomials_Operations.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Polynomials_Operations.thy @@ -0,0 +1,1261 @@ +theory PAC_Polynomials_Operations + imports PAC_Polynomials_Term PAC_Checker_Specification +begin + +subsection \Addition\ + +text \In this section, we refine the polynomials to list. These lists will be used in our checker +to represent the polynomials and execute operations. + +There is one \<^emph>\key\ difference between the list representation and the usual representation: in the +former, coefficients can be zero and monomials can appear several times. This makes it easier to +reason on intermediate representation where this has not yet been sanitized. +\ + +fun add_poly_l' :: \llist_polynomial \ llist_polynomial \ llist_polynomial\ where + \add_poly_l' (p, []) = p\ | + \add_poly_l' ([], q) = q\ | + \add_poly_l' ((xs, n) # p, (ys, m) # q) = + (if xs = ys then if n + m = 0 then add_poly_l' (p, q) else + let pq = add_poly_l' (p, q) in + ((xs, n + m) # pq) + else if (xs, ys) \ term_order_rel + then + let pq = add_poly_l' (p, (ys, m) # q) in + ((xs, n) # pq) + else + let pq = add_poly_l' ((xs, n) # p, q) in + ((ys, m) # pq) + )\ + +definition add_poly_l :: \llist_polynomial \ llist_polynomial \ llist_polynomial nres\ where + \add_poly_l = REC\<^sub>T + (\add_poly_l (p, q). + case (p,q) of + (p, []) \ RETURN p + | ([], q) \ RETURN q + | ((xs, n) # p, (ys, m) # q) \ + (if xs = ys then if n + m = 0 then add_poly_l (p, q) else + do { + pq \ add_poly_l (p, q); + RETURN ((xs, n + m) # pq) + } + else if (xs, ys) \ term_order_rel + then do { + pq \ add_poly_l (p, (ys, m) # q); + RETURN ((xs, n) # pq) + } + else do { + pq \ add_poly_l ((xs, n) # p, q); + RETURN ((ys, m) # pq) + }))\ + +definition nonzero_coeffs where + \nonzero_coeffs a \ 0 \# snd `# a\ + +lemma nonzero_coeffs_simps[simp]: + \nonzero_coeffs {#}\ + \nonzero_coeffs (add_mset (xs, n) a) \ nonzero_coeffs a \ n \ 0\ + by (auto simp: nonzero_coeffs_def) + +lemma nonzero_coeffsD: + \nonzero_coeffs a \ (x, n) \# a \ n \ 0\ + by (auto simp: nonzero_coeffs_def) + +lemma sorted_poly_list_rel_ConsD: + \((ys, n) # p, a) \ sorted_poly_list_rel S \ (p, remove1_mset (mset ys, n) a) \ sorted_poly_list_rel S \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys \ ys \ set (map fst p) \ n \ 0 \ nonzero_coeffs a\ + unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq + list_rel_def + apply (clarsimp) + apply (subst (asm) list.rel_sel) + apply (intro conjI) + apply (rename_tac y, rule_tac b = \tl y\ in relcompI) + apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + list.tl_def term_poly_list_rel_def nonzero_coeffs_def split: list.splits) + done + +lemma sorted_poly_list_rel_Cons_iff: + \((ys, n) # p, a) \ sorted_poly_list_rel S \ (p, remove1_mset (mset ys, n) a) \ sorted_poly_list_rel S \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys \ ys \ set (map fst p) \ n \ 0 \ nonzero_coeffs a\ + apply (rule iffI) + subgoal + by (auto dest!: sorted_poly_list_rel_ConsD) + subgoal + unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq + list_rel_def + apply (clarsimp) + apply (intro conjI) + apply (rename_tac y; rule_tac b = \(mset ys, n) # y\ in relcompI) + by (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \mset _\] + nonzero_coeffs_def + dest!: multi_member_split) + done + + + +lemma sorted_repeat_poly_list_rel_ConsD: + \((ys, n) # p, a) \ sorted_repeat_poly_list_rel S \ (p, remove1_mset (mset ys, n) a) \ sorted_repeat_poly_list_rel S \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys \ n \ 0 \ nonzero_coeffs a\ + unfolding sorted_repeat_poly_list_rel_wrt_def prod.case mem_Collect_eq + list_rel_def + apply (clarsimp) + apply (subst (asm) list.rel_sel) + apply (intro conjI) + apply (rename_tac y, rule_tac b = \tl y\ in relcompI) + apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + list.tl_def term_poly_list_rel_def nonzero_coeffs_def split: list.splits) + done + +lemma sorted_repeat_poly_list_rel_Cons_iff: + \((ys, n) # p, a) \ sorted_repeat_poly_list_rel S \ (p, remove1_mset (mset ys, n) a) \ sorted_repeat_poly_list_rel S \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys \ n \ 0 \ nonzero_coeffs a\ + apply (rule iffI) + subgoal + by (auto dest!: sorted_repeat_poly_list_rel_ConsD) + subgoal + unfolding sorted_repeat_poly_list_rel_wrt_def prod.case mem_Collect_eq + list_rel_def + apply (clarsimp) + apply (intro conjI) + apply (rename_tac y, rule_tac b = \(mset ys, n) # y\ in relcompI) + by (auto simp: sorted_repeat_poly_list_rel_wrt_def list_mset_rel_def br_def + term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \mset _\] + nonzero_coeffs_def + dest!: multi_member_split) + done + + +lemma add_poly_p_add_mset_sum_0: + \n + m = 0 \add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \ + add_poly_p\<^sup>*\<^sup>* + (add_mset (mset ys, n) A, add_mset (mset ys, m) Aa, {#}) + ({#}, {#}, r)\ + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_new_coeff_r) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_same_coeff_l) + apply (rule converse_rtranclp_into_rtranclp) + apply (auto intro: add_poly_p.rem_0_coeff) + done + +lemma monoms_add_poly_l'D: + \(aa, ba) \ set (add_poly_l' x) \ aa \ fst ` set (fst x) \ aa \ fst ` set (snd x)\ + by (induction x rule: add_poly_l'.induct) + (auto split: if_splits) + +lemma add_poly_p_add_to_result: + \add_poly_p\<^sup>*\<^sup>* (A, B, r) (A', B', r') \ + add_poly_p\<^sup>*\<^sup>* + (A, B, p + r) (A', B', p + r')\ + apply (induction rule: rtranclp_induct[of add_poly_p \(_, _, _)\ \(_, _, _)\, split_format(complete), of for r]) + subgoal by auto + by (elim add_poly_pE) + (metis (no_types, lifting) Pair_inject add_poly_p.intros rtranclp.simps union_mset_add_mset_right)+ + +lemma add_poly_p_add_mset_comb: + \add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \ + add_poly_p\<^sup>*\<^sup>* + (add_mset (xs, n) A, Aa, {#}) + ({#}, {#}, add_mset (xs, n) r)\ + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_new_coeff_l) + using add_poly_p_add_to_result[of A Aa \{#}\ \{#}\ \{#}\ r \{#(xs, n)#}\] + by auto + +lemma add_poly_p_add_mset_comb2: + \add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \ + add_poly_p\<^sup>*\<^sup>* + (add_mset (ys, n) A, add_mset (ys, m) Aa, {#}) + ({#}, {#}, add_mset (ys, n + m) r)\ + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_new_coeff_r) + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_same_coeff_l) + using add_poly_p_add_to_result[of A Aa \{#}\ \{#}\ \{#}\ r \{#(ys, n+m)#}\] + by auto + + +lemma add_poly_p_add_mset_comb3: + \add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \ + add_poly_p\<^sup>*\<^sup>* + (A, add_mset (ys, m) Aa, {#}) + ({#}, {#}, add_mset (ys, m) r)\ + apply (rule converse_rtranclp_into_rtranclp) + apply (rule add_poly_p.add_new_coeff_r) + using add_poly_p_add_to_result[of A Aa \{#}\ \{#}\ \{#}\ r \{#(ys, m)#}\] + by auto + +lemma total_on_lexord: + \Relation.total_on UNIV R \ Relation.total_on UNIV (lexord R)\ + apply (auto simp: Relation.total_on_def) + by (meson lexord_linear) + +lemma antisym_lexord: + \antisym R \ irrefl R \ antisym (lexord R)\ + by (auto simp: antisym_def lexord_def irrefl_def + elim!: list_match_lel_lel) + +lemma less_than_char_linear: + \(a, b) \ less_than_char \ + a = b \ (b, a) \ less_than_char\ + by (auto simp: less_than_char_def) + +lemma total_on_lexord_less_than_char_linear: + \xs \ ys \ (xs, ys) \ lexord (lexord less_than_char) \ + (ys, xs) \ lexord (lexord less_than_char)\ + using lexord_linear[of \lexord less_than_char\ xs ys] + using lexord_linear[of \less_than_char\] less_than_char_linear + using lexord_irrefl[OF irrefl_less_than_char] + antisym_lexord[OF antisym_lexord[OF antisym_less_than_char irrefl_less_than_char]] + apply (auto simp: antisym_def Relation.total_on_def) + done + +lemma sorted_poly_list_rel_nonzeroD: + \(p, r) \ sorted_poly_list_rel term_order \ + nonzero_coeffs (r)\ + \(p, r) \ sorted_poly_list_rel (rel2p (lexord (lexord less_than_char))) \ + nonzero_coeffs (r)\ + by (auto simp: sorted_poly_list_rel_wrt_def nonzero_coeffs_def) + + +lemma add_poly_l'_add_poly_p: + assumes \(pq, pq') \ sorted_poly_rel \\<^sub>r sorted_poly_rel\ + shows \\r. (add_poly_l' pq, r) \ sorted_poly_rel \ + add_poly_p\<^sup>*\<^sup>* (fst pq', snd pq', {#}) ({#}, {#}, r)\ + supply [[goals_limit=1]] + using assms + apply (induction \pq\ arbitrary: pq' rule: add_poly_l'.induct) + subgoal for p pq' + using add_poly_p_empty_l[of \fst pq'\ \{#}\ \{#}\] + by (cases pq') (auto intro!: exI[of _ \fst pq'\]) + subgoal for x p pq' + using add_poly_p_empty_r[of \{#}\ \snd pq'\ \{#}\] + by (cases pq') (auto intro!: exI[of _ \snd pq'\]) + subgoal premises p for xs n p ys m q pq' + apply (cases pq') \ \Isabelle does a completely stupid case distinction here\ + apply (cases \xs = ys\) + subgoal + apply (cases \n + m = 0\) + subgoal + using p(1)[of \(remove1_mset (mset xs, n) (fst pq'), remove1_mset (mset ys, m) (snd pq'))\] p(5-) + apply (auto dest!: sorted_poly_list_rel_ConsD multi_member_split + ) + using add_poly_p_add_mset_sum_0 by blast + subgoal + using p(2)[of \(remove1_mset (mset xs, n) (fst pq'), remove1_mset (mset ys, m) (snd pq'))\] p(5-) + apply (auto dest!: sorted_poly_list_rel_ConsD multi_member_split) + apply (rule_tac x = \add_mset (mset ys, n + m) r\ in exI) + apply (fastforce dest!: monoms_add_poly_l'D simp: sorted_poly_list_rel_Cons_iff rel2p_def + sorted_poly_list_rel_nonzeroD var_order_rel_def + intro: add_poly_p_add_mset_comb2) + done + done + subgoal + apply (cases \(xs, ys) \ term_order_rel\) + subgoal + using p(3)[of \(remove1_mset (mset xs, n) (fst pq'), (snd pq'))\] p(5-) + apply (auto dest!: multi_member_split simp: sorted_poly_list_rel_Cons_iff rel2p_def) + apply (rule_tac x = \add_mset (mset xs, n) r\ in exI) + apply (auto dest!: monoms_add_poly_l'D) + apply (auto intro: lexord_trans add_poly_p_add_mset_comb simp: lexord_transI var_order_rel_def) + apply (rule lexord_trans) + apply assumption + apply (auto intro: lexord_trans add_poly_p_add_mset_comb simp: lexord_transI + sorted_poly_list_rel_nonzeroD var_order_rel_def) + using total_on_lexord_less_than_char_linear by fastforce + + subgoal + using p(4)[of \(fst pq', remove1_mset (mset ys, m) (snd pq'))\] p(5-) + apply (auto dest!: multi_member_split simp: sorted_poly_list_rel_Cons_iff rel2p_def + var_order_rel_def) + apply (rule_tac x = \add_mset (mset ys, m) r\ in exI) + apply (auto dest!: monoms_add_poly_l'D + simp: total_on_lexord_less_than_char_linear) + apply (auto intro: lexord_trans add_poly_p_add_mset_comb simp: lexord_transI + total_on_lexord_less_than_char_linear var_order_rel_def) + apply (rule lexord_trans) + apply assumption + apply (auto intro: lexord_trans add_poly_p_add_mset_comb3 simp: lexord_transI + sorted_poly_list_rel_nonzeroD var_order_rel_def) + using total_on_lexord_less_than_char_linear by fastforce + done + done + done + + +lemma add_poly_l_add_poly: + \add_poly_l x = RETURN (add_poly_l' x)\ + unfolding add_poly_l_def + by (induction x rule: add_poly_l'.induct) + (solves \subst RECT_unfold, refine_mono, simp split: list.split\)+ + +lemma add_poly_l_spec: + \(add_poly_l, uncurry (\p q. SPEC(\r. add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r)))) \ + sorted_poly_rel \\<^sub>r sorted_poly_rel \\<^sub>f \sorted_poly_rel\nres_rel\ + unfolding add_poly_l_add_poly + apply (intro nres_relI frefI) + apply (drule add_poly_l'_add_poly_p) + apply (auto simp: conc_fun_RES) + done + +definition sort_poly_spec :: \llist_polynomial \ llist_polynomial nres\ where +\sort_poly_spec p = + SPEC(\p'. mset p = mset p' \ sorted_wrt (rel2p (Id \ term_order_rel)) (map fst p'))\ + +lemma sort_poly_spec_id: + assumes \(p, p') \ unsorted_poly_rel\ + shows \sort_poly_spec p \ \ (sorted_repeat_poly_rel) (RETURN p')\ +proof - + obtain y where + py: \(p, y) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ and + p'_y: \p' = mset y\ and + zero: \0 \# snd `# p'\ + using assms + unfolding sort_poly_spec_def poly_list_rel_def sorted_poly_list_rel_wrt_def + by (auto simp: list_mset_rel_def br_def) + then have [simp]: \length y = length p\ + by (auto simp: list_rel_def list_all2_conv_all_nth) + have H: \(x, p') + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel O list_mset_rel\ + if px: \mset p = mset x\ and \sorted_wrt (rel2p (Id \ lexord var_order_rel)) (map fst x)\ + for x :: \llist_polynomial\ + proof - + obtain f where + f: \bij_betw f {.. and + [simp]: \\i. i x ! i = p ! (f i)\ + using px apply - apply (subst (asm)(2) eq_commute) unfolding mset_eq_perm + by (auto dest!: permutation_Ex_bij) + let ?y = \map (\i. y ! f i) [0 ..< length x]\ + have \i < length y \ (p ! f i, y ! f i) \ term_poly_list_rel \\<^sub>r int_rel\ for i + using list_all2_nthD[of _ p y + \f i\, OF py[unfolded list_rel_def mem_Collect_eq prod.case]] + mset_eq_length[OF px] f + by (auto simp: list_rel_def list_all2_conv_all_nth bij_betw_def) + then have \(x, ?y) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ and + xy: \length x = length y\ + using py list_all2_nthD[of \rel2p (term_poly_list_rel \\<^sub>r int_rel)\ p y + \f i\ for i, simplified] mset_eq_length[OF px] + by (auto simp: list_rel_def list_all2_conv_all_nth) + moreover { + have f: \mset_set {0.. + using f mset_eq_length[OF px] + by (auto simp: bij_betw_def lessThan_atLeast0 image_mset_mset_set) + have \mset y = {#y ! f x. x \# mset_set {0.. + by (subst drop_0[symmetric], subst mset_drop_upto, subst xy[symmetric], subst f) + auto + then have \(?y, p') \ list_mset_rel\ + by (auto simp: list_mset_rel_def br_def p'_y) + } + ultimately show ?thesis + by (auto intro!: relcompI[of _ ?y]) + qed + show ?thesis + using zero + unfolding sort_poly_spec_def poly_list_rel_def sorted_repeat_poly_list_rel_wrt_def + by refine_rcg (auto intro: H) +qed + + +subsection \Multiplication\ + +fun mult_monoms :: \term_poly_list \ term_poly_list \ term_poly_list\ where + \mult_monoms p [] = p\ | + \mult_monoms [] p = p\ | + \mult_monoms (x # p) (y # q) = + (if x = y then x # mult_monoms p q + else if (x, y) \ var_order_rel then x # mult_monoms p (y # q) + else y # mult_monoms (x # p) q)\ + +lemma term_poly_list_rel_empty_iff[simp]: + \([], q') \ term_poly_list_rel \ q' = {#}\ + by (auto simp: term_poly_list_rel_def) + +lemma mset_eqD_set_mset: \mset xs = A \ set xs = set_mset A\ + by auto + +lemma term_poly_list_rel_Cons_iff: + \(y # p, p') \ term_poly_list_rel \ + (p, remove1_mset y p') \ term_poly_list_rel \ + y \# p' \ y \ set p \ y \# remove1_mset y p' \ + (\x\#mset p. (y, x) \ var_order_rel)\ + by (auto simp: term_poly_list_rel_def rel2p_def dest!: multi_member_split mset_eqD_set_mset) + +lemma var_order_rel_antisym[simp]: + \(y, y) \ var_order_rel\ + by (simp add: less_than_char_def lexord_irreflexive var_order_rel_def) + +lemma term_poly_list_rel_remdups_mset: + \(p, p') \ term_poly_list_rel \ + (p, remdups_mset p') \ term_poly_list_rel\ + by (auto simp: term_poly_list_rel_def distinct_mset_remdups_mset_id simp flip: distinct_mset_mset_distinct) + +lemma var_notin_notin_mult_monomsD: + \y \ set (mult_monoms p q) \ y \ set p \ y \ set q\ + by (induction p q arbitrary: p' q' rule: mult_monoms.induct) (auto split: if_splits) + +lemma term_poly_list_rel_set_mset: + \(p, q) \ term_poly_list_rel \ set p = set_mset q\ + by (auto simp: term_poly_list_rel_def) + + +lemma mult_monoms_spec: + \(mult_monoms, (\a b. remdups_mset (a + b))) \ term_poly_list_rel \ term_poly_list_rel \ term_poly_list_rel\ +proof - + have [dest]: \remdups_mset (A + Aa) = add_mset y Ab \ y \# A \ + y \# Aa \ + False\ for Aa Ab y A + by (metis set_mset_remdups_mset union_iff union_single_eq_member) + show ?thesis + apply (intro fun_relI) + apply (rename_tac p p' q q') + subgoal for p p' q q' + apply (induction p q arbitrary: p' q' rule: mult_monoms.induct) + subgoal by (auto simp: term_poly_list_rel_Cons_iff rel2p_def term_poly_list_rel_remdups_mset) + subgoal for x p p' q' + by (auto simp: term_poly_list_rel_Cons_iff rel2p_def term_poly_list_rel_remdups_mset + dest!: multi_member_split[of _ q']) + subgoal premises p for x p y q p' q' + apply (cases \x = y\) + subgoal + using p(1)[of \remove1_mset y p'\ \remove1_mset y q'\] p(4-) + by (auto simp: term_poly_list_rel_Cons_iff rel2p_def + dest!: var_notin_notin_mult_monomsD + dest!: multi_member_split) + apply (cases \(x, y) \ var_order_rel\) + subgoal + using p(2)[of \remove1_mset x p'\ \q'\] p(4-) + apply (auto simp: term_poly_list_rel_Cons_iff + term_poly_list_rel_set_mset rel2p_def var_order_rel_def + dest!: multi_member_split[of _ p'] multi_member_split[of _ q'] + var_notin_notin_mult_monomsD + split: if_splits) + apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear) + apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear) + apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear) + using lexord_trans trans_less_than_char var_order_rel_antisym + unfolding var_order_rel_def apply blast+ + done + subgoal + using p(3)[of \p'\ \remove1_mset y q'\] p(4-) + apply (auto simp: term_poly_list_rel_Cons_iff rel2p_def + term_poly_list_rel_set_mset rel2p_def var_order_rel_antisym + dest!: multi_member_split[of _ p'] multi_member_split[of _ q'] + var_notin_notin_mult_monomsD + split: if_splits) + using lexord_trans trans_less_than_char var_order_rel_antisym + unfolding var_order_rel_def apply blast + apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear) + by (meson less_than_char_linear lexord_linear lexord_trans trans_less_than_char) + done + done + done +qed + +definition mult_monomials :: \term_poly_list \ int \ term_poly_list \ int \ term_poly_list \ int\ where + \mult_monomials = (\(x, a) (y, b). (mult_monoms x y, a * b))\ + +definition mult_poly_raw :: \llist_polynomial \ llist_polynomial \ llist_polynomial\ where + \mult_poly_raw p q = foldl (\b x. map (mult_monomials x) q @ b) [] p\ + + +fun map_append where + \map_append f b [] = b\ | + \map_append f b (x # xs) = f x # map_append f b xs\ + +lemma map_append_alt_def: + \map_append f b xs = map f xs @ b\ + by (induction f b xs rule: map_append.induct) + auto + +lemma foldl_append_empty: + \NO_MATCH [] xs \ foldl (\b x. f x @ b) xs p = foldl (\b x. f x @ b) [] p @ xs\ + apply (induction p arbitrary: xs) + apply simp + by (metis (mono_tags, lifting) NO_MATCH_def append.assoc append_self_conv foldl_Cons) + + +lemma poly_list_rel_empty_iff[simp]: + \([], r) \ poly_list_rel R \ r = {#}\ + by (auto simp: poly_list_rel_def list_mset_rel_def br_def) + +lemma mult_poly_raw_simp[simp]: + \mult_poly_raw [] q = []\ + \mult_poly_raw (x # p) q = mult_poly_raw p q @ map (mult_monomials x) q\ + subgoal by (auto simp: mult_poly_raw_def) + subgoal by (induction p) (auto simp: mult_poly_raw_def foldl_append_empty) + done + +lemma sorted_poly_list_relD: + \(q, q') \ sorted_poly_list_rel R \ q' = (\(a, b). (mset a, b)) `# mset q\ + apply (induction q arbitrary: q') + apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + list_rel_split_right_iff) + apply (subst (asm)(2) term_poly_list_rel_def) + apply (simp add: relcomp.relcompI) + done + +lemma list_all2_in_set_ExD: + \list_all2 R p q \ x \ set p \ \y \ set q. R x y\ + by (induction p q rule: list_all2_induct) + auto + +inductive_cases mult_poly_p_elim: \mult_poly_p q (A, r) (B, r')\ + +lemma mult_poly_p_add_mset_same: + \(mult_poly_p q')\<^sup>*\<^sup>* (A, r) (B, r') \ (mult_poly_p q')\<^sup>*\<^sup>* (add_mset x A, r) (add_mset x B, r')\ + apply (induction rule: rtranclp_induct[of \mult_poly_p q'\ \(_, r)\ \(p', q'')\ for p' q'', split_format(complete)]) + subgoal by simp + apply (rule rtranclp.rtrancl_into_rtrancl) + apply assumption + by (auto elim!: mult_poly_p_elim intro: mult_poly_p.intros + intro: rtranclp.rtrancl_into_rtrancl simp: add_mset_commute[of x]) + +lemma mult_poly_raw_mult_poly_p: + assumes \(p, p') \ sorted_poly_rel\ and \(q, q') \ sorted_poly_rel\ + shows \\r. (mult_poly_raw p q, r) \ unsorted_poly_rel \ (mult_poly_p q')\<^sup>*\<^sup>* (p', {#}) ({#}, r)\ +proof - + have H: \(q, q') \ sorted_poly_list_rel term_order \ n < length q \ + distinct aa \ sorted_wrt var_order aa \ + (mult_monoms aa (fst (q ! n)), + mset (mult_monoms aa (fst (q ! n)))) + \ term_poly_list_rel\ for aa n + using mult_monoms_spec[unfolded fun_rel_def, simplified] apply - + apply (drule bspec[of _ _ \(aa, (mset aa))\]) + apply (auto simp: term_poly_list_rel_def)[] + unfolding prod.case sorted_poly_list_rel_wrt_def + apply clarsimp + subgoal for y + apply (drule bspec[of _ _ \(fst (q ! n), mset (fst (q ! n)))\]) + apply (cases \q ! n\; cases \y ! n\) + using param_nth[of n y n q \term_poly_list_rel \\<^sub>r int_rel\] + by (auto simp: list_rel_imp_same_length term_poly_list_rel_def) + done + + have H': \(q, q') \ sorted_poly_list_rel term_order \ + distinct aa \ sorted_wrt var_order aa \ + (ab, ba) \ set q \ + remdups_mset (mset aa + mset ab) = mset (mult_monoms aa ab)\ for aa n ab ba + using mult_monoms_spec[unfolded fun_rel_def, simplified] apply - + apply (drule bspec[of _ _ \(aa, (mset aa))\]) + apply (auto simp: term_poly_list_rel_def)[] + unfolding prod.case sorted_poly_list_rel_wrt_def + apply clarsimp + subgoal for y + apply (drule bspec[of _ _ \(ab, mset ab)\]) + apply (auto simp: list_rel_imp_same_length term_poly_list_rel_def list_rel_def + dest: list_all2_in_set_ExD) + done + done + + have H: \(q, q') \ sorted_poly_list_rel term_order \ + a = (aa, b) \ + (pq, r) \ unsorted_poly_rel \ + p' = add_mset (mset aa, b) A \ + \x\set p. term_order aa (fst x) \ + sorted_wrt var_order aa \ + distinct aa \ b\ 0 \ + (\aaa. (aaa, 0) \# q') \ + (pq @ + map (mult_monomials (aa, b)) q, + {#case x of (ys, n) \ (remdups_mset (mset aa + ys), n * b) + . x \# q'#} + + r) + \ unsorted_poly_rel\ for a p p' pq aa b r + apply (auto simp: poly_list_rel_def) + apply (rule_tac b = \y @ map (\(a,b). (mset a, b)) (map (mult_monomials (aa, b)) q)\ in relcompI) + apply (auto simp: list_rel_def list_all2_append list_all2_lengthD H + list_mset_rel_def br_def mult_monomials_def case_prod_beta intro!: list_all2_all_nthI + simp: sorted_poly_list_relD) + apply (subst sorted_poly_list_relD[of q q' term_order]) + apply (auto simp: case_prod_beta H' intro!: image_mset_cong) + done + + show ?thesis + using assms + apply (induction p arbitrary: p') + subgoal + by auto + subgoal premises p for a p p' + using p(1)[of \remove1_mset (mset (fst a), snd a) p'\] p(2-) + apply (cases a) + apply (auto simp: sorted_poly_list_rel_Cons_iff + dest!: multi_member_split) + apply (rule_tac x = \(\(ys, n). (remdups_mset (mset (fst a) + ys), n * snd a)) `# q' + r\ in exI) + apply (auto 5 3 intro: mult_poly_p.intros simp: intro!: H + dest: sorted_poly_list_rel_nonzeroD nonzero_coeffsD) + apply (rule rtranclp_trans) + apply (rule mult_poly_p_add_mset_same) + apply assumption + apply (rule converse_rtranclp_into_rtranclp) + apply (auto intro!: mult_poly_p.intros simp: ac_simps) + done + done +qed + +fun merge_coeffs :: \llist_polynomial \ llist_polynomial\ where + \merge_coeffs [] = []\ | + \merge_coeffs [(xs, n)] = [(xs, n)]\ | + \merge_coeffs ((xs, n) # (ys, m) # p) = + (if xs = ys + then if n + m \ 0 then merge_coeffs ((xs, n + m) # p) else merge_coeffs p + else (xs, n) # merge_coeffs ((ys, m) # p))\ + +abbreviation (in -)mononoms :: \llist_polynomial \ term_poly_list set\ where + \mononoms p \ fst `set p\ + + +lemma fst_normalize_polynomial_subset: + \mononoms (merge_coeffs p) \ mononoms p\ + by (induction p rule: merge_coeffs.induct) auto + + +lemma fst_normalize_polynomial_subsetD: + \(a, b) \ set (merge_coeffs p) \ a \ mononoms p\ + apply (induction p rule: merge_coeffs.induct) + subgoal + by auto + subgoal + by auto + subgoal + by (auto split: if_splits) + done + +lemma distinct_merge_coeffs: + assumes \sorted_wrt R (map fst xs)\ and \transp R\ \antisymp R\ + shows \distinct (map fst (merge_coeffs xs))\ + using assms + by (induction xs rule: merge_coeffs.induct) + (auto 5 4 dest: antisympD dest!: fst_normalize_polynomial_subsetD) + +lemma in_set_merge_coeffsD: + \(a, b) \ set (merge_coeffs p) \\b. (a, b) \ set p\ + by (auto dest!: fst_normalize_polynomial_subsetD) + +lemma rtranclp_normalize_poly_add_mset: + \normalize_poly_p\<^sup>*\<^sup>* A r \ normalize_poly_p\<^sup>*\<^sup>* (add_mset x A) (add_mset x r)\ + by (induction rule: rtranclp_induct) + (auto dest: normalize_poly_p.keep_coeff[of _ _ x]) + +lemma nonzero_coeffs_diff: + \nonzero_coeffs A \ nonzero_coeffs (A - B)\ + by (auto simp: nonzero_coeffs_def dest: in_diffD) + + +lemma merge_coeffs_is_normalize_poly_p: + \(xs, ys) \ sorted_repeat_poly_rel \ \r. (merge_coeffs xs, r) \ sorted_poly_rel \ normalize_poly_p\<^sup>*\<^sup>* ys r\ + apply (induction xs arbitrary: ys rule: merge_coeffs.induct) + subgoal by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def) + subgoal + by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def) + subgoal premises p for xs n ys m p ysa + apply (cases \xs = ys\, cases \m+n \ 0\) + subgoal + using p(1)[of \add_mset (mset ys, m+n) ysa - {#(mset ys, m), (mset ys, n)#}\] p(4-) + apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \r\ in exI) + using normalize_poly_p.merge_dup_coeff[of \ysa - {#(mset ys, m), (mset ys, n)#}\ \ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\ m n] + by (auto dest!: multi_member_split simp del: normalize_poly_p.merge_dup_coeff + simp: add_mset_commute + intro: converse_rtranclp_into_rtranclp) + subgoal + using p(2)[of \ysa - {#(mset ys, m), (mset ys, n)#}\] p(4-) + apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \r\ in exI) + using normalize_poly_p.rem_0_coeff[of \add_mset (mset ys, m +n) ysa - {#(mset ys, m), (mset ys, n)#}\ \add_mset (mset ys, m +n) ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\] + using normalize_poly_p.merge_dup_coeff[of \ysa - {#(mset ys, m), (mset ys, n)#}\ \ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\ m n] + by (force intro: add_mset_commute[of \(mset ys, n)\ \(mset ys, -n)\] + converse_rtranclp_into_rtranclp + dest!: multi_member_split + simp del: normalize_poly_p.rem_0_coeff + simp: add_eq_0_iff2 + intro: normalize_poly_p.rem_0_coeff) + subgoal + using p(3)[of \add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\] p(4-) + apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \add_mset (mset xs, n) r\ in exI) + apply (auto dest!: in_set_merge_coeffsD) + apply (auto intro: normalize_poly_p.intros rtranclp_normalize_poly_add_mset + simp: rel2p_def var_order_rel_def + dest!: multi_member_split + dest: sorted_poly_list_rel_nonzeroD) + using total_on_lexord_less_than_char_linear apply fastforce + using total_on_lexord_less_than_char_linear apply fastforce + done + done +done + + +subsection \Normalisation\ + +definition normalize_poly where + \normalize_poly p = do { + p \ sort_poly_spec p; + RETURN (merge_coeffs p) +}\ +definition sort_coeff :: \string list \ string list nres\ where +\sort_coeff ys = SPEC(\xs. mset xs = mset ys \ sorted_wrt (rel2p (Id \ var_order_rel)) xs)\ + +lemma distinct_var_order_Id_var_order: + \distinct a \ sorted_wrt (rel2p (Id \ var_order_rel)) a \ + sorted_wrt var_order a\ + by (induction a) (auto simp: rel2p_def) + +definition sort_all_coeffs :: \llist_polynomial \ llist_polynomial nres\ where +\sort_all_coeffs xs = monadic_nfoldli xs (\_. RETURN True) (\(a, n) b. do {a \ sort_coeff a; RETURN ((a, n) # b)}) []\ + +lemma sort_all_coeffs_gen: + assumes \(\xs \ mononoms xs'. sorted_wrt (rel2p (var_order_rel)) xs)\ and + \\x \ mononoms (xs @ xs'). distinct x\ + shows \monadic_nfoldli xs (\_. RETURN True) (\(a, n) b. do {a \ sort_coeff a; RETURN ((a, n) # b)}) xs' \ + \Id (SPEC(\ys. map (\(a,b). (mset a, b)) (rev xs @ xs') = map (\(a,b). (mset a, b)) (ys) \ + (\xs \ mononoms ys. sorted_wrt (rel2p (var_order_rel)) xs)))\ +proof - + have H: \ + \x\set xs'. sorted_wrt var_order (fst x) \ + sorted_wrt (rel2p (Id \ var_order_rel)) x \ + (aaa, ba) \ set xs' \ + sorted_wrt (rel2p (Id \ var_order_rel)) aaa\ for xs xs' ba aa b x aaa + by (metis UnCI fst_eqD rel2p_def sorted_wrt_mono_rel) + show ?thesis + using assms + unfolding sort_all_coeffs_def sort_coeff_def + apply (induction xs arbitrary: xs') + subgoal + using assms + by auto + subgoal premises p for a xs + using p(2-) + apply (cases a, simp only: monadic_nfoldli_simp bind_to_let_conv Let_def if_True Refine_Basic.nres_monad3 + intro_spec_refine_iff prod.case) + by (auto 5 3 simp: intro_spec_refine_iff image_Un + dest: same_mset_distinct_iff + intro!: p(1)[THEN order_trans] distinct_var_order_Id_var_order + simp: H) + done +qed + +definition shuffle_coefficients where + \shuffle_coefficients xs = (SPEC(\ys. map (\(a,b). (mset a, b)) (rev xs) = map (\(a,b). (mset a, b)) ys \ + (\xs \ mononoms ys. sorted_wrt (rel2p (var_order_rel)) xs)))\ + +lemma sort_all_coeffs: + \\x \ mononoms xs. distinct x \ + sort_all_coeffs xs \ \ Id (shuffle_coefficients xs)\ + unfolding sort_all_coeffs_def shuffle_coefficients_def + by (rule sort_all_coeffs_gen[THEN order_trans]) + auto + +lemma unsorted_term_poly_list_rel_mset: + \(ys, aa) \ unsorted_term_poly_list_rel \ mset ys = aa\ + by (auto simp: unsorted_term_poly_list_rel_def) + +lemma RETURN_map_alt_def: + \RETURN o (map f) = + REC\<^sub>T (\g xs. + case xs of + [] \ RETURN [] + | x # xs \ do {xs \ g xs; RETURN (f x # xs)})\ + unfolding comp_def + apply (subst eq_commute) + apply (intro ext) + apply (induct_tac x) + subgoal + apply (subst RECT_unfold) + apply refine_mono + apply auto + done + subgoal + apply (subst RECT_unfold) + apply refine_mono + apply auto + done + done + + +lemma fully_unsorted_poly_rel_Cons_iff: + \((ys, n) # p, a) \ fully_unsorted_poly_rel \ + (p, remove1_mset (mset ys, n) a) \ fully_unsorted_poly_rel \ + (mset ys, n) \# a \ distinct ys\ + apply (auto simp: poly_list_rel_def list_rel_split_right_iff list_mset_rel_def br_def + unsorted_term_poly_list_rel_def + nonzero_coeffs_def fully_unsorted_poly_list_rel_def dest!: multi_member_split) + apply blast + apply (rule_tac b = \(mset ys, n) # y\ in relcompI) + apply auto + done + +lemma map_mset_unsorted_term_poly_list_rel: + \(\a. a \ mononoms s \ distinct a) \ \x \ mononoms s. distinct x \ + (\xs \ mononoms s. sorted_wrt (rel2p (Id \ var_order_rel)) xs) \ + (s, map (\(a, y). (mset a, y)) s) + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ + by (induction s) (auto simp: term_poly_list_rel_def + distinct_var_order_Id_var_order) + +lemma list_rel_unsorted_term_poly_list_relD: + \(p, y) \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + mset y = (\(a, y). (mset a, y)) `# mset p \ (\x \ mononoms p. distinct x)\ + by (induction p arbitrary: y) + (auto simp: list_rel_split_right_iff + unsorted_term_poly_list_rel_def) + +lemma shuffle_terms_distinct_iff: + assumes \map (\(a, y). (mset a, y)) p = map (\(a, y). (mset a, y)) s\ + shows \(\x\set p. distinct (fst x)) \ (\x\set s. distinct (fst x))\ +proof - + have \\x\set s. distinct (fst x)\ + if m: \map (\(a, y). (mset a, y)) p = map (\(a, y). (mset a, y)) s\ and + dist: \\x\set p. distinct (fst x)\ + for s p + proof standard+ + fix x + assume x: \x \ set s\ + obtain v n where [simp]: \x = (v, n)\ by (cases x) + then have \(mset v, n) \ set (map (\(a, y). (mset a, y)) p)\ + using x unfolding m by auto + then obtain v' where + \(v', n) \ set p\ and + \mset v' = mset v\ + by (auto simp: image_iff) + then show \distinct (fst x)\ + using dist by (metis \x = (v, n)\ distinct_mset_mset_distinct fst_conv) + qed + from this[of p s] this[of s p] + show \?thesis\ + unfolding assms + by blast +qed + +lemma + \(p, y) \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + (a, b) \ set p \ distinct a\ + using list_rel_unsorted_term_poly_list_relD by fastforce + +lemma sort_all_coeffs_unsorted_poly_rel_with0: + assumes \(p, p') \ fully_unsorted_poly_rel\ + shows \sort_all_coeffs p \ \ (unsorted_poly_rel_with0) (RETURN p')\ +proof - + have H: \(map (\(a, y). (mset a, y)) (rev p)) = + map (\(a, y). (mset a, y)) s \ + (map (\(a, y). (mset a, y)) p) = + map (\(a, y). (mset a, y)) (rev s)\ for s + by (auto simp flip: rev_map simp: eq_commute[of \rev (map _ _)\ \map _ _\]) + have 1: \\s y. (p, y) \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + p' = mset y \ + map (\(a, y). (mset a, y)) (rev p) = map (\(a, y). (mset a, y)) s \ + \x\set s. sorted_wrt var_order (fst x) \ + (s, map (\(a, y). (mset a, y)) s) + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ + by (auto 4 4 simp: rel2p_def + dest!: list_rel_unsorted_term_poly_list_relD + dest: shuffle_terms_distinct_iff["THEN" iffD1] + intro!: map_mset_unsorted_term_poly_list_rel + sorted_wrt_mono_rel[of _ \rel2p (var_order_rel)\ \rel2p (Id \ var_order_rel)\]) + have 2: \\s y. (p, y) \ \unsorted_term_poly_list_rel \\<^sub>r int_rel\list_rel \ + p' = mset y \ + map (\(a, y). (mset a, y)) (rev p) = map (\(a, y). (mset a, y)) s \ + \x\set s. sorted_wrt var_order (fst x) \ + mset y = {#case x of (a, x) \ (mset a, x). x \# mset s#}\ + by (metis (no_types, lifting) list_rel_unsorted_term_poly_list_relD mset_map mset_rev) + show ?thesis + apply (rule sort_all_coeffs[THEN order_trans]) + using assms + by (auto simp: shuffle_coefficients_def poly_list_rel_def + RETURN_def fully_unsorted_poly_list_rel_def list_mset_rel_def + br_def dest: list_rel_unsorted_term_poly_list_relD + intro!: RES_refine relcompI[of _ \map (\(a, y). (mset a, y)) (rev p)\] + 1 2) +qed + +lemma sort_poly_spec_id': + assumes \(p, p') \ unsorted_poly_rel_with0\ + shows \sort_poly_spec p \ \ (sorted_repeat_poly_rel_with0) (RETURN p')\ +proof - + obtain y where + py: \(p, y) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ and + p'_y: \p' = mset y\ + using assms + unfolding fully_unsorted_poly_list_rel_def poly_list_rel_def sorted_poly_list_rel_wrt_def + by (auto simp: list_mset_rel_def br_def) + then have [simp]: \length y = length p\ + by (auto simp: list_rel_def list_all2_conv_all_nth) + have H: \(x, p') + \ \term_poly_list_rel \\<^sub>r int_rel\list_rel O list_mset_rel\ + if px: \mset p = mset x\ and \sorted_wrt (rel2p (Id \ lexord var_order_rel)) (map fst x)\ + for x :: \llist_polynomial\ + proof - + obtain f where + f: \bij_betw f {.. and + [simp]: \\i. i x ! i = p ! (f i)\ + using px apply - apply (subst (asm)(2) eq_commute) unfolding mset_eq_perm + by (auto dest!: permutation_Ex_bij) + let ?y = \map (\i. y ! f i) [0 ..< length x]\ + have \i < length y \ (p ! f i, y ! f i) \ term_poly_list_rel \\<^sub>r int_rel\ for i + using list_all2_nthD[of _ p y + \f i\, OF py[unfolded list_rel_def mem_Collect_eq prod.case]] + mset_eq_length[OF px] f + by (auto simp: list_rel_def list_all2_conv_all_nth bij_betw_def) + then have \(x, ?y) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel\ and + xy: \length x = length y\ + using py list_all2_nthD[of \rel2p (term_poly_list_rel \\<^sub>r int_rel)\ p y + \f i\ for i, simplified] mset_eq_length[OF px] + by (auto simp: list_rel_def list_all2_conv_all_nth) + moreover { + have f: \mset_set {0.. + using f mset_eq_length[OF px] + by (auto simp: bij_betw_def lessThan_atLeast0 image_mset_mset_set) + have \mset y = {#y ! f x. x \# mset_set {0.. + by (subst drop_0[symmetric], subst mset_drop_upto, subst xy[symmetric], subst f) + auto + then have \(?y, p') \ list_mset_rel\ + by (auto simp: list_mset_rel_def br_def p'_y) + } + ultimately show ?thesis + by (auto intro!: relcompI[of _ ?y]) + qed + show ?thesis + unfolding sort_poly_spec_def poly_list_rel_def sorted_repeat_poly_list_rel_with0_wrt_def + by refine_rcg (auto intro: H) +qed + + +fun merge_coeffs0 :: \llist_polynomial \ llist_polynomial\ where + \merge_coeffs0 [] = []\ | + \merge_coeffs0 [(xs, n)] = (if n = 0 then [] else [(xs, n)])\ | + \merge_coeffs0 ((xs, n) # (ys, m) # p) = + (if xs = ys + then if n + m \ 0 then merge_coeffs0 ((xs, n + m) # p) else merge_coeffs0 p + else if n = 0 then merge_coeffs0 ((ys, m) # p) + else(xs, n) # merge_coeffs0 ((ys, m) # p))\ + + +lemma sorted_repeat_poly_list_rel_with0_wrt_ConsD: + \((ys, n) # p, a) \ sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \ + (p, remove1_mset (mset ys, n) a) \ sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys\ + unfolding sorted_repeat_poly_list_rel_with0_wrt_def prod.case mem_Collect_eq + list_rel_def + apply (clarsimp) + apply (subst (asm) list.rel_sel) + apply (intro conjI) + apply (rule_tac b = \tl y\ in relcompI) + apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def) + apply (case_tac \lead_coeff y\; case_tac y) + apply (auto simp: term_poly_list_rel_def) + apply (case_tac \lead_coeff y\; case_tac y) + apply (auto simp: term_poly_list_rel_def) + apply (case_tac \lead_coeff y\; case_tac y) + apply (auto simp: term_poly_list_rel_def) + apply (case_tac \lead_coeff y\; case_tac y) + apply (auto simp: term_poly_list_rel_def) + done + +lemma sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff: + \((ys, n) # p, a) \ sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \ + (p, remove1_mset (mset ys, n) a) \ sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \ + (mset ys, n) \# a \ (\x \ set p. S ys (fst x)) \ sorted_wrt (rel2p var_order_rel) ys \ + distinct ys\ + apply (rule iffI) + subgoal + by (auto dest!: sorted_repeat_poly_list_rel_with0_wrt_ConsD) + subgoal + unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq + list_rel_def sorted_repeat_poly_list_rel_with0_wrt_def + apply (clarsimp) + apply (rule_tac b = \(mset ys, n) # y\ in relcompI) + by (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \mset _\] + nonzero_coeffs_def + dest!: multi_member_split) + done + +lemma fst_normalize0_polynomial_subsetD: + \(a, b) \ set (merge_coeffs0 p) \ a \ mononoms p\ + apply (induction p rule: merge_coeffs0.induct) + subgoal + by auto + subgoal + by (auto split: if_splits) + subgoal + by (auto split: if_splits) + done + +lemma in_set_merge_coeffs0D: + \(a, b) \ set (merge_coeffs0 p) \\b. (a, b) \ set p\ + by (auto dest!: fst_normalize0_polynomial_subsetD) + + +lemma merge_coeffs0_is_normalize_poly_p: + \(xs, ys) \ sorted_repeat_poly_rel_with0 \ \r. (merge_coeffs0 xs, r) \ sorted_poly_rel \ normalize_poly_p\<^sup>*\<^sup>* ys r\ + apply (induction xs arbitrary: ys rule: merge_coeffs0.induct) + subgoal by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def + sorted_repeat_poly_list_rel_with0_wrt_def list_mset_rel_def br_def) + subgoal for xs n ys + by (force simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def + sorted_repeat_poly_list_rel_with0_wrt_def list_mset_rel_def br_def + list_rel_split_right_iff) + subgoal premises p for xs n ys m p ysa + apply (cases \xs = ys\, cases \m+n \ 0\) + subgoal + using p(1)[of \add_mset (mset ys, m+n) ysa - {#(mset ys, m), (mset ys, n)#}\] p(5-) + apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff) + apply (auto intro: normalize_poly_p.intros add_mset_commute add_mset_commute + converse_rtranclp_into_rtranclp dest!: multi_member_split + simp del: normalize_poly_p.merge_dup_coeff) + apply (rule_tac x = \r\ in exI) + using normalize_poly_p.merge_dup_coeff[of \ysa - {#(mset ys, m), (mset ys, n)#}\ \ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\ m n] + by (auto intro: normalize_poly_p.intros + converse_rtranclp_into_rtranclp dest!: multi_member_split + simp: add_mset_commute[of \(mset ys, n)\ \(mset ys, m)\] + simp del: normalize_poly_p.merge_dup_coeff) + subgoal + using p(2)[of \ysa - {#(mset ys, m), (mset ys, n)#}\] p(5-) + apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \r\ in exI) + using normalize_poly_p.rem_0_coeff[of \add_mset (mset ys, m +n) ysa - {#(mset ys, m), (mset ys, n)#}\ \add_mset (mset ys, m +n) ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\] + using normalize_poly_p.merge_dup_coeff[of \ysa - {#(mset ys, m), (mset ys, n)#}\ \ysa - {#(mset ys, m), (mset ys, n)#}\ \mset ys\ m n] + by (force intro: normalize_poly_p.intros converse_rtranclp_into_rtranclp + dest!: multi_member_split + simp del: normalize_poly_p.rem_0_coeff + simp: add_mset_commute[of \(mset ys, n)\ \(mset ys, m)\]) + apply (cases \n = 0\) + subgoal + using p(3)[of \add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\] p(4-) + apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \r\ in exI) + apply (auto dest!: in_set_merge_coeffsD) + by (force intro: rtranclp_normalize_poly_add_mset converse_rtranclp_into_rtranclp + simp: rel2p_def var_order_rel_def sorted_poly_list_rel_Cons_iff + dest!: multi_member_split + dest: sorted_poly_list_rel_nonzeroD) + subgoal + using p(4)[of \add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\] p(5-) + apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute + remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff) + apply (rule_tac x = \add_mset (mset xs, n) r\ in exI) + apply (auto dest!: in_set_merge_coeffs0D) + apply (auto intro: normalize_poly_p.intros rtranclp_normalize_poly_add_mset + simp: rel2p_def var_order_rel_def sorted_poly_list_rel_Cons_iff + dest!: multi_member_split + dest: sorted_poly_list_rel_nonzeroD) + using in_set_merge_coeffs0D total_on_lexord_less_than_char_linear apply fastforce + using in_set_merge_coeffs0D total_on_lexord_less_than_char_linear apply fastforce + done + done + done + +definition full_normalize_poly where + \full_normalize_poly p = do { + p \ sort_all_coeffs p; + p \ sort_poly_spec p; + RETURN (merge_coeffs0 p) + }\ + +fun sorted_remdups where + \sorted_remdups (x # y # zs) = + (if x = y then sorted_remdups (y # zs) else x # sorted_remdups (y # zs))\ | + \sorted_remdups zs = zs\ + +lemma set_sorted_remdups[simp]: + \set (sorted_remdups xs) = set xs\ + by (induction xs rule: sorted_remdups.induct) + auto + +lemma distinct_sorted_remdups: + \sorted_wrt R xs \ transp R \ Restricted_Predicates.total_on R UNIV \ + antisymp R \ distinct (sorted_remdups xs)\ + by (induction xs rule: sorted_remdups.induct) + (auto dest: antisympD) + +lemma full_normalize_poly_normalize_poly_p: + assumes \(p, p') \ fully_unsorted_poly_rel\ + shows \full_normalize_poly p \ \ (sorted_poly_rel) (SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p' r))\ + (is \?A \ \ ?R ?B\) +proof - + have 1: \?B = do { + p' \ RETURN p'; + p' \ RETURN p'; + SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p' r) + }\ + by auto + have [refine0]: \sort_all_coeffs p \ SPEC(\p. (p, p') \ unsorted_poly_rel_with0)\ + by (rule sort_all_coeffs_unsorted_poly_rel_with0[OF assms, THEN order_trans]) + (auto simp: conc_fun_RES RETURN_def) + have [refine0]: \sort_poly_spec p \ SPEC (\c. (c, p') \ sorted_repeat_poly_rel_with0)\ + if \(p, p') \ unsorted_poly_rel_with0\ + for p p' + by (rule sort_poly_spec_id'[THEN order_trans, OF that]) + (auto simp: conc_fun_RES RETURN_def) + show ?thesis + apply (subst 1) + unfolding full_normalize_poly_def + by (refine_rcg) + (auto intro!: RES_refine + dest!: merge_coeffs0_is_normalize_poly_p + simp: RETURN_def) +qed + +definition mult_poly_full :: \_\ where +\mult_poly_full p q = do { + let pq = mult_poly_raw p q; + normalize_poly pq +}\ + +lemma normalize_poly_normalize_poly_p: + assumes \(p, p') \ unsorted_poly_rel\ + shows \normalize_poly p \ \ (sorted_poly_rel) (SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p' r))\ +proof - + have 1: \SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p' r) = do { + p' \ RETURN p'; + SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p' r) + }\ + by auto + show ?thesis + unfolding normalize_poly_def + apply (subst 1) + apply (refine_rcg sort_poly_spec_id[OF assms] + merge_coeffs_is_normalize_poly_p) + subgoal + by (drule merge_coeffs_is_normalize_poly_p) + (auto intro!: RES_refine simp: RETURN_def) + done +qed + + +subsection \Multiplication and normalisation\ + +definition mult_poly_p' :: \_\ where +\mult_poly_p' p' q' = do { + pq \ SPEC(\r. (mult_poly_p q')\<^sup>*\<^sup>* (p', {#}) ({#}, r)); + SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* pq r) +}\ + +lemma unsorted_poly_rel_fully_unsorted_poly_rel: + \unsorted_poly_rel \ fully_unsorted_poly_rel\ +proof - + have \term_poly_list_rel \\<^sub>r int_rel \ unsorted_term_poly_list_rel \\<^sub>r int_rel\ + by (auto simp: unsorted_term_poly_list_rel_def term_poly_list_rel_def) + from list_rel_mono[OF this] + show ?thesis + unfolding poly_list_rel_def fully_unsorted_poly_list_rel_def + by (auto simp:) +qed + +lemma mult_poly_full_mult_poly_p': + assumes \(p, p') \ sorted_poly_rel\ \(q, q') \ sorted_poly_rel\ + shows \mult_poly_full p q \ \ (sorted_poly_rel) (mult_poly_p' p' q')\ + unfolding mult_poly_full_def mult_poly_p'_def + apply (refine_rcg full_normalize_poly_normalize_poly_p + normalize_poly_normalize_poly_p) + apply (subst RETURN_RES_refine_iff) + apply (subst Bex_def) + apply (subst mem_Collect_eq) + apply (subst conj_commute) + apply (rule mult_poly_raw_mult_poly_p[OF assms(1,2)]) + subgoal + by blast + done + +definition add_poly_spec :: \_\ where +\add_poly_spec p q = SPEC (\r. p + q - r \ ideal polynomial_bool)\ + +definition add_poly_p' :: \_\ where +\add_poly_p' p q = SPEC(\r. add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r))\ + +lemma add_poly_l_add_poly_p': + assumes \(p, p') \ sorted_poly_rel\ \(q, q') \ sorted_poly_rel\ + shows \add_poly_l (p, q) \ \ (sorted_poly_rel) (add_poly_p' p' q')\ + unfolding add_poly_p'_def + apply (refine_rcg add_poly_l_spec[THEN fref_to_Down_curry_right, THEN order_trans, of _ p' q']) + subgoal by auto + subgoal using assms by auto + subgoal + by auto + done + + +subsection \Correctness\ + +context poly_embed +begin + +definition mset_poly_rel where + \mset_poly_rel = {(a, b). b = polynomial_of_mset a}\ + +definition var_rel where + \var_rel = br \ (\_. True)\ + +lemma normalize_poly_p_normalize_poly_spec: + \(p, p') \ mset_poly_rel \ + SPEC (\r. normalize_poly_p\<^sup>*\<^sup>* p r) \ \mset_poly_rel (normalize_poly_spec p')\ + by (auto simp: mset_poly_rel_def rtranclp_normalize_poly_p_poly_of_mset ideal.span_zero + normalize_poly_spec_def intro!: RES_refine) + + +lemma mult_poly_p'_mult_poly_spec: + \(p, p') \ mset_poly_rel \ (q, q') \ mset_poly_rel \ + mult_poly_p' p q \ \mset_poly_rel (mult_poly_spec p' q')\ + unfolding mult_poly_p'_def mult_poly_spec_def + apply refine_rcg + apply (auto simp: mset_poly_rel_def dest!: rtranclp_mult_poly_p_mult_ideal_final) + apply (intro RES_refine) + using ideal.span_add_eq2 ideal.span_zero + by (fastforce dest!: rtranclp_normalize_poly_p_poly_of_mset intro: ideal.span_add_eq2) + + +lemma add_poly_p'_add_poly_spec: + \(p, p') \ mset_poly_rel \ (q, q') \ mset_poly_rel \ + add_poly_p' p q \ \mset_poly_rel (add_poly_spec p' q')\ + unfolding add_poly_p'_def add_poly_spec_def + apply (auto simp: mset_poly_rel_def dest!: rtranclp_add_poly_p_polynomial_of_mset_full) + apply (intro RES_refine) + apply (auto simp: rtranclp_add_poly_p_polynomial_of_mset_full ideal.span_zero) + done + +end + + +definition weak_equality_l :: \llist_polynomial \ llist_polynomial \ bool nres\ where + \weak_equality_l p q = RETURN (p = q)\ + +definition weak_equality :: \int mpoly \ int mpoly \ bool nres\ where + \weak_equality p q = SPEC (\r. r \ p = q)\ + +definition weak_equality_spec :: \mset_polynomial \ mset_polynomial \ bool nres\ where + \weak_equality_spec p q = SPEC (\r. r \ p = q)\ + +lemma term_poly_list_rel_same_rightD: + \(a, aa) \ term_poly_list_rel \ (a, ab) \ term_poly_list_rel \ aa = ab\ + by (auto simp: term_poly_list_rel_def) + +lemma list_rel_term_poly_list_rel_same_rightD: + \(xa, y) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + (xa, ya) \ \term_poly_list_rel \\<^sub>r int_rel\list_rel \ + y = ya\ + by (induction xa arbitrary: y ya) + (auto simp: list_rel_split_right_iff + dest: term_poly_list_rel_same_rightD) + +lemma weak_equality_l_weak_equality_spec: + \(uncurry weak_equality_l, uncurry weak_equality_spec) \ + sorted_poly_rel \\<^sub>r sorted_poly_rel \\<^sub>f \bool_rel\nres_rel\ + by (intro frefI nres_relI) + (auto simp: weak_equality_l_def weak_equality_spec_def + sorted_poly_list_rel_wrt_def list_mset_rel_def br_def + dest: list_rel_term_poly_list_rel_same_rightD) + +end + diff --git a/thys/PAC_Checker/PAC_Polynomials_Term.thy b/thys/PAC_Checker/PAC_Polynomials_Term.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Polynomials_Term.thy @@ -0,0 +1,190 @@ +(* + File: PAC_Polynomials_Term.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Polynomials_Term + imports PAC_Polynomials + Refine_Imperative_HOL.IICF +begin + + +section \Terms\ + +text \We define some helper functions.\ + +subsection \Ordering\ + +(*Taken from WB_More_Refinement*) +lemma fref_to_Down_curry_left: + fixes f:: \'a \ 'b \ 'c nres\ and + A::\(('a \ 'b) \ 'd) set\ + shows + \(uncurry f, g) \ [P]\<^sub>f A \ \B\nres_rel \ + (\a b x'. P x' \ ((a, b), x') \ A \ f a b \ \ B (g x'))\ + unfolding fref_def uncurry_def nres_rel_def + by auto + +lemma fref_to_Down_curry_right: + fixes g :: \'a \ 'b \ 'c nres\ and f :: \'d \ _ nres\ and + A::\('d \ ('a \ 'b)) set\ + shows + \(f, uncurry g) \ [P]\<^sub>f A \ \B\nres_rel \ + (\a b x'. P (a,b) \ (x', (a, b)) \ A \ f x' \ \ B (g a b))\ + unfolding fref_def uncurry_def nres_rel_def + by auto + +type_synonym term_poly_list = \string list\ +type_synonym llist_polynomial = \(term_poly_list \ int) list\ + + +text \We instantiate the characters with typeclass linorder to be able to talk abourt sorted and + so on.\ + +definition less_eq_char :: \char \ char \ bool\ where + \less_eq_char c d = (((of_char c) :: nat) \ of_char d)\ + +definition less_char :: \char \ char \ bool\ where + \less_char c d = (((of_char c) :: nat) < of_char d)\ + +global_interpretation char: linorder less_eq_char less_char + using linorder_char + unfolding linorder_class_def class.linorder_def + less_eq_char_def[symmetric] less_char_def[symmetric] + class.order_def order_class_def + class.preorder_def preorder_class_def + ord_class_def + apply auto + done + +abbreviation less_than_char :: \(char \ char) set\ where + \less_than_char \ p2rel less_char\ + +lemma less_than_char_def: + \(x,y) \ less_than_char \ less_char x y\ + by (auto simp: p2rel_def) + +lemma trans_less_than_char[simp]: + \trans less_than_char\ and + irrefl_less_than_char: + \irrefl less_than_char\ and + antisym_less_than_char: + \antisym less_than_char\ + by (auto simp: less_than_char_def trans_def irrefl_def antisym_def) + + +subsection \Polynomials\ + +definition var_order_rel :: \(string \ string) set\ where + \var_order_rel \ lexord less_than_char\ + +abbreviation var_order :: \string \ string \ bool\ where + \var_order \ rel2p var_order_rel\ + +abbreviation term_order_rel :: \(term_poly_list \ term_poly_list) set\ where + \term_order_rel \ lexord var_order_rel\ + +abbreviation term_order :: \term_poly_list \ term_poly_list \ bool\ where + \term_order \ rel2p term_order_rel\ + +definition term_poly_list_rel :: \(term_poly_list \ term_poly) set\ where + \term_poly_list_rel = {(xs, ys). + ys = mset xs \ + distinct xs \ + sorted_wrt (rel2p var_order_rel) xs}\ + +definition unsorted_term_poly_list_rel :: \(term_poly_list \ term_poly) set\ where + \unsorted_term_poly_list_rel = {(xs, ys). + ys = mset xs \ distinct xs}\ + +definition poly_list_rel :: \_ \ (('a \ int) list \ mset_polynomial) set\ where + \poly_list_rel R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel \ + 0 \# snd `# ys}\ + +definition sorted_poly_list_rel_wrt :: \('a \ 'a \ bool) + \ ('a \ string multiset) set \ (('a \ int) list \ mset_polynomial) set\ where + \sorted_poly_list_rel_wrt S R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel \ + sorted_wrt S (map fst xs) \ + distinct (map fst xs) \ + 0 \# snd `# ys}\ + +abbreviation sorted_poly_list_rel where + \sorted_poly_list_rel R \ sorted_poly_list_rel_wrt R term_poly_list_rel\ + +abbreviation sorted_poly_rel where + \sorted_poly_rel \ sorted_poly_list_rel term_order\ + + +definition sorted_repeat_poly_list_rel_wrt :: \('a \ 'a \ bool) + \ ('a \ string multiset) set \ (('a \ int) list \ mset_polynomial) set\ where + \sorted_repeat_poly_list_rel_wrt S R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel \ + sorted_wrt S (map fst xs) \ + 0 \# snd `# ys}\ + +abbreviation sorted_repeat_poly_list_rel where + \sorted_repeat_poly_list_rel R \ sorted_repeat_poly_list_rel_wrt R term_poly_list_rel\ + +abbreviation sorted_repeat_poly_rel where + \sorted_repeat_poly_rel \ sorted_repeat_poly_list_rel (rel2p (Id \ lexord var_order_rel))\ + + +abbreviation unsorted_poly_rel where + \unsorted_poly_rel \ poly_list_rel term_poly_list_rel\ + +lemma sorted_poly_list_rel_empty_l[simp]: + \([], s') \ sorted_poly_list_rel_wrt S T \ s' = {#}\ + by (cases s') + (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def) + + +definition fully_unsorted_poly_list_rel :: \_ \ (('a \ int) list \ mset_polynomial) set\ where + \fully_unsorted_poly_list_rel R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel}\ + +abbreviation fully_unsorted_poly_rel where + \fully_unsorted_poly_rel \ fully_unsorted_poly_list_rel unsorted_term_poly_list_rel\ + + +lemma fully_unsorted_poly_list_rel_empty_iff[simp]: + \(p, {#}) \ fully_unsorted_poly_list_rel R \ p = []\ + \([], p') \ fully_unsorted_poly_list_rel R \ p' = {#}\ + by (auto simp: fully_unsorted_poly_list_rel_def list_mset_rel_def br_def) + +definition poly_list_rel_with0 :: \_ \ (('a \ int) list \ mset_polynomial) set\ where + \poly_list_rel_with0 R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel}\ + +abbreviation unsorted_poly_rel_with0 where + \unsorted_poly_rel_with0 \ fully_unsorted_poly_list_rel term_poly_list_rel\ + +lemma poly_list_rel_with0_empty_iff[simp]: + \(p, {#}) \ poly_list_rel_with0 R \ p = []\ + \([], p') \ poly_list_rel_with0 R \ p' = {#}\ + by (auto simp: poly_list_rel_with0_def list_mset_rel_def br_def) + + +definition sorted_repeat_poly_list_rel_with0_wrt :: \('a \ 'a \ bool) + \ ('a \ string multiset) set \ (('a \ int) list \ mset_polynomial) set\ where + \sorted_repeat_poly_list_rel_with0_wrt S R = {(xs, ys). + (xs, ys) \ \R \\<^sub>r int_rel\list_rel O list_mset_rel \ + sorted_wrt S (map fst xs)}\ + +abbreviation sorted_repeat_poly_list_rel_with0 where + \sorted_repeat_poly_list_rel_with0 R \ sorted_repeat_poly_list_rel_with0_wrt R term_poly_list_rel\ + +abbreviation sorted_repeat_poly_rel_with0 where + \sorted_repeat_poly_rel_with0 \ sorted_repeat_poly_list_rel_with0 (rel2p (Id \ lexord var_order_rel))\ + +lemma term_poly_list_relD: + \(xs, ys) \ term_poly_list_rel \ distinct xs\ + \(xs, ys) \ term_poly_list_rel \ ys = mset xs\ + \(xs, ys) \ term_poly_list_rel \ sorted_wrt (rel2p var_order_rel) xs\ + \(xs, ys) \ term_poly_list_rel \ sorted_wrt (rel2p (Id \ var_order_rel)) xs\ + apply (auto simp: term_poly_list_rel_def; fail)+ + by (metis (mono_tags, lifting) CollectD UnI2 rel2p_def sorted_wrt_mono_rel split_conv + term_poly_list_rel_def) + +end diff --git a/thys/PAC_Checker/PAC_Specification.thy b/thys/PAC_Checker/PAC_Specification.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Specification.thy @@ -0,0 +1,575 @@ +(* + File: PAC_Specification.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Specification + imports PAC_More_Poly +begin + + +section \Specification of the PAC checker\ + +subsection \Ideals\ + +type_synonym int_poly = \int mpoly\ +definition polynomial_bool :: \int_poly set\ where + \polynomial_bool = (\c. Var c ^ 2 - Var c) ` UNIV\ + +definition pac_ideal where + \pac_ideal A \ ideal (A \ polynomial_bool)\ + +lemma X2_X_in_pac_ideal: + \Var c ^ 2 - Var c \ pac_ideal A\ + unfolding polynomial_bool_def pac_ideal_def + by (auto intro: ideal.span_base) + +lemma pac_idealI1[intro]: + \p \ A \ p \ pac_ideal A\ + unfolding pac_ideal_def + by (auto intro: ideal.span_base) + +lemma pac_idealI2[intro]: + \p \ ideal A \ p \ pac_ideal A\ + using ideal.span_subspace_induct pac_ideal_def by blast + +lemma pac_idealI3[intro]: + \p \ ideal A \ p*q \ pac_ideal A\ + by (metis ideal.span_scale mult.commute pac_idealI2) + +lemma pac_ideal_Xsq2_iff: + \Var c ^ 2 \ pac_ideal A \ Var c \ pac_ideal A\ + unfolding pac_ideal_def + apply (subst (2) ideal.span_add_eq[symmetric, OF X2_X_in_pac_ideal[of c, unfolded pac_ideal_def]]) + apply auto + done + +lemma diff_in_polynomial_bool_pac_idealI: + assumes a1: "p \ pac_ideal A" + assumes a2: "p - p' \ More_Modules.ideal polynomial_bool" + shows \p' \ pac_ideal A\ + proof - + have "insert p polynomial_bool \ pac_ideal A" + using a1 unfolding pac_ideal_def by (meson ideal.span_superset insert_subset le_sup_iff) + then show ?thesis + using a2 unfolding pac_ideal_def by (metis (no_types) ideal.eq_span_insert_eq ideal.span_subset_spanI ideal.span_superset insert_subset subsetD) +qed + +lemma diff_in_polynomial_bool_pac_idealI2: + assumes a1: "p \ A" + assumes a2: "p - p' \ More_Modules.ideal polynomial_bool" + shows \p' \ pac_ideal A\ + using diff_in_polynomial_bool_pac_idealI[OF _ assms(2), of A] assms(1) + by (auto simp: ideal.span_base) + +lemma pac_ideal_alt_def: + \pac_ideal A = ideal (A \ ideal polynomial_bool)\ + unfolding pac_ideal_def + by (meson ideal.span_eq ideal.span_mono ideal.span_superset le_sup_iff subset_trans sup_ge2) + +text \ + + The equality on ideals is restricted to polynomials whose variable + appear in the set of ideals. The function restrict sets: + +\ +definition restricted_ideal_to where + \restricted_ideal_to B A = {p \ A. vars p \ B}\ + +abbreviation restricted_ideal_to\<^sub>I where + \restricted_ideal_to\<^sub>I B A \ restricted_ideal_to B (pac_ideal (set_mset A))\ + +abbreviation restricted_ideal_to\<^sub>V where + \restricted_ideal_to\<^sub>V B \ restricted_ideal_to (\(vars ` set_mset B))\ + +abbreviation restricted_ideal_to\<^sub>V\<^sub>I where + \restricted_ideal_to\<^sub>V\<^sub>I B A \ restricted_ideal_to (\(vars ` set_mset B)) (pac_ideal (set_mset A))\ + + +lemma restricted_idealI: + \p \ pac_ideal (set_mset A) \ vars p \ C \ p \ restricted_ideal_to\<^sub>I C A\ + unfolding restricted_ideal_to_def + by auto + +lemma pac_ideal_insert_already_in: + \pq \ pac_ideal (set_mset A) \ pac_ideal (insert pq (set_mset A)) = pac_ideal (set_mset A)\ + by (auto simp: pac_ideal_alt_def ideal.span_insert_idI) + +lemma pac_ideal_add: + \p \# A \ q \# A \ p + q \ pac_ideal (set_mset A)\ + by (simp add: ideal.span_add ideal.span_base pac_ideal_def) +lemma pac_ideal_mult: + \p \# A \ p * q \ pac_ideal (set_mset A)\ + by (simp add: ideal.span_base pac_idealI3) + +lemma pac_ideal_mono: + \A \ B \ pac_ideal A \ pac_ideal B\ + using ideal.span_mono[of \A \ _\ \B \ _\] + by (auto simp: pac_ideal_def intro: ideal.span_mono) + + +subsection \PAC Format\ + +text \The PAC format contains three kind of steps: + \<^item> \<^verbatim>\add\ that adds up two polynomials that are known. + \<^item> \<^verbatim>\mult\ that multiply a known polynomial with another one. + \<^item> \<^verbatim>\del\ that removes a polynomial that cannot be reused anymore. + +To model the simplification that happens, we add the \<^term>\p - p' \ polynomial_bool\ +stating that \<^term>\p\ and \<^term>\p'\ are equivalent. +\ + +type_synonym pac_st = \(nat set \ int_poly multiset)\ + +inductive PAC_Format :: \pac_st \ pac_st \ bool\ where +add: + \PAC_Format (\, A) (\, add_mset p' A)\ +if + \p \# A\ \q \# A\ + \p+q - p' \ ideal polynomial_bool\ + \vars p' \ \\ | +mult: + \PAC_Format (\, A) (\, add_mset p' A)\ +if + \p \# A\ + \p*q - p' \ ideal polynomial_bool\ + \vars p' \ \\ + \vars q \ \\ | +del: + \p \# A \ PAC_Format (\, A) (\, A - {#p#})\ | +extend_pos: + \PAC_Format (\, A) (\ \ {x' \ vars (-Var x + p'). x' \ \}, add_mset (-Var x + p') A)\ + if + \(p')\<^sup>2 - p' \ ideal polynomial_bool\ + \vars p' \ \\ + \x \ \\ + +text \ + In the PAC format above, we have a technical condition on the + normalisation: \<^term>\vars p' \ vars (p + q)\ is here to ensure that + we don't normalise \<^term>\0 :: int mpoly\ to \<^term>\Var x^2 - Var x :: int mpoly\ + for a new variable \<^term>\x :: nat\. This is completely obvious for the normalisation + process we have in mind when we write the specification, but we must add it + explicitly because we are too general. +\ + +lemmas PAC_Format_induct_split = + PAC_Format.induct[split_format(complete), of V A V' A' for V A V' A'] + +lemma PAC_Format_induct[consumes 1, case_names add mult del ext]: + assumes + \PAC_Format (\, A) (\', A')\ and + cases: + \\p q p' A \. p \# A \ q \# A \ p+q - p' \ ideal polynomial_bool \ vars p' \ \ \ P \ A \ (add_mset p' A)\ + \\p q p' A \. p \# A \ p*q - p' \ ideal polynomial_bool \ vars p' \ \ \ vars q \ \ \ + P \ A \ (add_mset p' A)\ + \\p A \. p \# A \ P \ A \ (A - {#p#})\ + \\p' x r. + (p')^2 - (p') \ ideal polynomial_bool \ vars p' \ \ \ + x \ \ \ P \ A (\ \ {x' \ vars (p' - Var x). x' \ \}) (add_mset (p' -Var x) A)\ + shows + \P \ A \' A'\ + using assms(1) apply - + by (induct V\\ A\A \' A' rule: PAC_Format_induct_split) + (auto intro: assms(1) cases) + + +text \ + +The theorem below (based on the proof ideal by Manuel Kauers) is the +correctness theorem of extensions. Remark that the assumption \<^term>\vars +q \ \\ is only used to show that \<^term>\x' \ vars q\. + +\ +lemma extensions_are_safe: + assumes \x' \ vars p\ and + x': \x' \ \\ and + \\ (vars ` set_mset A) \ \\ and + p_x_coeff: \coeff p (monomial (Suc 0) x') = 1\ and + vars_q: \vars q \ \\ and + q: \q \ More_Modules.ideal (insert p (set_mset A \ polynomial_bool))\ and + leading: \x' \ vars (p - Var x')\ and + diff: \(Var x' - p)\<^sup>2 - (Var x' - p) \ More_Modules.ideal polynomial_bool\ + shows + \q \ More_Modules.ideal (set_mset A \ polynomial_bool)\ +proof - + define p' where \p' \ p - Var x'\ + let ?v = \Var x' :: int mpoly\ + have p_p': \p = ?v + p'\ + by (auto simp: p'_def) + define q' where \q' \ Var x' - p\ + have q_q': \p = ?v - q'\ + by (auto simp: q'_def) + have diff: \q'^2 - q' \ More_Modules.ideal polynomial_bool\ + using diff unfolding q_q' by auto + + have [simp]: \vars ((Var c)\<^sup>2 - Var c :: int mpoly) = {c}\ for c + apply (auto simp: vars_def Var_def Var\<^sub>0_def mpoly.MPoly_inverse keys_def lookup_minus_fun + lookup_times_monomial_right single.rep_eq split: if_splits) + apply (auto simp: vars_def Var_def Var\<^sub>0_def mpoly.MPoly_inverse keys_def lookup_minus_fun + lookup_times_monomial_right single.rep_eq when_def ac_simps adds_def lookup_plus_fun + power2_eq_square times_mpoly.rep_eq minus_mpoly.rep_eq split: if_splits) + apply (rule_tac x = \(2 :: nat \\<^sub>0 nat) * monomial (Suc 0) c\ in exI) + apply (auto dest: monomial_0D simp: plus_eq_zero_2 lookup_plus_fun mult_2) + by (meson Suc_neq_Zero monomial_0D plus_eq_zero_2) + + + have eq: \More_Modules.ideal (insert p (set_mset A \ polynomial_bool)) = + More_Modules.ideal (insert p (set_mset A \ (\c. Var c ^ 2 - Var c) ` {c. c \ x'}))\ + (is \?A = ?B\ is \_ = More_Modules.ideal ?trimmed\) + proof - + let ?C = \insert p (set_mset A \ (\c. Var c ^ 2 - Var c) ` {c. c \ x'})\ + let ?D = \(\c. Var c ^ 2 - Var c) ` {c. c \ x'}\ + have diff: \q'^2 - q' \ More_Modules.ideal ?D\ (is \?q \ _\) + proof - + obtain r t where + q: \?q = (\a\t. r a * a)\ and + fin_t: \finite t\ and + t: \t \ polynomial_bool\ + using diff unfolding ideal.span_explicit + by auto + show ?thesis + proof (cases \?v^2-?v \ t\) + case True + then show \?thesis\ + using q fin_t t unfolding ideal.span_explicit + by (auto intro!: exI[of _ \t - {?v^2 -?v}\] exI[of _ r] + simp: polynomial_bool_def sum_diff1) + next + case False + define t' where \t' = t - {?v^2 - ?v}\ + have t_t': \t = insert (?v^2 - ?v) t'\ and + notin: \?v^2 - ?v \ t'\ and + \t' \ (\c. Var c ^ 2 - Var c) ` {c. c \ x'}\ + using False t unfolding t'_def polynomial_bool_def by auto + have mon: \monom (monomial (Suc 0) x') 1 = Var x'\ + by (auto simp: coeff_def minus_mpoly.rep_eq Var_def Var\<^sub>0_def monom_def + times_mpoly.rep_eq lookup_minus lookup_times_monomial_right mpoly.MPoly_inverse) + then have \\a. \g h. r a = ?v * g + h \ x' \ vars h\ + using polynomial_split_on_var[of \r _\ x'] + by metis + then obtain g h where + r: \r a = ?v * g a + h a\ and + x'_h: \x' \ vars (h a)\ for a + using polynomial_split_on_var[of \r a\ x'] + by metis + have \?q = ((\a\t'. g a * a) + r (?v^2-?v) * (?v - 1)) * ?v + (\a\t'. h a * a)\ + using fin_t notin unfolding t_t' q r + by (auto simp: field_simps comm_monoid_add_class.sum.distrib + power2_eq_square ideal.scale_left_commute sum_distrib_left) + moreover have \x' \ vars ?q\ + by (metis (no_types, hide_lams) Groups.add_ac(2) Un_iff add_diff_cancel_left' + diff_minus_eq_add in_mono leading q'_def semiring_normalization_rules(29) + vars_in_right_only vars_mult) + moreover { + have \x' \ (\m\t' - {?v^2-?v}. vars (h m * m))\ + using fin_t x'_h vars_mult[of \h _\] \t \ polynomial_bool\ + by (auto simp: polynomial_bool_def t_t' elim!: vars_unE) + then have \x' \ vars (\a\t'. h a * a)\ + using vars_setsum[of \t'\ \\a. h a * a\] fin_t x'_h t notin + by (auto simp: t_t') + } + ultimately have \?q = (\a\t'. h a * a)\ + unfolding mon[symmetric] + by (rule polynomial_decomp_alien_var(2)[unfolded]) + then show ?thesis + using t fin_t \t' \ (\c. Var c ^ 2 - Var c) ` {c. c \ x'}\ + unfolding ideal.span_explicit t_t' + by auto + qed + qed + have eq1: \More_Modules.ideal (insert p (set_mset A \ polynomial_bool)) = + More_Modules.ideal (insert (?v^2 - ?v) ?C)\ + (is \More_Modules.ideal _ = More_Modules.ideal (insert _ ?C)\) + by (rule arg_cong[of _ _ More_Modules.ideal]) + (auto simp: polynomial_bool_def) + moreover have \?v^2 - ?v \ More_Modules.ideal ?C\ + proof - + have \?v - q' \ More_Modules.ideal ?C\ + by (auto simp: q_q' ideal.span_base) + from ideal.span_scale[OF this, of \?v + q' - 1\] have \(?v - q') * (?v + q' - 1) \ More_Modules.ideal ?C\ + by (auto simp: field_simps) + moreover have \q'^2 - q' \ More_Modules.ideal ?C\ + using diff by (smt Un_insert_right ideal.span_mono insert_subset subsetD sup_ge2) + ultimately have \(?v - q') * (?v + q' - 1) + (q'^2 - q') \ More_Modules.ideal ?C\ + by (rule ideal.span_add) + moreover have \?v^2 - ?v = (?v - q') * (?v + q' - 1) + (q'^2 - q')\ + by (auto simp: p'_def q_q' field_simps power2_eq_square) + ultimately show ?thesis by simp + qed + ultimately show ?thesis + using ideal.span_insert_idI by blast + qed + + have \n < m \ n > 0 \ \q. ?v^n = ?v + q * (?v^2 - ?v)\ for n m :: nat + proof (induction m arbitrary: n) + case 0 + then show ?case by auto + next + case (Suc m n) note IH = this(1-) + consider + \n < m\ | + \m = n\ \n > 1\ | + \n = 1\ + using IH + by (cases \n < m\; cases n) auto + then show ?case + proof cases + case 1 + then show ?thesis using IH by auto + next + case 2 + have eq: \?v^(n) = ((?v :: int mpoly) ^ (n-2)) * (?v^2-?v) + ?v^(n-1)\ + using 2 by (auto simp: field_simps power_eq_if + ideal.scale_right_diff_distrib) + obtain q where + q: \?v^(n-1) = ?v + q * (?v^2 - ?v)\ + using IH(1)[of \n-1\] 2 + by auto + show ?thesis + using q unfolding eq + by (auto intro!: exI[of _ \Var x' ^ (n - 2) + q\] simp: distrib_right) + next + case 3 + then show \?thesis\ + by auto + qed + qed + + obtain r t where + q: \q = (\a\t. r a * a)\ and + fin_t: \finite t\ and + t: \t \ ?trimmed\ + using q unfolding eq unfolding ideal.span_explicit + by auto + + + define t' where \t' \ t - {p}\ + have t': \t = (if p \ t then insert p t' else t')\ and + t''[simp]: \p \ t'\ + unfolding t'_def by auto + show ?thesis + proof (cases \r p = 0 \ p \ t\) + case True + have + q: \q = (\a\t'. r a * a)\ and + fin_t: \finite t'\ and + t: \t' \ set_mset A \ polynomial_bool\ + using q fin_t t True t'' + apply (subst (asm) t') + apply (auto intro: sum.cong simp: sum.insert_remove t'_def) + using q fin_t t True t'' + apply (auto intro: sum.cong simp: sum.insert_remove t'_def polynomial_bool_def) + done + then show ?thesis + by (auto simp: ideal.span_explicit) + next + case False + then have \r p \ 0\ and \p \ t\ + by auto + then have t: \t = insert p t'\ + by (auto simp: t'_def) + + have \x' \ vars (- p')\ + using leading p'_def vars_in_right_only by fastforce + have mon: \monom (monomial (Suc 0) x') 1 = Var x'\ + by (auto simp:coeff_def minus_mpoly.rep_eq Var_def Var\<^sub>0_def monom_def + times_mpoly.rep_eq lookup_minus lookup_times_monomial_right mpoly.MPoly_inverse) + then have \\a. \g h. r a = (?v + p') * g + h \ x' \ vars h\ + using polynomial_split_on_var2[of x' \-p'\ \r _\] \x' \ vars (- p')\ + by (metis diff_minus_eq_add) + then obtain g h where + r: \r a = p * g a + h a\ and + x'_h: \x' \ vars (h a)\ for a + using polynomial_split_on_var2[of x' p' \r a\] unfolding p_p'[symmetric] + by metis + + + have ISABLLE_come_on: \a * (p * g a) = p * (a * g a)\ for a + by auto + have q1: \q = p * (\a\t'. g a * a) + (\a\t'. h a * a) + p * r p\ + (is \_ = _ + ?NOx' + _\) + using fin_t t'' unfolding q t ISABLLE_come_on r + apply (subst semiring_class.distrib_right)+ + apply (auto simp: comm_monoid_add_class.sum.distrib semigroup_mult_class.mult.assoc + ISABLLE_come_on simp flip: semiring_0_class.sum_distrib_right + semiring_0_class.sum_distrib_left) + by (auto simp: field_simps) + also have \... = ((\a\t'. g a * a) + r p) * p + (\a\t'. h a * a)\ + by (auto simp: field_simps) + finally have q_decomp: \q = ((\a\t'. g a * a) + r p) * p + (\a\t'. h a * a)\ + (is \q = ?X * p + ?NOx'\). + + + have [iff]: \monomial (Suc 0) c = 0 - monomial (Suc 0) c = False\ for c + by (metis One_nat_def diff_is_0_eq' le_eq_less_or_eq less_Suc_eq_le monomial_0_iff single_diff zero_neq_one) + have \x \ t' \ x' \ vars x \ False\ for x + using \t \ ?trimmed\ t assms(2,3) + apply (auto simp: polynomial_bool_def dest!: multi_member_split) + apply (frule set_rev_mp) + apply assumption + apply (auto dest!: multi_member_split) + done + then have \x' \ (\m\t'. vars (h m * m))\ + using fin_t x'_h vars_mult[of \h _\] + by (auto simp: t elim!: vars_unE) + then have \x' \ vars ?NOx'\ + using vars_setsum[of \t'\ \\a. h a * a\] fin_t x'_h + by (auto simp: t) + + moreover { + have \x' \ vars p'\ + using assms(7) + unfolding p'_def + by auto + then have \x' \ vars (h p * p')\ + using vars_mult[of \h p\ p'] x'_h + by auto + } + ultimately have + \x' \ vars q\ + \x' \ vars ?NOx'\ + \x' \ vars p'\ + using x' vars_q vars_add[of \h p * p'\ \\a\t'. h a * a\] x'_h + leading p'_def + by auto + then have \?X = 0\ and q_decomp: \q = ?NOx'\ + unfolding mon[symmetric] p_p' + using polynomial_decomp_alien_var2[OF q_decomp[unfolded p_p' mon[symmetric]]] + by auto + + then have \r p = (\a\t'. (- g a) * a)\ + (is \_ = ?CL\) + unfolding add.assoc add_eq_0_iff equation_minus_iff + by (auto simp: sum_negf ac_simps) + + + then have q2: \q = (\a\t'. a * (r a - p * g a))\ + using fin_t unfolding q + apply (auto simp: t r q + comm_monoid_add_class.sum.distrib[symmetric] + sum_distrib_left + sum_distrib_right + left_diff_distrib + intro!: sum.cong) + apply (auto simp: field_simps) + done + then show \?thesis\ + using t fin_t \t \ ?trimmed\ unfolding ideal.span_explicit + by (auto intro!: exI[of _ t'] exI[of _ \\a. r a - p * g a\] + simp: field_simps polynomial_bool_def) + qed +qed + +lemma extensions_are_safe_uminus: + assumes \x' \ vars p\ and + x': \x' \ \\ and + \\ (vars ` set_mset A) \ \\ and + p_x_coeff: \coeff p (monomial (Suc 0) x') = -1\ and + vars_q: \vars q \ \\ and + q: \q \ More_Modules.ideal (insert p (set_mset A \ polynomial_bool))\ and + leading: \x' \ vars (p + Var x')\ and + diff: \(Var x' + p)^2 - (Var x' + p) \ More_Modules.ideal polynomial_bool\ + shows + \q \ More_Modules.ideal (set_mset A \ polynomial_bool)\ +proof - + have \q \ More_Modules.ideal (insert (- p) (set_mset A \ polynomial_bool))\ + by (metis ideal.span_breakdown_eq minus_mult_minus q) + + then show ?thesis + using extensions_are_safe[of x' \-p\ \ A q] assms + using vars_in_right_only by force +qed + +text \This is the correctness theorem of a PAC step: no polynomials are +added to the ideal.\ + +lemma vars_subst_in_left_only: + \x \ vars p \ x \ vars (p - Var x)\ for p :: \int mpoly\ + by (metis One_nat_def Var.abs_eq Var\<^sub>0_def group_eq_aux monom.abs_eq mult_numeral_1 polynomial_decomp_alien_var(1) zero_neq_numeral) + +lemma vars_subst_in_left_only_diff_iff: + fixes p :: \int mpoly\ + assumes \x \ vars p\ + shows \vars (p - Var x) = insert x (vars p)\ +proof - + have \\xa. x \ vars p \ xa \ vars (p - Var x) \ xa \ vars p \ xa = x\ + by (metis (no_types, hide_lams) diff_0_right diff_minus_eq_add empty_iff in_vars_addE insert_iff + keys_single minus_diff_eq monom_one mult.right_neutral one_neq_zero single_zero + vars_monom_keys vars_mult_Var vars_uminus) + moreover have \\xa. x \ vars p \ xa \ vars p \ xa \ vars (p - Var x)\ + by (metis add.inverse_inverse diff_minus_eq_add empty_iff insert_iff keys_single minus_diff_eq + monom_one mult.right_neutral one_neq_zero single_zero vars_in_right_only vars_monom_keys + vars_mult_Var vars_uminus) + ultimately show ?thesis + using assms + by (auto simp: vars_subst_in_left_only) +qed + +lemma vars_subst_in_left_only_iff: + \x \ vars p \ vars (p + Var x) = insert x (vars p)\ for p :: \int mpoly\ + using vars_subst_in_left_only_diff_iff[of x \-p\] + by (metis diff_0 diff_diff_add vars_uminus) + +lemma coeff_add_right_notin: + \x \ vars p \ MPoly_Type.coeff (Var x - p) (monomial (Suc 0) x) = 1\ + apply (auto simp flip: coeff_minus simp: not_in_vars_coeff0) + by (simp add: MPoly_Type.coeff_def Var.rep_eq Var\<^sub>0_def) + +lemma coeff_add_left_notin: + \x \ vars p \ MPoly_Type.coeff (p - Var x) (monomial (Suc 0) x) = -1\ for p :: \int mpoly\ + apply (auto simp flip: coeff_minus simp: not_in_vars_coeff0) + by (simp add: MPoly_Type.coeff_def Var.rep_eq Var\<^sub>0_def) + +lemma ideal_insert_polynomial_bool_swap: \r - s \ ideal polynomial_bool \ + More_Modules.ideal (insert r (A \ polynomial_bool)) = More_Modules.ideal (insert s (A \ polynomial_bool))\ + apply auto + using ideal.eq_span_insert_eq ideal.span_mono sup_ge2 apply blast+ + done + +lemma PAC_Format_subset_ideal: + \PAC_Format (\, A) (\', B) \ \(vars ` set_mset A) \ \ \ + restricted_ideal_to\<^sub>I \ B \ restricted_ideal_to\<^sub>I \ A \ \ \ \' \ \(vars ` set_mset B) \ \'\ + unfolding restricted_ideal_to_def + apply (induction rule:PAC_Format_induct) + subgoal for p q pq A \ + using vars_add + by (force simp: ideal.span_add_eq ideal.span_base pac_ideal_insert_already_in[OF diff_in_polynomial_bool_pac_idealI[of \p + q\ \_\ pq]] + pac_ideal_add + intro!: diff_in_polynomial_bool_pac_idealI[of \p + q\ \_\ pq]) + subgoal for p q pq + using vars_mult[of p q] + by (force simp: ideal.span_add_eq ideal.span_base pac_ideal_mult + pac_ideal_insert_already_in[OF diff_in_polynomial_bool_pac_idealI[of \p*q\ \_\ pq]]) + subgoal for p A + using pac_ideal_mono[of \set_mset (A - {#p#})\ \set_mset A\] + by (auto dest: in_diffD) + subgoal for p x' r' + apply (subgoal_tac \x' \ vars p\) + using extensions_are_safe_uminus[of x' \-Var x' + p\ \ A] unfolding pac_ideal_def + apply (auto simp: vars_subst_in_left_only coeff_add_left_notin) + done + done + + +text \ + In general, if deletions are disallowed, then the stronger \<^term>\B = pac_ideal A\ holds. +\ +lemma restricted_ideal_to_restricted_ideal_to\<^sub>ID: + \restricted_ideal_to \ (set_mset A) \ restricted_ideal_to\<^sub>I \ A\ + by (auto simp add: Collect_disj_eq pac_idealI1 restricted_ideal_to_def) + + +lemma rtranclp_PAC_Format_subset_ideal: + \rtranclp PAC_Format (\, A) (\', B) \ \(vars ` set_mset A) \ \ \ + restricted_ideal_to\<^sub>I \ B \ restricted_ideal_to\<^sub>I \ A \ \ \ \' \ \(vars ` set_mset B) \ \'\ + apply (induction rule:rtranclp_induct[of PAC_Format \(_, _)\ \(_, _)\, split_format(complete)]) + subgoal + by (simp add: restricted_ideal_to_restricted_ideal_to\<^sub>ID) + subgoal + by (drule PAC_Format_subset_ideal) + (auto simp: restricted_ideal_to_def Collect_mono_iff) + done + + +end \ No newline at end of file diff --git a/thys/PAC_Checker/PAC_Version.thy b/thys/PAC_Checker/PAC_Version.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/PAC_Version.thy @@ -0,0 +1,24 @@ +(* + File: PAC_Version.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Maintainer: Mathias Fleury, JKU +*) +theory PAC_Version + imports Main +begin + +text \This code was taken from IsaFoR. However, for the AFP, we use the version name \<^text>\AFP\, +instead of a mercurial version. \ +local_setup \ + let + val version = "AFP" + in + Local_Theory.define + ((\<^binding>\version\, NoSyn), + ((\<^binding>\version_def\, []), HOLogic.mk_literal version)) #> #2 + end +\ + +declare version_def [code] + +end diff --git a/thys/PAC_Checker/ROOT b/thys/PAC_Checker/ROOT new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/ROOT @@ -0,0 +1,38 @@ +chapter AFP + +session PAC_Checker (AFP) = "Sepref_IICF" + + description \PAC proof checker\ + options + [timeout = 2700] + sessions + "HOL-Library" + "HOL-Algebra" + "Polynomials" + Nested_Multisets_Ordinals + theories + PAC_More_Poly + Duplicate_Free_Multiset + Finite_Map_Multiset + WB_Sort + More_Loops + PAC_Specification + PAC_Map_Rel + PAC_Checker_Specification + PAC_Checker_Relation + PAC_Polynomials + PAC_Polynomials_Term + PAC_Polynomials_Operations + PAC_Assoc_Map_Rel + PAC_Map_Rel + PAC_Checker + PAC_Checker_Init + PAC_Version + PAC_Checker_Synthesis + theories [condition=ISABELLE_MLTON] + PAC_Checker_MLton + document_files + "root.tex" + "root.bib" + export_files (in "code") [1] + "PAC_Checker.PAC_Checker_MLton:**" + diff --git a/thys/PAC_Checker/WB_Sort.thy b/thys/PAC_Checker/WB_Sort.thy new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/WB_Sort.thy @@ -0,0 +1,1688 @@ +(* + File: WB_Sort.thy + Author: Mathias Fleury, Daniela Kaufmann, JKU + Author: Maximilian Wuttke, Saarland University + Maintainer: Mathias Fleury, JKU + +Correctness proof contributed by Maximilian Wuttke *) +theory WB_Sort + imports Refine_Imperative_HOL.IICF "HOL-Library.Rewrite" Duplicate_Free_Multiset +begin + +text \This a complete copy-paste of the IsaFoL version because sharing is too hard.\ + + +text \Every element between \<^term>\lo\ and \<^term>\hi\ can be chosen as pivot element.\ +definition choose_pivot :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ nat nres\ where + \choose_pivot _ _ _ lo hi = SPEC(\k. k \ lo \ k \ hi)\ + +text \The element at index \p\ partitions the subarray \lo..hi\. This means that every element \ +definition isPartition_wrt :: \('b \ 'b \ bool) \ 'b list \ nat \ nat \ nat \ bool\ where + \isPartition_wrt R xs lo hi p \ (\ i. i \ lo \ i < p \ R (xs!i) (xs!p)) \ (\ j. j > p \ j \ hi \ R (xs!p) (xs!j))\ + +lemma isPartition_wrtI: + \(\ i. \i \ lo; i < p\ \ R (xs!i) (xs!p)) \ (\ j. \j > p; j \ hi\ \ R (xs!p) (xs!j)) \ isPartition_wrt R xs lo hi p\ + by (simp add: isPartition_wrt_def) + +definition isPartition :: \'a :: order list \ nat \ nat \ nat \ bool\ where + \isPartition xs lo hi p \ isPartition_wrt (\) xs lo hi p\ + +abbreviation isPartition_map :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ nat \ bool\ where + \isPartition_map R h xs i j k \ isPartition_wrt (\a b. R (h a) (h b)) xs i j k\ + +lemma isPartition_map_def': + \lo \ p \ p \ hi \ hi < length xs \ isPartition_map R h xs lo hi p = isPartition_wrt R (map h xs) lo hi p\ + by (auto simp add: isPartition_wrt_def conjI) + + +text \Example: 6 is the pivot element (with index 4); \<^term>\7\ is equal to the \<^term>\length xs - 1\.\ +lemma \isPartition [0,5,3,4,6,9,8,10::nat] 0 7 4\ + by (auto simp add: isPartition_def isPartition_wrt_def nth_Cons') + + + +definition sublist :: \'a list \ nat \ nat \ 'a list\ where +\sublist xs i j \ take (Suc j - i) (drop i xs)\ + +(*take from HashMap *) +lemma take_Suc0: + "l\[] \ take (Suc 0) l = [l!0]" + "0 < length l \ take (Suc 0) l = [l!0]" + "Suc n \ length l \ take (Suc 0) l = [l!0]" + by (cases l, auto)+ + +lemma sublist_single: \i < length xs \ sublist xs i i = [xs!i]\ + by (cases xs) (auto simp add: sublist_def take_Suc0) + +lemma insert_eq: \insert a b = b \ {a}\ + by auto + +lemma sublist_nth: \\lo \ hi; hi < length xs; k+lo \ hi\ \ (sublist xs lo hi)!k = xs!(lo+k)\ + by (simp add: sublist_def) + +lemma sublist_length: \\i \ j; j < length xs\ \ length (sublist xs i j) = 1 + j - i\ + by (simp add: sublist_def) + +lemma sublist_not_empty: \\i \ j; j < length xs; xs \ []\ \ sublist xs i j \ []\ + apply simp + apply (rewrite List.length_greater_0_conv[symmetric]) + apply (rewrite sublist_length) + by auto + + + +lemma sublist_app: \\i1 \ i2; i2 \ i3\ \ sublist xs i1 i2 @ sublist xs (Suc i2) i3 = sublist xs i1 i3\ + unfolding sublist_def + by (smt Suc_eq_plus1_left Suc_le_mono append.assoc le_SucI le_add_diff_inverse le_trans same_append_eq take_add) + +definition sorted_sublist_wrt :: \('b \ 'b \ bool) \ 'b list \ nat \ nat \ bool\ where + \sorted_sublist_wrt R xs lo hi = sorted_wrt R (sublist xs lo hi)\ + +definition sorted_sublist :: \'a :: linorder list \ nat \ nat \ bool\ where + \sorted_sublist xs lo hi = sorted_sublist_wrt (\) xs lo hi\ + +abbreviation sorted_sublist_map :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ bool\ where + \sorted_sublist_map R h xs lo hi \ sorted_sublist_wrt (\a b. R (h a) (h b)) xs lo hi\ + +lemma sorted_sublist_map_def': + \lo < length xs \ sorted_sublist_map R h xs lo hi \ sorted_sublist_wrt R (map h xs) lo hi\ + apply (simp add: sorted_sublist_wrt_def) + by (simp add: drop_map sorted_wrt_map sublist_def take_map) + +lemma sorted_sublist_wrt_refl: \i < length xs \ sorted_sublist_wrt R xs i i\ + by (auto simp add: sorted_sublist_wrt_def sublist_single) + +lemma sorted_sublist_refl: \i < length xs \ sorted_sublist xs i i\ + by (auto simp add: sorted_sublist_def sorted_sublist_wrt_refl) + +lemma sublist_map: \sublist (map f xs) i j = map f (sublist xs i j)\ + apply (auto simp add: sublist_def) + by (simp add: drop_map take_map) + + +lemma take_set: \j \ length xs \ x \ set (take j xs) \ (\ k. k < j \ xs!k = x)\ + apply (induction xs) + apply simp + by (meson in_set_conv_iff less_le_trans) + +lemma drop_set: \j \ length xs \ x \ set (drop j xs) \ (\k. j\k\k xs!k=x)\ + by (smt Misc.in_set_drop_conv_nth) (* lemma found by sledgehammer *) + +lemma sublist_el: \i \ j \ j < length xs \ x \ set (sublist xs i j) \ (\ k. k < Suc j-i \ xs!(i+k)=x)\ + by (auto simp add: take_set sublist_def) + +lemma sublist_el': \i \ j \ j < length xs \ x \ set (sublist xs i j) \ (\ k. i\k\k\j \ xs!k=x)\ + apply (subst sublist_el, assumption, assumption) + by (smt Groups.add_ac(2) le_add1 le_add_diff_inverse less_Suc_eq less_diff_conv nat_less_le order_refl) + + +lemma sublist_lt: \hi < lo \ sublist xs lo hi = []\ + by (auto simp add: sublist_def) + +lemma nat_le_eq_or_lt: \(a :: nat) \ b = (a = b \ a < b)\ + by linarith + + +lemma sorted_sublist_wrt_le: \hi \ lo \ hi < length xs \ sorted_sublist_wrt R xs lo hi\ + apply (auto simp add: nat_le_eq_or_lt) + unfolding sorted_sublist_wrt_def + subgoal apply (rewrite sublist_single) by auto + subgoal by (auto simp add: sublist_lt) + done + +text \Elements in a sorted sublists are actually sorted\ +lemma sorted_sublist_wrt_nth_le: + assumes \sorted_sublist_wrt R xs lo hi\ and \lo \ hi\ and \hi < length xs\ and + \lo \ i\ and \i < j\ and \j \ hi\ + shows \R (xs!i) (xs!j)\ +proof - + have A: \lo < length xs\ using assms(2) assms(3) by linarith + obtain i' where I: \i = lo + i'\ using assms(4) le_Suc_ex by auto + obtain j' where J: \j = lo + j'\ by (meson assms(4) assms(5) dual_order.trans le_iff_add less_imp_le_nat) + show ?thesis + using assms(1) apply (simp add: sorted_sublist_wrt_def I J) + apply (rewrite sublist_nth[symmetric, where k=i', where lo=lo, where hi=hi]) + using assms apply auto subgoal using I by linarith + apply (rewrite sublist_nth[symmetric, where k=j', where lo=lo, where hi=hi]) + using assms apply auto subgoal using J by linarith + apply (rule sorted_wrt_nth_less) + apply auto + subgoal using I J nat_add_left_cancel_less by blast + subgoal apply (simp add: sublist_length) using J by linarith + done +qed + +text \We can make the assumption \<^term>\i < j\ weaker if we have a reflexivie relation.\ +lemma sorted_sublist_wrt_nth_le': + assumes ref: \\ x. R x x\ + and \sorted_sublist_wrt R xs lo hi\ and \lo \ hi\ and \hi < length xs\ + and \lo \ i\ and \i \ j\ and \j \ hi\ + shows \R (xs!i) (xs!j)\ +proof - + have \i < j \ i = j\ using \i \ j\ by linarith + then consider (a) \i < j\ | + (b) \i = j\ by blast + then show ?thesis + proof cases + case a + then show ?thesis + using assms(2-5,7) sorted_sublist_wrt_nth_le by blast + next + case b + then show ?thesis + by (simp add: ref) + qed +qed + + + +(* +lemma sorted_sublist_map_nth_le: + assumes \sorted_sublist_map R h xs lo hi\ and \lo \ hi\ and \hi < length xs\ and + \lo \ i\ and \i < j\ and \j \ hi\ + shows \R (h (xs!i)) (h (xs!j))\ +proof - + show ?thesis + using assms by (rule sorted_sublist_wrt_nth_le) +qed +*) + + + +lemma sorted_sublist_le: \hi \ lo \ hi < length xs \ sorted_sublist xs lo hi\ + by (auto simp add: sorted_sublist_def sorted_sublist_wrt_le) + +lemma sorted_sublist_map_le: \hi \ lo \ hi < length xs \ sorted_sublist_map R h xs lo hi\ + by (auto simp add: sorted_sublist_wrt_le) + +lemma sublist_cons: \lo < hi \ hi < length xs \ sublist xs lo hi = xs!lo # sublist xs (Suc lo) hi\ + by (metis Cons_eq_appendI append_self_conv2 less_imp_le_nat less_or_eq_imp_le less_trans + sublist_app sublist_single) + +lemma sorted_sublist_wrt_cons': + \sorted_sublist_wrt R xs (lo+1) hi \ lo \ hi \ hi < length xs \ (\j. loj\hi \ R (xs!lo) (xs!j)) \ sorted_sublist_wrt R xs lo hi\ + apply (auto simp add: nat_le_eq_or_lt sorted_sublist_wrt_def) + apply (auto 5 4 simp add: sublist_cons sublist_el less_diff_conv add.commute[of _ lo] + dest: Suc_lessI sublist_single) + done + +lemma sorted_sublist_wrt_cons: + assumes trans: \(\ x y z. \R x y; R y z\ \ R x z)\ and + \sorted_sublist_wrt R xs (lo+1) hi\ and + \lo \ hi\ and \hi < length xs \ and \R (xs!lo) (xs!(lo+1))\ + shows \sorted_sublist_wrt R xs lo hi\ +proof - + show ?thesis + apply (rule sorted_sublist_wrt_cons') using assms apply auto + subgoal premises assms' for j + proof - + have A: \j=lo+1 \ j>lo+1\ using assms'(5) by linarith + show ?thesis + using A proof + assume A: \j=lo+1\ show ?thesis + by (simp add: A assms') + next + assume A: \j>lo+1\ show ?thesis + apply (rule trans) + apply (rule assms(5)) + apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=\lo+1\, where j=j]) + subgoal using A assms'(6) by linarith + subgoal using assms'(3) less_imp_diff_less by blast + subgoal using assms'(5) by auto + subgoal using A by linarith + subgoal by (simp add: assms'(6)) + done + qed + qed + done +qed + +lemma sorted_sublist_map_cons: + \(\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)) \ + sorted_sublist_map R h xs (lo+1) hi \ lo \ hi \ hi < length xs \ R (h (xs!lo)) (h (xs!(lo+1))) \ sorted_sublist_map R h xs lo hi\ + by (blast intro: sorted_sublist_wrt_cons) + + +lemma sublist_snoc: \lo < hi \ hi < length xs \ sublist xs lo hi = sublist xs lo (hi-1) @ [xs!hi]\ + apply (simp add: sublist_def) +proof - + assume a1: "lo < hi" + assume "hi < length xs" + then have "take lo xs @ take (Suc hi - lo) (drop lo xs) = (take lo xs @ take (hi - lo) (drop lo xs)) @ [xs ! hi]" + using a1 by (metis (no_types) Suc_diff_le add_Suc_right hd_drop_conv_nth le_add_diff_inverse less_imp_le_nat take_add take_hd_drop) + then show "take (Suc hi - lo) (drop lo xs) = take (hi - lo) (drop lo xs) @ [xs ! hi]" + by simp +qed + +lemma sorted_sublist_wrt_snoc': + \sorted_sublist_wrt R xs lo (hi-1) \ lo \ hi \ hi < length xs \ (\j. lo\j\j R (xs!j) (xs!hi)) \ sorted_sublist_wrt R xs lo hi\ + apply (simp add: sorted_sublist_wrt_def) + apply (auto simp add: nat_le_eq_or_lt) + subgoal by (simp add: sublist_single) + by (auto simp add: sublist_snoc sublist_el sorted_wrt_append add.commute[of lo] less_diff_conv + simp: leI simp flip:nat_le_eq_or_lt) + + +lemma sorted_sublist_wrt_snoc: + assumes trans: \(\ x y z. \R x y; R y z\ \ R x z)\ and + \sorted_sublist_wrt R xs lo (hi-1)\ and + \lo \ hi\ and \hi < length xs\ and \(R (xs!(hi-1)) (xs!hi))\ + shows \sorted_sublist_wrt R xs lo hi\ +proof - + show ?thesis + apply (rule sorted_sublist_wrt_snoc') using assms apply auto + subgoal premises assms' for j + proof - + have A: \j=hi-1 \ j using assms'(6) by linarith + show ?thesis + using A proof + assume A: \j=hi-1\ show ?thesis + by (simp add: A assms') + next + assume A: \j show ?thesis + apply (rule trans) + apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=j, where j=\hi-1\]) + prefer 6 + apply (rule assms(5)) + apply auto + subgoal using A assms'(5) by linarith + subgoal using assms'(3) less_imp_diff_less by blast + subgoal using assms'(5) by auto + subgoal using A by linarith + done + qed + qed + done +qed + +lemma sublist_split: \lo \ hi \ lo < p \ p < hi \ hi < length xs \ sublist xs lo p @ sublist xs (p+1) hi = sublist xs lo hi\ + by (simp add: sublist_app) + +lemma sublist_split_part: \lo \ hi \ lo < p \ p < hi \ hi < length xs \ sublist xs lo (p-1) @ xs!p # sublist xs (p+1) hi = sublist xs lo hi\ + by (auto simp add: sublist_split[symmetric] sublist_snoc[where xs=xs,where lo=lo,where hi=p]) + + +text \A property for partitions (we always assume that \<^term>\R\ is transitive.\ +lemma isPartition_wrt_trans: +\(\ x y z. \R x y; R y z\ \ R x z) \ + isPartition_wrt R xs lo hi p \ + (\i j. lo \ i \ i < p \ p < j \ j \ hi \ R (xs!i) (xs!j))\ + by (auto simp add: isPartition_wrt_def) + +lemma isPartition_map_trans: +\(\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)) \ + hi < length xs \ + isPartition_map R h xs lo hi p \ + (\i j. lo \ i \ i < p \ p < j \ j \ hi \ R (h (xs!i)) (h (xs!j)))\ + by (auto simp add: isPartition_wrt_def) + + +lemma merge_sorted_wrt_partitions_between': + \lo \ hi \ lo < p \ p < hi \ hi < length xs \ + isPartition_wrt R xs lo hi p \ + sorted_sublist_wrt R xs lo (p-1) \ sorted_sublist_wrt R xs (p+1) hi \ + (\i j. lo \ i \ i < p \ p < j \ j \ hi \ R (xs!i) (xs!j)) \ + sorted_sublist_wrt R xs lo hi\ + apply (auto simp add: isPartition_def isPartition_wrt_def sorted_sublist_def sorted_sublist_wrt_def sublist_map) + apply (simp add: sublist_split_part[symmetric]) + apply (auto simp add: List.sorted_wrt_append) + subgoal by (auto simp add: sublist_el) + subgoal by (auto simp add: sublist_el) + subgoal by (auto simp add: sublist_el') + done + +lemma merge_sorted_wrt_partitions_between: + \(\ x y z. \R x y; R y z\ \ R x z) \ + isPartition_wrt R xs lo hi p \ + sorted_sublist_wrt R xs lo (p-1) \ sorted_sublist_wrt R xs (p+1) hi \ + lo \ hi \ hi < length xs \ lo < p \ p < hi \ hi < length xs \ + sorted_sublist_wrt R xs lo hi\ + by (simp add: merge_sorted_wrt_partitions_between' isPartition_wrt_trans) + + +(* +lemma merge_sorted_map_partitions_between: + \(\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)) \ + isPartition_map R h xs lo hi p \ + sorted_sublist_map R h xs lo (p-1) \ sorted_sublist_map R h xs (p+1) hi \ + lo \ hi \ hi < length xs \ lo < p \ p < hi \ hi < length xs \ + sorted_sublist_map R h xs lo hi\ + by (simp add: merge_sorted_wrt_partitions_between' isPartition_map_trans) +*) + + + + +text \The main theorem to merge sorted lists\ +lemma merge_sorted_wrt_partitions: + \isPartition_wrt R xs lo hi p \ + sorted_sublist_wrt R xs lo (p - Suc 0) \ sorted_sublist_wrt R xs (Suc p) hi \ + lo \ hi \ lo \ p \ p \ hi \ hi < length xs \ + (\i j. lo \ i \ i < p \ p < j \ j \ hi \ R (xs!i) (xs!j)) \ + sorted_sublist_wrt R xs lo hi\ + subgoal premises assms + proof - + have C: \lo=p\p=hi \ lo=p\p lop=hi \ lop + using assms by linarith + show ?thesis + using C apply auto + subgoal \ \lo=p=hi\ + apply (rule sorted_sublist_wrt_refl) + using assms by auto + subgoal \ \lo=p + using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_cons') + subgoal \ \lo + using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_snoc') + subgoal \ \lo + using assms + apply (rewrite merge_sorted_wrt_partitions_between'[where p=p]) + by auto + done + qed + done + +theorem merge_sorted_map_partitions: + \(\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)) \ + isPartition_map R h xs lo hi p \ + sorted_sublist_map R h xs lo (p - Suc 0) \ sorted_sublist_map R h xs (Suc p) hi \ + lo \ hi \ lo \ p \ p \ hi \ hi < length xs \ + sorted_sublist_map R h xs lo hi\ + apply (rule merge_sorted_wrt_partitions) apply auto + by (simp add: merge_sorted_wrt_partitions isPartition_map_trans) + + +lemma partition_wrt_extend: + \isPartition_wrt R xs lo' hi' p \ + hi < length xs \ + lo \ lo' \ lo' \ hi \ hi' \ hi \ + lo' \ p \ p \ hi' \ + (\ i. lo\i \ i R (xs!i) (xs!p)) \ + (\ j. hi' j\hi \ R (xs!p) (xs!j)) \ + isPartition_wrt R xs lo hi p\ + unfolding isPartition_wrt_def + apply (intro conjI) + subgoal + by (force simp: not_le) + subgoal + using leI by blast + done + +lemma partition_map_extend: + \isPartition_map R h xs lo' hi' p \ + hi < length xs \ + lo \ lo' \ lo' \ hi \ hi' \ hi \ + lo' \ p \ p \ hi' \ + (\ i. lo\i \ i R (h (xs!i)) (h (xs!p))) \ + (\ j. hi' j\hi \ R (h (xs!p)) (h (xs!j))) \ + isPartition_map R h xs lo hi p\ + by (auto simp add: partition_wrt_extend) + + +lemma isPartition_empty: + \(\ j. \lo < j; j \ hi\ \ R (xs ! lo) (xs ! j)) \ + isPartition_wrt R xs lo hi lo\ + by (auto simp add: isPartition_wrt_def) + + + +lemma take_ext: + \(\i + k < length xs \ k < length xs' \ + take k xs' = take k xs\ + by (simp add: nth_take_lemma) + +lemma drop_ext': + \(\i. i\k \ i xs'!i=xs!i) \ + 0 xs\[] \ \ \These corner cases will be dealt with in the next lemma\ + length xs'=length xs \ + drop k xs' = drop k xs\ + apply (rewrite in \drop _ \ = _\ List.rev_rev_ident[symmetric]) + apply (rewrite in \_ = drop _ \\ List.rev_rev_ident[symmetric]) + apply (rewrite in \\ = _\ List.drop_rev) + apply (rewrite in \_ = \\ List.drop_rev) + apply simp + apply (rule take_ext) + by (auto simp add: nth_rev) + +lemma drop_ext: +\(\i. i\k \ i xs'!i=xs!i) \ + length xs'=length xs \ + drop k xs' = drop k xs\ + apply (cases xs) + apply auto + apply (cases k) + subgoal by (simp add: nth_equalityI) + subgoal apply (rule drop_ext') by auto + done + + +lemma sublist_ext': + \(\i. lo\i\i\hi \ xs'!i=xs!i) \ + length xs' = length xs \ + lo \ hi \ Suc hi < length xs \ + sublist xs' lo hi = sublist xs lo hi\ + apply (simp add: sublist_def) + apply (rule take_ext) + by auto + + +lemma lt_Suc: \(a < b) = (Suc a = b \ Suc a < b)\ + by auto + +lemma sublist_until_end_eq_drop: \Suc hi = length xs \ sublist xs lo hi = drop lo xs\ + by (simp add: sublist_def) + +lemma sublist_ext: + \(\i. lo\i\i\hi \ xs'!i=xs!i) \ + length xs' = length xs \ + lo \ hi \ hi < length xs \ + sublist xs' lo hi = sublist xs lo hi\ + apply (auto simp add: lt_Suc[where a=hi]) + subgoal by (auto simp add: sublist_until_end_eq_drop drop_ext) + subgoal by (auto simp add: sublist_ext') + done + +lemma sorted_wrt_lower_sublist_still_sorted: + assumes \sorted_sublist_wrt R xs lo (lo' - Suc 0)\ and + \lo \ lo'\ and \lo' < length xs\ and + \(\ i. lo\i\i xs'!i=xs!i)\ and \length xs' = length xs\ + shows \sorted_sublist_wrt R xs' lo (lo' - Suc 0)\ +proof - + have l: \lo < lo' - 1 \ lo \ lo'-1\ + by linarith + show ?thesis + using l apply auto + subgoal \ \lo < lo' - 1\ + apply (auto simp add: sorted_sublist_wrt_def) + apply (rewrite sublist_ext[where xs=xs]) + using assms by (auto simp add: sorted_sublist_wrt_def) + subgoal \ \lo >= lo' - 1\ + using assms by (auto simp add: sorted_sublist_wrt_le) + done +qed + +lemma sorted_map_lower_sublist_still_sorted: + assumes \sorted_sublist_map R h xs lo (lo' - Suc 0)\ and + \lo \ lo'\ and \lo' < length xs\ and + \(\ i. lo\i\i xs'!i=xs!i)\ and \length xs' = length xs\ + shows \sorted_sublist_map R h xs' lo (lo' - Suc 0)\ + using assms by (rule sorted_wrt_lower_sublist_still_sorted) + +lemma sorted_wrt_upper_sublist_still_sorted: + assumes \sorted_sublist_wrt R xs (hi'+1) hi\ and + \lo \ lo'\ and \hi < length xs\ and + \\ j. hi'j\hi \ xs'!j=xs!j\ and \length xs' = length xs\ + shows \sorted_sublist_wrt R xs' (hi'+1) hi\ +proof - + have l: \hi' + 1 < hi \ hi' + 1 \ hi\ + by linarith + show ?thesis + using l apply auto + subgoal \ \hi' + 1 < h\ + apply (auto simp add: sorted_sublist_wrt_def) + apply (rewrite sublist_ext[where xs=xs]) + using assms by (auto simp add: sorted_sublist_wrt_def) + subgoal \ \\<^term>\hi' + 1 \ hi\\ + using assms by (auto simp add: sorted_sublist_wrt_le) + done +qed + +lemma sorted_map_upper_sublist_still_sorted: + assumes \sorted_sublist_map R h xs (hi'+1) hi\ and + \lo \ lo'\ and \hi < length xs\ and + \\ j. hi'j\hi \ xs'!j=xs!j\ and \length xs' = length xs\ + shows \sorted_sublist_map R h xs' (hi'+1) hi\ + using assms by (rule sorted_wrt_upper_sublist_still_sorted) + + + + + + + +text \The specification of the partition function\ +definition partition_spec :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ 'a list \ nat \ bool\ where + \partition_spec R h xs lo hi xs' p \ + mset xs' = mset xs \ \ \The list is a permutation\ + isPartition_map R h xs' lo hi p \ \ \We have a valid partition on the resulting list\ + lo \ p \ p \ hi \ \ \The partition index is in bounds\ + (\ i. i xs'!i=xs!i) \ (\ i. hii xs'!i=xs!i)\ \ \Everything else is unchanged.\ + +lemma in_set_take_conv_nth: + \x \ set (take n xs) \ (\m + by (metis in_set_conv_nth length_take min.commute min.strict_boundedE nth_take) + +lemma mset_drop_upto: \mset (drop a N) = {#N!i. i \# mset_set {a.. +proof (induction N arbitrary: a) + case Nil + then show ?case by simp +next + case (Cons c N) + have upt: \{0.. + by auto + then have H: \mset_set {0.. + unfolding upt by auto + have mset_case_Suc: \{#case x of 0 \ c | Suc x \ N ! x . x \# mset_set {Suc a..# mset_set {Suc a.. for a b + by (rule image_mset_cong) (auto split: nat.splits) + have Suc_Suc: \{Suc a.. for a b + by auto + then have mset_set_Suc_Suc: \mset_set {Suc a..# mset_set {a.. for a b + unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto + have *: \{#N ! (x-Suc 0) . x \# mset_set {Suc a..# mset_set {a.. + for a b + by (auto simp add: mset_set_Suc_Suc multiset.map_comp comp_def) + show ?case + apply (cases a) + using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *) +qed + +(* Actually, I only need that \set (sublist xs' lo hi) = set (sublist xs lo hi)\ *) +lemma mathias: + assumes + Perm: \mset xs' = mset xs\ + and I: \lo\i\ \i\hi\ \xs'!i=x\ + and Bounds: \hi < length xs\ + and Fix: \\ i. i xs'!i = xs!i\ \\ j. \hi \ xs'!j = xs!j\ + shows \\j. lo\j\j\hi \ xs!j = x\ +proof - + define xs1 xs2 xs3 xs1' xs2' xs3' where + \xs1 = take lo xs\ and + \xs2 = take (Suc hi - lo) (drop lo xs)\ and + \xs3 = drop (Suc hi) xs\ and + \xs1' = take lo xs'\ and + \xs2' = take (Suc hi - lo) (drop lo xs')\ and + \xs3' = drop (Suc hi) xs'\ + have [simp]: \length xs' = length xs\ + using Perm by (auto dest: mset_eq_length) + have [simp]: \mset xs1 = mset xs1'\ + using Fix(1) unfolding xs1_def xs1'_def + by (metis Perm le_cases mset_eq_length nth_take_lemma take_all) + have [simp]: \mset xs3 = mset xs3'\ + using Fix(2) unfolding xs3_def xs3'_def mset_drop_upto + by (auto intro: image_mset_cong) + have \xs = xs1 @ xs2 @ xs3\ \xs' = xs1' @ xs2' @ xs3'\ + using I unfolding xs1_def xs2_def xs3_def xs1'_def xs2'_def xs3'_def + by (metis append.assoc append_take_drop_id le_SucI le_add_diff_inverse order_trans take_add)+ + moreover have \xs ! i = xs2 ! (i - lo)\ \i \ length xs1\ + using I Bounds unfolding xs2_def xs1_def by (auto simp: nth_take min_def) + moreover have \x \ set xs2'\ + using I Bounds unfolding xs2'_def + by (auto simp: in_set_take_conv_nth + intro!: exI[of _ \i - lo\]) + ultimately have \x \ set xs2\ + using Perm I by (auto dest: mset_eq_setD) + then obtain j where \xs ! (lo + j) = x\ \j \ hi - lo\ + unfolding in_set_conv_nth xs2_def + by auto + then show ?thesis + using Bounds I + by (auto intro: exI[of _ \lo+j\]) +qed + + +text \If we fix the left and right rest of two permutated lists, then the sublists are also permutations.\ +text \But we only need that the sets are equal.\ +lemma mset_sublist_incl: + assumes Perm: \mset xs' = mset xs\ + and Fix: \\ i. i xs'!i = xs!i\ \\ j. \hi \ xs'!j = xs!j\ + and bounds: \lo \ hi\ \hi < length xs\ + shows \set (sublist xs' lo hi) \ set (sublist xs lo hi)\ +proof + fix x + assume \x \ set (sublist xs' lo hi)\ + then have \\i. lo\i\i\hi \ xs'!i=x\ + by (metis assms(1) bounds(1) bounds(2) size_mset sublist_el') + then obtain i where I: \lo\i\ \i\hi\ \xs'!i=x\ by blast + have \\j. lo\j\j\hi \ xs!j=x\ + using Perm I bounds(2) Fix by (rule mathias, auto) + then show \x \ set (sublist xs lo hi)\ + by (simp add: bounds(1) bounds(2) sublist_el') +qed + + +lemma mset_sublist_eq: + assumes \mset xs' = mset xs\ + and \\ i. i xs'!i = xs!i\ + and \\ j. \hi \ xs'!j = xs!j\ + and bounds: \lo \ hi\ \hi < length xs\ + shows \set (sublist xs' lo hi) = set (sublist xs lo hi)\ +proof + show \set (sublist xs' lo hi) \ set (sublist xs lo hi)\ + apply (rule mset_sublist_incl) + using assms by auto + show \set (sublist xs lo hi) \ set (sublist xs' lo hi)\ + by (rule mset_sublist_incl) (metis assms size_mset)+ +qed + + + +text \Our abstract recursive quicksort procedure. We abstract over a partition procedure.\ +definition quicksort :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ 'a list nres\ where +\quicksort R h = (\(lo,hi,xs0). do { + RECT (\f (lo,hi,xs). do { + ASSERT(lo \ hi \ hi < length xs \ mset xs = mset xs0); \ \Premise for a partition function\ + (xs, p) \ SPEC(uncurry (partition_spec R h xs lo hi)); \ \Abstract partition function\ + ASSERT(mset xs = mset xs0); + xs \ (if p-1\lo then RETURN xs else f (lo, p-1, xs)); + ASSERT(mset xs = mset xs0); + if hi\p+1 then RETURN xs else f (p+1, hi, xs) + }) (lo,hi,xs0) + })\ + +text \As premise for quicksor, we only need that the indices are ok.\ +definition quicksort_pre :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ 'a list \ bool\ where + \quicksort_pre R h xs0 lo hi xs \ lo \ hi \ hi < length xs \ mset xs = mset xs0\ + +definition quicksort_post :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ 'a list \ bool\ where + \quicksort_post R h lo hi xs xs' \ + mset xs' = mset xs \ + sorted_sublist_map R h xs' lo hi \ + (\ i. i xs'!i = xs!i) \ + (\ j. hij xs'!j = xs!j)\ + +text \Convert Pure to HOL\ +lemma quicksort_postI: + \\mset xs' = mset xs; sorted_sublist_map R h xs' lo hi; (\ i. \i \ xs'!i = xs!i); (\ j. \hi \ xs'!j = xs!j)\ \ quicksort_post R h lo hi xs xs'\ + by (auto simp add: quicksort_post_def) + + +text \The first case for the correctness proof of (abstract) quicksort: We assume that we called the partition function, and we have \<^term>\p-1\lo\ and \<^term>\hi\p+1\.\ +lemma quicksort_correct_case1: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + and pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \p-1 \ lo\ \hi \ p+1\ + shows \quicksort_post R h lo hi xs xs'\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ + using pre by (auto simp add: quicksort_pre_def) +(* + have part_perm: \set (sublist xs' lo hi) = set (sublist xs lo hi)\ + using part partition_spec_set_sublist pre(1) pre(2) by blast +*) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + + + have sorted_lower: \sorted_sublist_map R h xs' lo (p - Suc 0)\ + proof - + show ?thesis + apply (rule sorted_sublist_wrt_le) + subgoal using ifs(1) by auto + subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce + done + qed + + have sorted_upper: \sorted_sublist_map R h xs' (Suc p) hi\ + proof - + show ?thesis + apply (rule sorted_sublist_wrt_le) + subgoal using ifs(2) by auto + subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce + done + qed + + have sorted_middle: \sorted_sublist_map R h xs' lo hi\ + proof - + show ?thesis + apply (rule merge_sorted_map_partitions[where p=p]) + subgoal by (rule trans) + subgoal by (rule part) + subgoal by (rule sorted_lower) + subgoal by (rule sorted_upper) + subgoal using pre(1) by auto + subgoal by (simp add: part(4)) + subgoal by (simp add: part(5)) + subgoal by (metis part(1) pre(2) size_mset) + done + qed + + show ?thesis + proof (intro quicksort_postI) + show \mset xs' = mset xs\ + by (simp add: part(1)) + next + show \sorted_sublist_map R h xs' lo hi\ + by (rule sorted_middle) + next + show \\i. i < lo \ xs' ! i = xs ! i\ + using part(6) by blast + next + show \\j. \hi < j; j < length xs\ \ xs' ! j = xs ! j\ + by (metis part(1) part(7) size_mset) + qed +qed + + +text \In the second case, we have to show that the precondition still holds for (p+1, hi, x') after the partition.\ +lemma quicksort_correct_case2: + assumes + pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \\ hi \ p + 1\ + shows \quicksort_pre R h xs0 (Suc p) hi xs'\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ \mset xs = mset xs0\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + show ?thesis + unfolding quicksort_pre_def + proof (intro conjI) + show \Suc p \ hi\ + using ifs by linarith + show \hi < length xs'\ + by (metis part(1) pre(2) size_mset) + show \mset xs' = mset xs0\ + using pre(3) part(1) by (auto dest: mset_eq_setD) + qed +qed + + + +lemma quicksort_post_set: + assumes \quicksort_post R h lo hi xs xs'\ + and bounds: \lo \ hi\ \hi < length xs\ + shows \set (sublist xs' lo hi) = set (sublist xs lo hi)\ +proof - + have \mset xs' = mset xs\ \\ i. i xs'!i = xs!i\ \\ j. \hi \ xs'!j = xs!j\ + using assms by (auto simp add: quicksort_post_def) + then show ?thesis + using bounds by (rule mset_sublist_eq, auto) +qed + + +text \In the third case, we have run quicksort recursively on (p+1, hi, xs') after the partition, with hi<=p+1 and p-1<=lo.\ +lemma quicksort_correct_case3: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + and pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \p - Suc 0 \ lo\ \\ hi \ Suc p\ + and IH1': \quicksort_post R h (Suc p) hi xs' xs''\ + shows \quicksort_post R h lo hi xs xs''\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ \mset xs = mset xs0\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + have IH1: \mset xs'' = mset xs'\ \sorted_sublist_map R h xs'' (Suc p) hi\ + \\ i. i xs'' ! i = xs' ! i\ \\ j. \hi < j; j < length xs'\ \ xs'' ! j = xs' ! j\ + using IH1' by (auto simp add: quicksort_post_def) + note IH1_perm = quicksort_post_set[OF IH1'] + + have still_partition: \isPartition_map R h xs'' lo hi p\ + proof(intro isPartition_wrtI) + fix i assume \lo \ i\ \i < p\ + show \R (h (xs'' ! i)) (h (xs'' ! p))\ + text \This holds because this part hasn't changed\ + using IH1(3) \i < p\ \lo \ i\ isPartition_wrt_def part(3) by fastforce + next + fix j assume \p < j\ \j \ hi\ + text \Obtain the position \<^term>\posJ\ where \<^term>\xs''!j\ was stored in \<^term>\xs'\.\ + have \xs''!j \ set (sublist xs'' (Suc p) hi)\ + by (metis IH1(1) Suc_leI \j \ hi\ \p < j\ less_le_trans mset_eq_length part(1) pre(2) sublist_el') + then have \xs''!j \ set (sublist xs' (Suc p) hi)\ + by (metis IH1_perm ifs(2) nat_le_linear part(1) pre(2) size_mset) + then have \\ posJ. Suc p\posJ\posJ\hi \ xs''!j = xs'!posJ\ + by (metis Suc_leI \j \ hi\ \p < j\ less_le_trans part(1) pre(2) size_mset sublist_el') + then obtain posJ :: nat where PosJ: \Suc p\posJ\ \posJ\hi\ \xs''!j = xs'!posJ\ by blast + + then show \R (h (xs'' ! p)) (h (xs'' ! j))\ + by (metis IH1(3) Suc_le_lessD isPartition_wrt_def lessI part(3)) + qed + + have sorted_lower: \sorted_sublist_map R h xs'' lo (p - Suc 0)\ + proof - + show ?thesis + apply (rule sorted_sublist_wrt_le) + subgoal by (simp add: ifs(1)) + subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce + done + qed + + note sorted_upper = IH1(2) + + have sorted_middle: \sorted_sublist_map R h xs'' lo hi\ + proof - + show ?thesis + apply (rule merge_sorted_map_partitions[where p=p]) + subgoal by (rule trans) + subgoal by (rule still_partition) + subgoal by (rule sorted_lower) + subgoal by (rule sorted_upper) + subgoal using pre(1) by auto + subgoal by (simp add: part(4)) + subgoal by (simp add: part(5)) + subgoal by (metis IH1(1) part(1) pre(2) size_mset) + done + qed + + + show ?thesis + proof (intro quicksort_postI) + show \mset xs'' = mset xs\ + using part(1) IH1(1) by auto \ \I was faster than sledgehammer :-)\ + next + show \sorted_sublist_map R h xs'' lo hi\ + by (rule sorted_middle) + next + show \\i. i < lo \ xs'' ! i = xs ! i\ + using IH1(3) le_SucI part(4) part(6) by auto + next show \\j. hi < j \ j < length xs \ xs'' ! j = xs ! j\ + by (metis IH1(4) part(1) part(7) size_mset) + qed +qed + + +text \In the 4th case, we have to show that the premise holds for \<^term>\(lo,p-1,xs')\, in case \<^term>\\p-1\lo\\ +text \Analogous to case 2.\ +lemma quicksort_correct_case4: + assumes + pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \\ p - Suc 0 \ lo \ + shows \quicksort_pre R h xs0 lo (p-Suc 0) xs'\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ \mset xs0 = mset xs\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + + show ?thesis + unfolding quicksort_pre_def + proof (intro conjI) + show \lo \ p - Suc 0\ + using ifs by linarith + show \p - Suc 0 < length xs'\ + using mset_eq_length part(1) part(5) pre(2) by fastforce + show \mset xs' = mset xs0\ + using pre(3) part(1) by (auto dest: mset_eq_setD) + qed +qed + + +text \In the 5th case, we have run quicksort recursively on (lo, p-1, xs').\ +lemma quicksort_correct_case5: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + and pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \\ p - Suc 0 \ lo\ \hi \ Suc p\ + and IH1': \quicksort_post R h lo (p - Suc 0) xs' xs''\ + shows \quicksort_post R h lo hi xs xs''\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + have IH1: \mset xs'' = mset xs'\ \sorted_sublist_map R h xs'' lo (p - Suc 0)\ + \\ i. i xs''!i = xs'!i\ \\ j. \p-Suc 0 \ xs''!j = xs'!j\ + using IH1' by (auto simp add: quicksort_post_def) + note IH1_perm = quicksort_post_set[OF IH1'] + + + have still_partition: \isPartition_map R h xs'' lo hi p\ + proof(intro isPartition_wrtI) + fix i assume \lo \ i\ \i < p\ + text \Obtain the position \<^term>\posI\ where \<^term>\xs''!i\ was stored in \<^term>\xs'\.\ + have \xs''!i \ set (sublist xs'' lo (p-Suc 0))\ + by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \i < p\ \lo \ i\ le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el') + then have \xs''!i \ set (sublist xs' lo (p-Suc 0))\ + by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2)) + then have \\ posI. lo\posI\posI\p-Suc 0 \ xs''!i = xs'!posI\ + proof - \ \sledgehammer\ + have "p - Suc 0 < length xs" + by (meson diff_le_self le_less_trans part(5) pre(2)) + then show ?thesis + by (metis (no_types) \xs'' ! i \ set (sublist xs' lo (p - Suc 0))\ ifs(1) mset_eq_length nat_le_linear part(1) sublist_el') + qed + then obtain posI :: nat where PosI: \lo\posI\ \posI\p-Suc 0\ \xs''!i = xs'!posI\ by blast + then show \R (h (xs'' ! i)) (h (xs'' ! p))\ + by (metis (no_types, lifting) IH1(4) \i < p\ diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc) + next + fix j assume \p < j\ \j \ hi\ + then show \R (h (xs'' ! p)) (h (xs'' ! j))\ + text \This holds because this part hasn't changed\ + by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2)) + qed + + + note sorted_lower = IH1(2) + + have sorted_upper: \sorted_sublist_map R h xs'' (Suc p) hi\ + proof - + show ?thesis + apply (rule sorted_sublist_wrt_le) + subgoal by (simp add: ifs(2)) + subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce + done + qed + + + have sorted_middle: \sorted_sublist_map R h xs'' lo hi\ + proof - + show ?thesis + apply (rule merge_sorted_map_partitions[where p=p]) + subgoal by (rule trans) + subgoal by (rule still_partition) + subgoal by (rule sorted_lower) + subgoal by (rule sorted_upper) + subgoal using pre(1) by auto + subgoal by (simp add: part(4)) + subgoal by (simp add: part(5)) + subgoal by (metis IH1(1) part(1) pre(2) size_mset) + done + qed + + + show ?thesis + proof (intro quicksort_postI) + show \mset xs'' = mset xs\ + by (simp add: IH1(1) part(1)) + next + show \sorted_sublist_map R h xs'' lo hi\ + by (rule sorted_middle) + next + show \\i. i < lo \ xs'' ! i = xs ! i\ + by (simp add: IH1(3) part(6)) + next + show \\j. hi < j \ j < length xs \ xs'' ! j = xs ! j\ + by (metis IH1(4) diff_le_self dual_order.strict_trans2 mset_eq_length part(1) part(5) part(7)) + qed +qed + + +text \In the 6th case, we have run quicksort recursively on (lo, p-1, xs'). We show the precondition on the second call on (p+1, hi, xs'')\ +lemma quicksort_correct_case6: + assumes + pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \\ p - Suc 0 \ lo\ \\ hi \ Suc p\ + and IH1: \quicksort_post R h lo (p - Suc 0) xs' xs''\ + shows \quicksort_pre R h xs0 (Suc p) hi xs''\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ \mset xs0 = mset xs\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + have IH1: \mset xs'' = mset xs'\ \sorted_sublist_map R h xs'' lo (p - Suc 0)\ + \\ i. i xs''!i = xs'!i\ \\ j. \p-Suc 0 \ xs''!j = xs'!j\ + using IH1 by (auto simp add: quicksort_post_def) + + show ?thesis + unfolding quicksort_pre_def + proof (intro conjI) + show \Suc p \ hi\ + using ifs(2) by linarith + show \hi < length xs''\ + using IH1(1) mset_eq_length part(1) pre(2) by fastforce + show \mset xs'' = mset xs0\ + using pre(3) part(1) IH1(1) by (auto dest: mset_eq_setD) + qed +qed + + +text \In the 7th (and last) case, we have run quicksort recursively on (lo, p-1, xs'). We show the postcondition on the second call on (p+1, hi, xs'')\ +lemma quicksort_correct_case7: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + and pre: \quicksort_pre R h xs0 lo hi xs\ + and part: \partition_spec R h xs lo hi xs' p\ + and ifs: \\ p - Suc 0 \ lo\ \\ hi \ Suc p\ + and IH1': \quicksort_post R h lo (p - Suc 0) xs' xs''\ + and IH2': \quicksort_post R h (Suc p) hi xs'' xs'''\ + shows \quicksort_post R h lo hi xs xs'''\ +proof - + text \First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\ + have pre: \lo \ hi\ \hi < length xs\ + using pre by (auto simp add: quicksort_pre_def) + have part: \mset xs' = mset xs\ True + \isPartition_map R h xs' lo hi p\ \lo \ p\ \p \ hi\ + \\ i. i xs'!i=xs!i\ \\ i. \hi \ xs'!i=xs!i\ + using part by (auto simp add: partition_spec_def) + have IH1: \mset xs'' = mset xs'\ \sorted_sublist_map R h xs'' lo (p - Suc 0)\ + \\ i. i xs''!i = xs'!i\ \\ j. \p-Suc 0 \ xs''!j = xs'!j\ + using IH1' by (auto simp add: quicksort_post_def) + note IH1_perm = quicksort_post_set[OF IH1'] + have IH2: \mset xs''' = mset xs''\ \sorted_sublist_map R h xs''' (Suc p) hi\ + \\ i. i xs'''!i = xs''!i\ \\ j. \hi \ xs'''!j = xs''!j\ + using IH2' by (auto simp add: quicksort_post_def) + note IH2_perm = quicksort_post_set[OF IH2'] + + + text \We still have a partition after the first call (same as in case 5)\ + have still_partition1: \isPartition_map R h xs'' lo hi p\ + proof(intro isPartition_wrtI) + fix i assume \lo \ i\ \i < p\ + text \Obtain the position \<^term>\posI\ where \<^term>\xs''!i\ was stored in \<^term>\xs'\.\ + have \xs''!i \ set (sublist xs'' lo (p-Suc 0))\ + by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \i < p\ \lo \ i\ le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el') + then have \xs''!i \ set (sublist xs' lo (p-Suc 0))\ + by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2)) + then have \\ posI. lo\posI\posI\p-Suc 0 \ xs''!i = xs'!posI\ + proof - \ \sledgehammer\ + have "p - Suc 0 < length xs" + by (meson diff_le_self le_less_trans part(5) pre(2)) + then show ?thesis + by (metis (no_types) \xs'' ! i \ set (sublist xs' lo (p - Suc 0))\ ifs(1) mset_eq_length nat_le_linear part(1) sublist_el') + qed + then obtain posI :: nat where PosI: \lo\posI\ \posI\p-Suc 0\ \xs''!i = xs'!posI\ by blast + then show \R (h (xs'' ! i)) (h (xs'' ! p))\ + by (metis (no_types, lifting) IH1(4) \i < p\ diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc) + next + fix j assume \p < j\ \j \ hi\ + then show \R (h (xs'' ! p)) (h (xs'' ! j))\ + text \This holds because this part hasn't changed\ + by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2)) + qed + + + text \We still have a partition after the second call (similar as in case 3)\ + have still_partition2: \isPartition_map R h xs''' lo hi p\ + proof(intro isPartition_wrtI) + fix i assume \lo \ i\ \i < p\ + show \R (h (xs''' ! i)) (h (xs''' ! p))\ + text \This holds because this part hasn't changed\ + using IH2(3) \i < p\ \lo \ i\ isPartition_wrt_def still_partition1 by fastforce + next + fix j assume \p < j\ \j \ hi\ + text \Obtain the position \<^term>\posJ\ where \<^term>\xs'''!j\ was stored in \<^term>\xs'''\.\ + have \xs'''!j \ set (sublist xs''' (Suc p) hi)\ + by (metis IH1(1) IH2(1) Suc_leI \j \ hi\ \p < j\ ifs(2) nat_le_linear part(1) pre(2) size_mset sublist_el') + then have \xs'''!j \ set (sublist xs'' (Suc p) hi)\ + by (metis IH1(1) IH2_perm ifs(2) mset_eq_length nat_le_linear part(1) pre(2)) + then have \\ posJ. Suc p\posJ\posJ\hi \ xs'''!j = xs''!posJ\ + by (metis IH1(1) ifs(2) mset_eq_length nat_le_linear part(1) pre(2) sublist_el') + then obtain posJ :: nat where PosJ: \Suc p\posJ\ \posJ\hi\ \xs'''!j = xs''!posJ\ by blast + + then show \R (h (xs''' ! p)) (h (xs''' ! j))\ + proof - \ \sledgehammer\ + have "\n na as p. (p (as ! na::'a) (as ! posJ) \ posJ \ na) \ \ isPartition_wrt p as n hi na" + by (metis (no_types) PosJ(2) isPartition_wrt_def not_less) + then show ?thesis + by (metis IH2(3) PosJ(1) PosJ(3) lessI not_less_eq_eq still_partition1) + qed + qed + + + text \We have that the lower part is sorted after the first recursive call\ + note sorted_lower1 = IH1(2) + + text \We show that it is still sorted after the second call.\ + have sorted_lower2: \sorted_sublist_map R h xs''' lo (p-Suc 0)\ + proof - + show ?thesis + using sorted_lower1 apply (rule sorted_wrt_lower_sublist_still_sorted) + subgoal by (rule part) + subgoal + using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce + subgoal + by (simp add: IH2(3)) + subgoal + by (metis IH2(1) size_mset) + done + qed + + text \The second IH gives us the the upper list is sorted after the second recursive call\ + note sorted_upper2 = IH2(2) + + text \Finally, we have to show that the entire list is sorted after the second recursive call.\ + have sorted_middle: \sorted_sublist_map R h xs''' lo hi\ + proof - + show ?thesis + apply (rule merge_sorted_map_partitions[where p=p]) + subgoal by (rule trans) + subgoal by (rule still_partition2) + subgoal by (rule sorted_lower2) + subgoal by (rule sorted_upper2) + subgoal using pre(1) by auto + subgoal by (simp add: part(4)) + subgoal by (simp add: part(5)) + subgoal by (metis IH1(1) IH2(1) part(1) pre(2) size_mset) + done + qed + + show ?thesis + proof (intro quicksort_postI) + show \mset xs''' = mset xs\ + by (simp add: IH1(1) IH2(1) part(1)) + next + show \sorted_sublist_map R h xs''' lo hi\ + by (rule sorted_middle) + next + show \\i. i < lo \ xs''' ! i = xs ! i\ + using IH1(3) IH2(3) part(4) part(6) by auto + next + show \\j. hi < j \ j < length xs \ xs''' ! j = xs ! j\ + by (metis IH1(1) IH1(4) IH2(4) diff_le_self ifs(2) le_SucI less_le_trans nat_le_eq_or_lt not_less part(1) part(7) size_mset) + qed + +qed + + + +text \We can now show the correctness of the abstract quicksort procedure, using the refinement framework and the above case lemmas.\ +lemma quicksort_correct: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + and Pre: \lo0 \ hi0\ \hi0 < length xs0\ + shows \quicksort R h (lo0,hi0,xs0) \ \ Id (SPEC(\xs. quicksort_post R h lo0 hi0 xs0 xs))\ +proof - + have wf: \wf (measure (\(lo, hi, xs). Suc hi - lo))\ + by auto + define pre where \pre = (\(lo,hi,xs). quicksort_pre R h xs0 lo hi xs)\ + define post where \post = (\(lo,hi,xs). quicksort_post R h lo hi xs)\ + have pre: \pre (lo0,hi0,xs0)\ + unfolding quicksort_pre_def pre_def by (simp add: Pre) + + text \We first generalize the goal a over all states.\ + have \WB_Sort.quicksort R h (lo0,hi0,xs0) \ \ Id (SPEC (post (lo0,hi0,xs0)))\ + unfolding quicksort_def prod.case + apply (rule RECT_rule) + apply (refine_mono) + apply (rule wf) + apply (rule pre) + subgoal premises IH for f x + apply (refine_vcg ASSERT_leI) + unfolding pre_def post_def + + subgoal \ \First premise (assertion) for partition\ + using IH(2) by (simp add: quicksort_pre_def pre_def) + subgoal \ \Second premise (assertion) for partition\ + using IH(2) by (simp add: quicksort_pre_def pre_def) + subgoal + using IH(2) by (auto simp add: quicksort_pre_def pre_def dest: mset_eq_setD) + + text \Termination case: \<^term>\(p-1 \ lo')\ and \<^term>\(hi' \ p+1)\; directly show postcondition\ + subgoal unfolding partition_spec_def by (auto dest: mset_eq_setD) + subgoal \ \Postcondition (after partition)\ + apply - + using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits) + using trans lin apply (rule quicksort_correct_case1) by auto + + text \Case \<^term>\(p-1 \ lo')\ and \<^term>\(hi' < p+1)\ (Only second recursive call)\ + subgoal + apply (rule IH(1)[THEN order_trans]) + + text \Show that the invariant holds for the second recursive call\ + subgoal + using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits) + apply (rule quicksort_correct_case2) by auto + + text \Wellfoundness (easy)\ + subgoal by (auto simp add: quicksort_pre_def partition_spec_def) + + text \Show that the postcondition holds\ + subgoal + apply (simp add: Misc.subset_Collect_conv post_def, intro allI impI, elim conjE) + using trans lin apply (rule quicksort_correct_case3) + using IH(2) unfolding pre_def by auto + done + + text \Case: At least the first recursive call\ + subgoal + apply (rule IH(1)[THEN order_trans]) + + text \Show that the precondition holds for the first recursive call\ + subgoal + using IH(2) unfolding pre_def post_def apply (simp, elim conjE, split prod.splits) apply auto + apply (rule quicksort_correct_case4) by auto + + text \Wellfoundness for first recursive call (easy)\ + subgoal by (auto simp add: quicksort_pre_def partition_spec_def) + + text \Simplify some refinement suff...\ + apply (simp add: Misc.subset_Collect_conv ASSERT_leI, intro allI impI conjI, elim conjE) + apply (rule ASSERT_leI) + apply (simp_all add: Misc.subset_Collect_conv ASSERT_leI) + subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD) + text \Only the first recursive call: show postcondition\ + subgoal + using trans lin apply (rule quicksort_correct_case5) + using IH(2) unfolding pre_def post_def by auto + + apply (rule ASSERT_leI) + subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD) + + text \Both recursive calls.\ + subgoal + apply (rule IH(1)[THEN order_trans]) + + text \Show precondition for second recursive call (after the first call)\ + subgoal + unfolding pre_def post_def + apply auto + apply (rule quicksort_correct_case6) + using IH(2) unfolding pre_def post_def by auto + + text \Wellfoundedness for second recursive call (easy)\ + subgoal by (auto simp add: quicksort_pre_def partition_spec_def) + + text \Show that the postcondition holds (after both recursive calls)\ + subgoal + apply (simp add: Misc.subset_Collect_conv, intro allI impI, elim conjE) + using trans lin apply (rule quicksort_correct_case7) + using IH(2) unfolding pre_def post_def by auto + done + done + done + done + + text \Finally, apply the generalized lemma to show the thesis.\ + then show ?thesis unfolding post_def by auto +qed + + + +(* TODO: Show that our (abstract) partition satisifies the specification *) + + +definition partition_main_inv :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ (nat\nat\'a list) \ bool\ where + \partition_main_inv R h lo hi xs0 p \ + case p of (i,j,xs) \ + j < length xs \ j \ hi \ i < length xs \ lo \ i \ i \ j \ mset xs = mset xs0 \ + (\k. k \ lo \ k < i \ R (h (xs!k)) (h (xs!hi))) \ \ \All elements from \<^term>\lo\ to \<^term>\i-1\ are smaller than the pivot\ + (\k. k \ i \ k < j \ R (h (xs!hi)) (h (xs!k))) \ \ \All elements from \<^term>\i\ to \<^term>\j-1\ are greater than the pivot\ + (\k. k < lo \ xs!k = xs0!k) \ \ \Everything below \<^term>\lo\ is unchanged\ + (\k. k \ j \ k < length xs \ xs!k = xs0!k) \ \All elements from \<^term>\j\ are unchanged (including everyting above \<^term>\hi\)\ + \ + +text \The main part of the partition function. The pivot is assumed to be the last element. This is +exactly the "Lomuto partition scheme" partition function from Wikipedia.\ +definition partition_main :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ ('a list \ nat) nres\ where + \partition_main R h lo hi xs0 = do { + ASSERT(hi < length xs0); + pivot \ RETURN (h (xs0 ! hi)); + (i,j,xs) \ WHILE\<^sub>T\<^bsup>partition_main_inv R h lo hi xs0\<^esup> \ \We loop from \<^term>\j=lo\ to \<^term>\j=hi-1\.\ + (\(i,j,xs). j < hi) + (\(i,j,xs). do { + ASSERT(i < length xs \ j < length xs); + if R (h (xs!j)) pivot + then RETURN (i+1, j+1, swap xs i j) + else RETURN (i, j+1, xs) + }) + (lo, lo, xs0); \ \i and j are both initialized to lo\ + ASSERT(i < length xs \ j = hi \ lo \ i \ hi < length xs \ mset xs = mset xs0); + RETURN (swap xs i hi, i) + }\ + +(* +definition partition_spec :: \('b \ 'b \ bool) \ ('a \ 'b) \ 'a list \ nat \ nat \ 'a list \ nat \ bool\ where + \partition_spec R h xs lo hi xs' p \ + mset xs' = mset xs \ \ \The list is a permutation\ + isPartition_map R h xs' lo hi p \ \ \We have a valid partition on the resulting list\ + lo \ p \ p \ hi \ \ \The partition index is in bounds\ + (\ i. i xs'!i=xs!i) \ (\ i. hii xs'!i=xs!i)\ \ \Everything else is unchanged.\ +*) + +lemma partition_main_correct: + assumes bounds: \hi < length xs\ \lo \ hi\ and + trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. R (h x) (h y) \ R (h y) (h x)\ + shows \partition_main R h lo hi xs \ SPEC(\(xs', p). mset xs = mset xs' \ + lo \ p \ p \ hi \ isPartition_map R h xs' lo hi p \ (\ i. i xs'!i=xs!i) \ (\ i. hii xs'!i=xs!i))\ +proof - + have K: \b \ hi - Suc n \ n > 0 \ Suc n \ hi \ Suc b \ hi - n\ for b hi n + by auto + have L: \~ R (h x) (h y) \ R (h y) (h x)\ for x y \ \Corollary of linearity\ + using assms by blast + have M: \a < Suc b \ a = b \ a < b\ for a b + by linarith + have N: \(a::nat) \ b \ a = b \ a < b\ for a b + by arith + + show ?thesis + unfolding partition_main_def choose_pivot_def + apply (refine_vcg WHILEIT_rule[where R = \measure(\(i,j,xs). hi-j)\]) + subgoal using assms by blast \ \We feed our assumption to the assertion\ + subgoal by auto \ \WF\ + subgoal \ \Invariant holds before the first iteration\ + unfolding partition_main_inv_def + using assms apply simp by linarith + subgoal unfolding partition_main_inv_def by simp + subgoal unfolding partition_main_inv_def by simp + subgoal + unfolding partition_main_inv_def + apply (auto dest: mset_eq_length) + done + subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length) + subgoal + unfolding partition_main_inv_def apply (auto dest: mset_eq_length) + by (metis L M mset_eq_length nat_le_eq_or_lt) + + subgoal unfolding partition_main_inv_def by simp \ \assertions, etc\ + subgoal unfolding partition_main_inv_def by simp + subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length) + subgoal unfolding partition_main_inv_def by simp + subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length) + subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length) + subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length) + subgoal unfolding partition_main_inv_def by simp + subgoal unfolding partition_main_inv_def by simp + + subgoal \ \After the last iteration, we have a partitioning! :-)\ + unfolding partition_main_inv_def by (auto simp add: isPartition_wrt_def) + subgoal \ \And the lower out-of-bounds parts of the list haven't been changed\ + unfolding partition_main_inv_def by auto + subgoal \ \And the upper out-of-bounds parts of the list haven't been changed\ + unfolding partition_main_inv_def by auto + done +qed + + +definition partition_between :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ ('a list \ nat) nres\ where + \partition_between R h lo hi xs0 = do { + ASSERT(hi < length xs0 \ lo \ hi); + k \ choose_pivot R h xs0 lo hi; \ \choice of pivot\ + ASSERT(k < length xs0); + xs \ RETURN (swap xs0 k hi); \ \move the pivot to the last position, before we start the actual loop\ + ASSERT(length xs = length xs0); + partition_main R h lo hi xs + }\ + + +lemma partition_between_correct: + assumes \hi < length xs\ and \lo \ hi\ and + \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and \\x y. R (h x) (h y) \ R (h y) (h x)\ + shows \partition_between R h lo hi xs \ SPEC(uncurry (partition_spec R h xs lo hi))\ +proof - + have K: \b \ hi - Suc n \ n > 0 \ Suc n \ hi \ Suc b \ hi - n\ for b hi n + by auto + show ?thesis + unfolding partition_between_def choose_pivot_def + apply (refine_vcg partition_main_correct) + using assms apply (auto dest: mset_eq_length simp add: partition_spec_def) + by (metis dual_order.strict_trans2 less_imp_not_eq2 mset_eq_length swap_nth) +qed + + + +text \We use the median of the first, the middle, and the last element.\ +definition choose_pivot3 where + \choose_pivot3 R h xs lo (hi::nat) = do { + ASSERT(lo < length xs); + ASSERT(hi < length xs); + let k' = (hi - lo) div 2; + let k = lo + k'; + ASSERT(k < length xs); + let start = h (xs ! lo); + let mid = h (xs ! k); + let end = h (xs ! hi); + if (R start mid \ R mid end) \ (R end mid \ R mid start) then RETURN k + else if (R start end \ R end mid) \ (R mid end \ R end start) then RETURN hi + else RETURN lo +}\ + +\ \We only have to show that this procedure yields a valid index between \lo\ and \hi\.\ +lemma choose_pivot3_choose_pivot: + assumes \lo < length xs\ \hi < length xs\ \hi \ lo\ + shows \choose_pivot3 R h xs lo hi \ \ Id (choose_pivot R h xs lo hi)\ + unfolding choose_pivot3_def choose_pivot_def + using assms by (auto intro!: ASSERT_leI simp: Let_def) + +text \The refined partion function: We use the above pivot function and fold instead of non-deterministic iteration.\ +definition partition_between_ref + :: \('b \ 'b \ bool) \ ('a \ 'b) \ nat \ nat \ 'a list \ ('a list \ nat) nres\ +where + \partition_between_ref R h lo hi xs0 = do { + ASSERT(hi < length xs0 \ hi < length xs0 \ lo \ hi); + k \ choose_pivot3 R h xs0 lo hi; \ \choice of pivot\ + ASSERT(k < length xs0); + xs \ RETURN (swap xs0 k hi); \ \move the pivot to the last position, before we start the actual loop\ + ASSERT(length xs = length xs0); + partition_main R h lo hi xs + }\ + + +lemma partition_main_ref': + \partition_main R h lo hi xs + \ \ ((\ a b c d. Id) a b c d) (partition_main R h lo hi xs)\ + by auto + + +(*TODO already exists somewhere*) +lemma Down_id_eq: + \\Id x = x\ + by auto + +lemma partition_between_ref_partition_between: + \partition_between_ref R h lo hi xs \ (partition_between R h lo hi xs)\ +proof - + have swap: \(swap xs k hi, swap xs ka hi) \ Id\ if \k = ka\ + for k ka + using that by auto + have [refine0]: \(h (xsa ! hi), h (xsaa ! hi)) \ Id\ + if \(xsa, xsaa) \ Id\ + for xsa xsaa + using that by auto + + show ?thesis + apply (subst (2) Down_id_eq[symmetric]) + unfolding partition_between_ref_def + partition_between_def + OP_def + apply (refine_vcg choose_pivot3_choose_pivot swap partition_main_correct) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + by (auto intro: Refine_Basic.Id_refine dest: mset_eq_length) +qed + +text \Technical lemma for sepref\ + +lemma partition_between_ref_partition_between': + \(uncurry2 (partition_between_ref R h), uncurry2 (partition_between R h)) \ + (nat_rel \\<^sub>r nat_rel) \\<^sub>r \Id\list_rel \\<^sub>f \\Id\list_rel \\<^sub>r nat_rel\nres_rel\ + by (intro frefI nres_relI) + (auto intro: partition_between_ref_partition_between) + +text \Example instantiation for pivot\ +definition choose_pivot3_impl where + \choose_pivot3_impl = choose_pivot3 (\) id\ + + +lemma partition_between_ref_correct: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. R (h x) (h y) \ R (h y) (h x)\ + and bounds: \hi < length xs\ \lo \ hi\ + shows \partition_between_ref R h lo hi xs \ SPEC (uncurry (partition_spec R h xs lo hi))\ +proof - + show ?thesis + apply (rule partition_between_ref_partition_between[THEN order_trans]) + using bounds apply (rule partition_between_correct[where h=h]) + subgoal by (rule trans) + subgoal by (rule lin) + done +qed + + +text \Refined quicksort algorithm: We use the refined partition function.\ +definition quicksort_ref :: \_ \ _ \ nat \ nat \ 'a list \ 'a list nres\ where +\quicksort_ref R h = (\(lo,hi,xs0). + do { + RECT (\f (lo,hi,xs). do { + ASSERT(lo \ hi \ hi < length xs0 \ mset xs = mset xs0); + (xs, p) \ partition_between_ref R h lo hi xs; \ \This is the refined partition function. Note that we need the premises (trans,lin,bounds) here.\ + ASSERT(mset xs = mset xs0 \ p \ lo \ p < length xs0); + xs \ (if p-1\lo then RETURN xs else f (lo, p-1, xs)); + ASSERT(mset xs = mset xs0); + if hi\p+1 then RETURN xs else f (p+1, hi, xs) + }) (lo,hi,xs0) + })\ + + +(*TODO share*) +lemma fref_to_Down_curry2: + \(uncurry2 f, uncurry2 g) \ [P]\<^sub>f A \ \B\nres_rel \ + (\x x' y y' z z'. P ((x', y'), z') \ (((x, y), z), ((x', y'), z')) \ A\ + f x y z \ \ B (g x' y' z'))\ + unfolding fref_def uncurry_def nres_rel_def + by auto + +lemma fref_to_Down_curry: + \(f, g) \ [P]\<^sub>f A \ \B\nres_rel \ + (\x x' . P x' \ (x, x') \ A\ + f x \ \ B (g x'))\ + unfolding fref_def uncurry_def nres_rel_def + by auto + + + +lemma quicksort_ref_quicksort: + assumes bounds: \hi < length xs\ \lo \ hi\ and + trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. R (h x) (h y) \ R (h y) (h x)\ + shows \quicksort_ref R h x0 \ \ Id (quicksort R h x0)\ +proof - + have wf: \wf (measure (\(lo, hi, xs). Suc hi - lo))\ + by auto + have pre: \x0 = x0' \ (x0, x0') \ Id \\<^sub>r Id \\<^sub>r \Id\list_rel\ for x0 x0' :: \nat \ nat \ 'b list\ + by auto + have [refine0]: \(x1e = x1d) \ (x1e,x1d) \ Id\ for x1e x1d :: \'b list\ + by auto + + show ?thesis + unfolding quicksort_def quicksort_ref_def + apply (refine_vcg pre partition_between_ref_partition_between'[THEN fref_to_Down_curry2]) + + text \First assertion (premise for partition)\ + subgoal + by auto + text \First assertion (premise for partition)\ + subgoal + by auto + subgoal + by (auto dest: mset_eq_length) + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + + text \Correctness of the concrete partition function\ + subgoal + apply (simp, rule partition_between_ref_correct) + subgoal by (rule trans) + subgoal by (rule lin) + subgoal by auto \ \first premise\ + subgoal by auto \ \second premise\ + done + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + subgoal by (auto simp: partition_spec_def isPartition_wrt_def) + subgoal by (auto simp: partition_spec_def isPartition_wrt_def dest: mset_eq_length) + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + subgoal + by (auto dest: mset_eq_length mset_eq_setD) + + by simp+ +qed + +\ \Sort the entire list\ +definition full_quicksort where + \full_quicksort R h xs \ if xs = [] then RETURN xs else quicksort R h (0, length xs - 1, xs)\ + +definition full_quicksort_ref where + \full_quicksort_ref R h xs \ + if List.null xs then RETURN xs + else quicksort_ref R h (0, length xs - 1, xs)\ + +definition full_quicksort_impl :: \nat list \ nat list nres\ where + \full_quicksort_impl xs = full_quicksort_ref (\) id xs\ + +lemma full_quicksort_ref_full_quicksort: + assumes trans: \\ x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. R (h x) (h y) \ R (h y) (h x)\ + shows \(full_quicksort_ref R h, full_quicksort R h) \ + \Id\list_rel \\<^sub>f \ \Id\list_rel\nres_rel\ +proof - + show ?thesis + unfolding full_quicksort_ref_def full_quicksort_def + apply (intro frefI nres_relI) + apply (auto intro!: quicksort_ref_quicksort[unfolded Down_id_eq] simp: List.null_def) + subgoal by (rule trans) + subgoal using lin by blast + done +qed + + +lemma sublist_entire: + \sublist xs 0 (length xs - 1) = xs\ + by (simp add: sublist_def) + + +lemma sorted_sublist_wrt_entire: + assumes \sorted_sublist_wrt R xs 0 (length xs - 1)\ + shows \sorted_wrt R xs\ +proof - + have \sorted_wrt R (sublist xs 0 (length xs - 1))\ + using assms by (simp add: sorted_sublist_wrt_def ) + then show ?thesis + by (metis sublist_entire) +qed + +lemma sorted_sublist_map_entire: + assumes \sorted_sublist_map R h xs 0 (length xs - 1)\ + shows \sorted_wrt (\ x y. R (h x) (h y)) xs\ +proof - + show ?thesis + using assms by (rule sorted_sublist_wrt_entire) +qed + + +text \Final correctness lemma\ +theorem full_quicksort_correct_sorted: + assumes + trans: \\x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and lin: \\x y. x \ y \ R (h x) (h y) \ R (h y) (h x)\ + shows \full_quicksort R h xs \ \ Id (SPEC(\xs'. mset xs' = mset xs \ sorted_wrt (\ x y. R (h x) (h y)) xs'))\ +proof - + show ?thesis + unfolding full_quicksort_def + apply (refine_vcg) + subgoal by simp \ \case xs=[]\ + subgoal by simp \ \case xs=[]\ + + apply (rule quicksort_correct[THEN order_trans]) + subgoal by (rule trans) + subgoal by (rule lin) + subgoal by linarith + subgoal by simp + + apply (simp add: Misc.subset_Collect_conv, intro allI impI conjI) + subgoal + by (auto simp add: quicksort_post_def) + subgoal + apply (rule sorted_sublist_map_entire) + by (auto simp add: quicksort_post_def dest: mset_eq_length) + done +qed + +lemma full_quicksort_correct: + assumes + trans: \\x y z. \R (h x) (h y); R (h y) (h z)\ \ R (h x) (h z)\ and + lin: \\x y. R (h x) (h y) \ R (h y) (h x)\ + shows \full_quicksort R h xs \ \ Id (SPEC(\xs'. mset xs' = mset xs))\ + by (rule order_trans[OF full_quicksort_correct_sorted]) + (use assms in auto) + +end diff --git a/thys/PAC_Checker/code/parser.sml b/thys/PAC_Checker/code/parser.sml new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/code/parser.sml @@ -0,0 +1,396 @@ +structure PAC_Parser = +struct +(* +fun hashList hashA l = + case l + of nil => 0wx0 + | [a] => 0w1 + hashA a + | a1::a2::_ => 0w2 + 0w3853 * hashA a1 + 0wx1327 * hashA a2 +val hashChar = Word.fromInt o ord + +fun hashString s = + let val res = ref 0wx0; + val i = ref 0; + in + while !i < String.size s + do + (res := !res + hashChar (String.sub(s,!i)); + res := !res * 0wx3853; + i := !i+1); + !res + end + + +val hash : (string list, string list) HashTable.t ref = ref (HashTable.new {hash = hashList hashString, equals = op=}); +val hashvar : (string, string) HashTable.t ref = ref (HashTable.new {hash = hashString, equals = op=}); +val num_vars = ref 0; + +fun share_var t = + case HashTable.peek (!hashvar, t) of + SOME t => t + | NONE => + let val new = Int.toString (!num_vars) in + (num_vars := 1 + !num_vars; + ignore (HashTable.insertIfNew(!hashvar, t, fn () => new, ignore)); + new) + end + + +fun share_term t = + case HashTable.peek (!hash, t) of + SOME t => t + | NONE => + (case t of + [] => [] + | x :: xs => + (let + val xs' = share_term xs; + val x = share_var x; + in + ignore (HashTable.insertIfNew(!hash, t, fn () => x::xs, ignore)); + x :: xs' + end + )); + + +val share_term = map share_var; +*) + +val share_var = fn x => x +val share_term = fn x => x; + + +exception Parser_Error of string + + fun is_digit c = c >= #"0" andalso c <= #"9"; + fun is_zero c = (c = #"0"); + fun digit_of_char c = Char.ord c - Char.ord #"0"; + + fun is_alpha c = + c >= #"a" andalso c <= #"z" + orelse c >= #"A" andalso c <= #"Z"; + + fun is_space c = + c = #" " orelse c = #"\t" orelse c = #"\n" orelse c = #"\r"; + + fun is_separator c = + c = #"*" orelse c = #"," orelse c = #";" orelse c = #"+" orelse c = #"-"; + + fun print2 a = (); + fun rev2 a = rev a; + + fun skip_spaces istream = + (print2 "skip space"; + if TextIO.lookahead(istream) = SOME #" " + then (TextIO.input1(istream); skip_spaces istream) + else ()) + + + (* string_num is a very imperative to do the parser. We use is for 'string' until we need real + 'strings'. Once we need them (to convert them to a number), we convert them via slices. + + Compared to a string, it could also avoid allocating memory, although that does not seem to + happen. + *) + val resizable_str = ref (ArraySlice.slice(Array.tabulate (10, fn _ => #" "), 0, NONE)); + fun double_string_size () = + let + fun new_val c = if c >= ArraySlice.length (!resizable_str) then #" " else ArraySlice.sub(!resizable_str, c) + val c = ArraySlice.slice(Array.tabulate(2*ArraySlice.length (!resizable_str), new_val),0,NONE) + in + resizable_str := c + end + fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.subslice (arr, s, l)) + fun parse_natural istream = + let + val _ = print2 "parse_number\n" + val i = ref (0); + val seen_one_digit = ref false; + fun parse_aux () = + let val c = TextIO.lookahead istream + in + if (is_space (valOf c) orelse is_separator (valOf c) orelse not (is_digit (valOf c))) + then (print2 ("number sep = '" ^ String.implode [(valOf c)] ^"'")) + else + case TextIO.input1(istream) of + NONE => raise Parser_Error "no number found" + | SOME c => + ( (*print2 (String.implode [c] ^ " to be put at position" ^ Int.toString (!i));*) + seen_one_digit := true; + if !i < ArraySlice.length (!resizable_str) - 1 + then () else double_string_size (); + ArraySlice.update(!resizable_str, !i, c); + i := !i + 1; + parse_aux ()) + end + in + (parse_aux (); + if !seen_one_digit = false + then raise Parser_Error ("no number digit") + else + (print2 (extract(!resizable_str, 0, SOME (!i)) ^"\n"); + (valOf (IntInf.fromString ((extract(!resizable_str, 0, SOME (!i)))))))) + end + + fun parse_nat istream = + let + val _ = print2 "parse_nat\n" + val num = ref 0; + val seen_one_digit = ref false; + fun parse_aux () = + let val c = TextIO.lookahead istream + in + if (is_space (valOf c) orelse is_separator (valOf c)) + then (print2 ("number sep = '" ^ String.implode [(valOf c)] ^ "'")) + else + case TextIO.input1(istream) of + NONE => raise Parser_Error "no number found" + | SOME c => + if is_digit c + then (seen_one_digit := true; + num := !num* 10 + digit_of_char c; + parse_aux ()) + else raise Parser_Error ("no number found, found " ^ String.implode [c]) + end + in + (parse_aux (); + if !seen_one_digit = false + then raise Parser_Error ("no number digit") + else Uint64.fromInt (IntInf.fromInt(!num))) + end + + fun parse_var istream = + let + val _ = print2 "parse_var\n" + val i = ref 0; + fun parse_aux () = + let val c = TextIO.lookahead istream + in + if (is_space (valOf c) orelse is_separator (valOf c)) + then (print2 ("var sep = '" ^ String.implode [(valOf c)] ^ "'")) + else + case TextIO.input1(istream) of + NONE => raise Parser_Error "no char found" + | SOME c => + (if !i < ArraySlice.length (!resizable_str) - 1 + then () else double_string_size (); + ArraySlice.update(!resizable_str, !i, c); + i := !i + 1; + parse_aux ()) + end + in + (parse_aux (); + if !i = 0 + then raise Parser_Error "no variable found" + else + (print2 (extract(!resizable_str, 0, SOME (!i))); + (extract(!resizable_str, 0, SOME (!i))))) + end; + + fun parse_vars_only_monom istream = (* can start with /*/ *) + let + val _ = print2 "parse_vars_only_monom\n" + val vars = ref []; + fun parse_aux () = + let + val _ = skip_spaces istream; + in + if TextIO.lookahead(istream) = SOME #"," orelse TextIO.lookahead(istream) = SOME #";" + orelse TextIO.lookahead(istream) = SOME #"-" orelse TextIO.lookahead(istream) = SOME #"+" + then (print2 ("parse_vars_only_monom, sep =" ^ String.implode [valOf (TextIO.lookahead(istream))] ^ "\n")) + else if TextIO.lookahead(istream) = SOME #"*" + then + (ignore (TextIO.input1(istream)); + vars := parse_var istream :: (!vars); + parse_aux ()) + else + (vars := parse_var istream :: (!vars); + parse_aux ()) + end + in + parse_aux (); + share_term (rev2 (!vars)) + end; + + fun parse_full_monom istream = + let + val _ = print2 "parse_full_monom\n" + val num = ref 1; + val vars = ref []; + val next_token = ref NONE; + val _ = skip_spaces istream; + in + ( + next_token := TextIO.lookahead(istream); + print2 ("parse_full_monom/next token 1 = '" ^String.implode [valOf (!next_token)] ^ "'\n"); + (case !next_token of + SOME #"-" => + (ignore (TextIO.input1 istream); + num := ~1) + | SOME #"+" => ignore (TextIO.input1 istream) + | _ => ()); + skip_spaces istream; + next_token := TextIO.lookahead(istream); + print2 ("parse_full_monom/next token 2 = '" ^String.implode [valOf (!next_token)] ^ "'\n"); + if !next_token <> NONE andalso is_digit (valOf (!next_token)) + then num := !num * parse_natural istream + else (); + vars := parse_vars_only_monom istream; + next_token := TextIO.lookahead(istream); + print2 ("parse_full_monom/next token 3 = '" ^String.implode [valOf (!next_token)] ^ "'\n"); + (!vars, !num) + ) + end; + + fun parse_comma istream () = + let + val c1 = TextIO.input1(istream); + val c2 = skip_spaces istream; + in + if valOf c1 <> #"," + then raise Parser_Error ("unrecognised ',', found '" ^ String.implode [valOf c1] ^ "'") + else () + end + + + fun parse_polynom istream : (string list * IntInf.int) list = + let + val _ = print2 "parse_poly\n" + val monoms = ref []; + fun parse_aux () = + if TextIO.lookahead(istream) = SOME #"," orelse TextIO.lookahead(istream) = SOME #";" + then print2 ("parse_poly finished" ^ String.implode [valOf (TextIO.lookahead(istream))] ^ "\n") + else (monoms := parse_full_monom istream :: !monoms; + parse_aux ()) + in + (parse_aux (); + rev2 (!monoms)) + end + + fun parse_rule istream = + let val del = ref false; + val _ = skip_spaces istream; + in + case TextIO.input1(istream) of + SOME #"d" => (print2 "rule d:\n"; "d") + | SOME #"+" => + (ignore (TextIO.input1 istream); print2 "rule +:\n"; "+:") + | SOME #"*" => + (ignore (TextIO.input1 istream); print2 "rule *:\n";"*:") + | SOME #"=" => + (print2 "rule =\n"; "=") + | SOME c => raise Parser_Error ("unrecognised rule '" ^ String.implode [c] ^ "'") + end + + fun parse_EOL istream () = + let + val c1 = TextIO.input1(istream); + val _ = skip_spaces istream; + val c2 = TextIO.input1(istream); + fun f () = + (case TextIO.lookahead istream of + SOME #"\n" => (ignore (TextIO.input1 istream); f ()) + | _ => ()) + in + if c1 <> NONE andalso c2 <> NONE andalso (valOf c1 <> #";" orelse valOf c2 <> #"\n") + then raise Parser_Error ("unrecognised EOL '" ^ String.implode [valOf c1, valOf c2] ^ "'") + else f () + end + + fun parse_step istream = + let + val lbl = parse_nat istream; + val _ = print2 ("label = " ^ IntInf.toString (Uint64.toInt lbl)); + val rule = parse_rule istream; + val _ = print2 ("rule = " ^ rule); + in + if rule = "+:" + then + let + val _ = skip_spaces istream; + val src1 = parse_natural istream; + val _ = parse_comma istream (); + val src2 = parse_natural istream; + val _ = parse_comma istream (); + val poly = parse_polynom istream; + val _ = parse_EOL istream (); + in + (PAC_Checker.Add (src1, src2, + lbl, + (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly))) + end + else if rule = "*:" + then + let + val _ = skip_spaces istream; + val src1 = parse_natural istream; + val _ = parse_comma istream (); + val src2 = parse_polynom istream; + val _ = parse_comma istream (); + val poly = parse_polynom istream; + val _ = parse_EOL istream (); + in + (PAC_Checker.Mult (src1, + (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) src2), + lbl, + (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly))) + end + else if rule = "d" + then + let + val _ = skip_spaces istream; + val _ = parse_EOL istream (); + in + (PAC_Checker.Del (lbl)) + end + else if rule = "=" + then + let + val _ = skip_spaces istream; + val var = parse_var istream; + val _ = parse_comma istream (); + val ext = parse_polynom istream; + val _ = parse_EOL istream (); + in + (PAC_Checker.Extension (lbl, var, + (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) ext))) + end + else raise Parser_Error ("unrecognised rule '" ^ rule ^ "'") + end + + fun step_polys istream = + let + val polys = ref []; + fun parse_aux () = + if TextIO.lookahead(istream) = NONE + then rev (!polys) + else (polys := parse_step istream :: (!polys); + skip_spaces istream; + parse_EOL istream; + skip_spaces istream; + parse_aux ()) + in + parse_aux () + end + + fun input_poly istream : IntInf.int * (string list * IntInf.int) list = + let val a = parse_natural istream + val _ = skip_spaces istream + val b = (parse_polynom istream) + val _ = print2 ("parsed " ^ IntInf.toString a ^"\n") + in (a,b) end + + fun input_polys istream = + let + val polys = ref []; + fun parse_aux () = + if TextIO.lookahead(istream) = NONE + then rev (!polys) + else (polys := input_poly istream :: (!polys); + parse_EOL istream (); + parse_aux ()) + in + parse_aux () + end + +end diff --git a/thys/PAC_Checker/code/pasteque.mlb b/thys/PAC_Checker/code/pasteque.mlb new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/code/pasteque.mlb @@ -0,0 +1,18 @@ +$(SML_LIB)/basis/basis.mlb +$(SML_LIB)/basis/mlton.mlb + + +local + checker.ML +in +structure PAC_Checker +structure Uint64 +end + +local + parser.sml +in +structure PAC_Parser +end + +pasteque.sml diff --git a/thys/PAC_Checker/code/pasteque.sml b/thys/PAC_Checker/code/pasteque.sml new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/code/pasteque.sml @@ -0,0 +1,181 @@ +fun println x = print (x ^ "\n") + + +fun print_help () = ( + println ("Usage: pactrim [option] \n" ^ + " or pactrim --version\n" ^ + "\n" ^ + "Prints\n" ^ + "s SUCCESSFULL: if everything worked\n" ^ + "s FAILED, but correct PAC: if the PAC file is correct, but\n" ^ + "\tthe spec was not derived\n" ^ + "s PAC FAILED: if the PAC file is incorrect\n" ^ + "\n" ^ + "\n" ^ + "Option:\n" ^ + "--uloop (unsafe loop): use the non-verified loop instead of \n" ^ + "\tthe verified loop. This is faster because the file does not\n" ^ + "\t have to be parsed upfront.") +) + +fun readfile istream = + let val a = TextIO.inputLine istream + in if a = NONE then [] else valOf a :: readfile istream + end + + +fun print_poly [] = (print " + 0") + | print_poly ((i, m) :: xs) = + (print (IntInf.toString i ^" * "); + map print m; + print_poly xs) +fun print_input_poly (lbl, poly) = + (println (Int.toString lbl); print_poly poly) + +fun parse_polys_file file_name = let + val istream = TextIO.openIn file_name + val a = map (fn x => + let val (lbl, poly) = x + in + (PAC_Checker.nat_of_integer lbl, + map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly) + end) + (PAC_Parser.input_polys istream) + val _ = TextIO.closeIn istream +in + foldl (fn ((lbl, a), b) => PAC_Checker.pAC_update_impl lbl a b ()) (PAC_Checker.pAC_empty_impl ()) a +end + +fun parse_pac_file file_name = let + val istream = TextIO.openIn file_name + val a = PAC_Parser.step_polys istream + val _ = TextIO.closeIn istream +in + a +end + +fun parse_spec_file file_name = let + val istream = TextIO.openIn file_name + val poly = PAC_Parser.parse_polynom istream + val _ = TextIO.closeIn istream +in + map(fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly +end + +fun print_stat polys_timer pac_timer end_of_init end_of_processing full = + let + fun print_timer d t = print ("c " ^ d ^ " (nonGC): " ^ + Time.toString (Time.+ (#usr (#nongc t), #sys (#nongc t))) ^ " s = " ^ + Time.toString (#usr (#nongc t)) ^ " s (usr) " ^ + Time.toString (#sys (#nongc t)) ^ " s (sys)\n"); + fun print_timer_GC d t = print ("c " ^ d ^ ": " ^ + Time.toString (Time.+ (#usr (#gc t), #sys (#gc t))) ^ " s = " ^ + Time.toString (#usr (#gc t)) ^ " s (usr) " ^ + Time.toString (#sys (#gc t)) ^ " s (sys)\n"); + fun print_full_timer d t = print ("c " ^ d ^ "(full): " ^ + Time.toString (Time.+(Time.+ (#usr (#gc t), #sys (#gc t)), + (Time.+ (#usr (#nongc t), #sys (#nongc t))))) ^ " s\n" ); + val clock = Time.toSeconds (#usr (#nongc end_of_processing)) + Time.toSeconds (#sys (#nongc end_of_processing)); + val _ = print "c\nc\nc ***** stats *****\n" + val _ = print_timer "parsing polys file init" polys_timer + val _ = print_timer "parsing pac file init" pac_timer + val _ = print_timer "full init" end_of_init + val _ = print_timer "time solving" end_of_processing + val _ = print_timer_GC "time GC" end_of_processing + val _ = print_full_timer "time solving" end_of_processing + val _ = print_timer "Overall" full + val _ = print_timer_GC "overall GC" full + val _ = print_full_timer "Overall" full + in + () + end + +fun first (a, b) = a +fun second (a, b) = b + +fun inside_loop [polys, pac, spec] = + let + val init_timer = Timer.startCPUTimer (); + val problem = parse_polys_file polys; + val polys_timer = Timer.checkCPUTimes init_timer; + val timer = Timer.startCPUTimer (); + val _ = println "c polys parsed\nc ******************" + val timer = Timer.startCPUTimer (); + val (spec0 : ((string list * PAC_Checker.int) list)) = parse_spec_file spec; + val _ = println "c spec parsed"; + val end_of_init = Timer.checkCPUTimes init_timer; + val timer = Timer.startCPUTimer (); + val _ = println "c Now checking"; + val spec = PAC_Checker.fully_normalize_poly_impl spec0 (); + val vars = PAC_Checker.empty_vars_impl (); + val (b, (vars, polys)) = PAC_Checker.remap_polys_l_impl spec vars problem (); + val vars = PAC_Checker.union_vars_poly_impl spec0 vars () + val state = ref (b, (vars, polys)) + val istream = TextIO.openIn pac + val _ = + while (TextIO.lookahead(istream) <> NONE andalso PAC_Checker.is_cfailed (first (!state)) = false) + do + let + val st = PAC_Parser.parse_step istream; + val (b, (vars, a)) = !state; + in + state := PAC_Checker.check_step_impl spec b vars a st () + end; + val (b, _) = !state; + val _ = if PAC_Checker.is_cfound b then println "s SUCCESSFULL" + else if (PAC_Checker.is_cfailed b) = false then println "s FAILED, but correct PAC" + else (println "s PAC FAILED"; println (PAC_Checker.implode (PAC_Checker.the_error b))) + val end_of_processing = Timer.checkCPUTimes timer + val full = Timer.checkCPUTimes init_timer + val _ = print_stat polys_timer polys_timer end_of_init end_of_processing full + in () + end + +fun checker [polys, pac, spec] = let + val init_timer = Timer.startCPUTimer (); + val problem = parse_polys_file polys; + val polys_timer = Timer.checkCPUTimes init_timer; + val timer = Timer.startCPUTimer (); + val _ = println "c polys parsed\nc ******************" + val pac : (((string list * PAC_Checker.int) list, string, Uint64.uint64) PAC_Checker.pac_step) list = parse_pac_file pac; +(* val _ = MLton.share pac; *) + val _ = println "c pac parsed" + val pac_timer = Timer.checkCPUTimes timer; + val timer = Timer.startCPUTimer (); + val (spec : ((string list * PAC_Checker.int) list)) = parse_spec_file spec; + val _ = println "c spec parsed"; + val end_of_init = Timer.checkCPUTimes init_timer; + val timer = Timer.startCPUTimer (); + val _ = println "c Now checking"; + val (b, _) = PAC_Checker.full_checker_l_impl spec problem pac (); + val _ = if PAC_Checker.is_cfound b then println "s SUCCESSFULL" + else if (PAC_Checker.is_cfailed b) = false then println "s FAILED, but correct PAC" + else (println "s PAC FAILED"; println (PAC_Checker.implode (PAC_Checker.the_error b))) + val end_of_processing = Timer.checkCPUTimes timer + val full = Timer.checkCPUTimes init_timer + val _ = print_stat polys_timer pac_timer end_of_init end_of_processing full + in + () +end + handle PAC_Parser.Parser_Error err => print("parsing failed with error: " ^ err) + +fun process_args [arg, polys, pac, spec] = + if arg = "--iloop" orelse arg = "--uloop" + then inside_loop [polys, pac, spec] + else print_help() + | process_args [polys, pac, spec] = + checker [polys, pac, spec] + | process_args [arg] = + if arg = "--version" orelse arg = "-v" orelse arg = "-version" + then println (PAC_Checker.version) + else print_help() + | process_args [] = print_help() + +fun main () = let + val args = CommandLine.arguments (); +in + process_args args +end + + +val _ = if MLton.isMLton then main() else () diff --git a/thys/PAC_Checker/document/root.bib b/thys/PAC_Checker/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/document/root.bib @@ -0,0 +1,10 @@ +@inproceedings{KaufmannFleuryBiere-FMCAD20, + author = {Daniela Kaufmann and Mathias Fleury and + Armin Biere}, + editor = {Ofer Strichman and Alexander Ivrii}, + title = {The Proof Checkers Pacheck and Pasteque for the Practical Algebraic Calculus}, + booktitle = {Formal Methods in Computer-Aided Design, {FMCAD} 2020, September 21-24, 2020.}, + publisher = {IEEE}, + year = {2020}, +} +} diff --git a/thys/PAC_Checker/document/root.tex b/thys/PAC_Checker/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/PAC_Checker/document/root.tex @@ -0,0 +1,109 @@ +%Some LaTeX checking: no bad pratices +%\RequirePackage[l2tabu, orthodox]{nag} +%\RequirePackage[all,error]{onlyamsmath} +\RequirePackage{fixltx2e} + +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +% lualatex +%\usepackage{spelling} +\usepackage{fullpage} +\usepackage{graphicx} +\usepackage{comment} + + +\usepackage{mdframed} +%% Saisie en UTF-8 +\usepackage[utf8]{inputenc} +\usepackage[T1]{fontenc} +\usepackage{lmodern} +\usepackage{subcaption} + +%% Pour composer des mathématiques +\usepackage{amsmath,amssymb, amsthm} +\usepackage{nicefrac} +\usepackage{tikz} +\usetikzlibrary{decorations, arrows, shapes, automata, mindmap, trees} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ + +%\usepackage{eurosym} + %for \ + +\usepackage[only,bigsqcap]{stmaryrd} + %for \ +\usepackage{wasysym} + +%\usepackage{eufrak} + %for \ ... \, \ ... \ (also included in amssymb) + +%\usepackage{textcomp} + %for \, \, \, \, \, + %\ + +\usepackage[english]{babel} +% 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} +\let\set\mathbb +\newcommand{\mailto}[1]{\href{mailto:#1}{#1}} + +\newcommand{\shortrules}[3]{#2$\Rightarrow^{\text{#1}}$ #3} +\newcommand{\isasymRes}{\ensuremath{\text{Res}}} + +\begin{document} + + + +\title{PAC Checker} +\author{Mathias Fleury and Daniela Kaufmann} +\maketitle + +\begin{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. 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~\cite{KaufmannFleuryBiere-FMCAD20}. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + + +{\section*{Acknowledgment} +This work is supported by Austrian Science Fund (FWF), NFN S11408-N23 +(RiSE), and LIT AI Lab funded by the State of Upper Austria. +} + +% 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,553 +1,556 @@ ADS_Functor 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 BNF_CC BNF_Operations Banach_Steinhaus Bell_Numbers_Spivey Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues +BirdKMP 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 CYK 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 CofGroups Coinductive Coinductive_Languages Collections Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Complete_Non_Orders Completeness Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Consensus_Refined Constructive_Cryptography Constructor_Funs Containers CoreC++ Core_DOM Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties DFS_Framework DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos 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 FFT FLP FOL-Fitting FOL_Harrison FOL_Seq_Calc1 Factored_Transition_System_Bounding Falling_Factorial_Sum Farkas FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite_Automata_HF First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_SSA Formula_Derivatives Fourier Free-Boolean-Algebra Free-Groups FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC 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 Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Heard_Of Hello_World HereditarilyFinite Hermite Hidden_Markov_Models Higher_Order_Terms Hoare_Time HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL IEEE_Floating_Point IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality +Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interval_Arithmetic_Word32 Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Isabelle_C Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knuth_Bendix_Order 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 Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option 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 Lowe_Ontological_Argument Lower_Semicontinuous Lp Lucas_Theorem 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 Mersenne_Primes MiniML Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security 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 PCF PLM POPLmark-deBruijn PSemigroupsConvolution +PAC_Checker Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Pell Perfect-Number-Thm Perron_Frobenius 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 Projective_Geometry Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem 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 Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Regular-Sets Regular_Algebras Relation_Algebra Relational-Incorrectness-Logic Relational_Disjoint_Set_Forests Relational_Paths Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Root_Balanced_Tree Routing Roy_Floyd_Warshall SATSolverVerification SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_Distance Safe_OCL Saturation_Framework Saturation_Framework_Extensions Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Sort_Encodings Source_Coding_Theorem 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 SuperCalc Surprise_Paradox Symmetric_Polynomials Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Timed_Automata 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 UPF UPF_Firewall UTP Universal_Turing_Machine UpDown_Scheme Valuation VectorSpace VeriComp Verified-Prover VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves VolpanoSmith WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval Word_Lib WorkerWrapper XML ZFC_in_HOL Zeta_3_Irrational Zeta_Function pGCL diff --git a/web/entries/BirdKMP.html b/web/entries/BirdKMP.html new file mode 100644 --- /dev/null +++ b/web/entries/BirdKMP.html @@ -0,0 +1,202 @@ + + + + +Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download
+

 

+

 

+		 +
+

 

+

Putting + + the + + `K' + + into + + Bird's + + derivation + + of + + Knuth-Morris-Pratt + + string + + matching + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching
+ Author: + + Peter Gammie +
Submission date:2020-08-25
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.
BibTeX: + 
@article{BirdKMP-AFP,
+  author  = {Peter Gammie},
+  title   = {Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching},
+  journal = {Archive of Formal Proofs},
+  month   = aug,
+  year    = 2020,
+  note    = {\url{http://isa-afp.org/entries/BirdKMP.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:HOLCF-Prelude
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ 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,208 +1,210 @@ HOLCF-Prelude - Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

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)
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{http://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:
\ No newline at end of file diff --git a/web/entries/Inductive_Inference.html b/web/entries/Inductive_Inference.html new file mode 100644 --- /dev/null +++ b/web/entries/Inductive_Inference.html @@ -0,0 +1,229 @@ + + + + +Some classical results in inductive inference of recursive functions - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download
+

 

+

 

+		 +
+

 

+

Some + + classical + + results + + in + + inductive + + inference + + of + + recursive + + functions + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Some classical results in inductive inference of recursive functions
+ Author: + + Frank J. Balbach (frank-balbach /at/ gmx /dot/ de) +
Submission date:2020-08-31
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 Universal +Turing Machine 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.

BibTeX: + 
@article{Inductive_Inference-AFP,
+  author  = {Frank J. Balbach},
+  title   = {Some classical results in inductive inference of recursive functions},
+  journal = {Archive of Formal Proofs},
+  month   = aug,
+  year    = 2020,
+  note    = {\url{http://isa-afp.org/entries/Inductive_Inference.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/Nested_Multisets_Ordinals.html b/web/entries/Nested_Multisets_Ordinals.html --- a/web/entries/Nested_Multisets_Ordinals.html +++ b/web/entries/Nested_Multisets_Ordinals.html @@ -1,220 +1,220 @@ Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals - Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals

 

- +
Title: Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals
Authors: Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl), - Mathias Fleury (fleury /at/ mpi-inf /dot/ mpg /dot/ de) and + Mathias Fleury and Dmitriy Traytel
Submission date: 2016-11-12
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.
BibTeX: 
@article{Nested_Multisets_Ordinals-AFP,
   author  = {Jasmin Christian Blanchette and Mathias Fleury and Dmitriy Traytel},
   title   = {Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals},
   journal = {Archive of Formal Proofs},
   month   = nov,
   year    = 2016,
   note    = {\url{http://isa-afp.org/entries/Nested_Multisets_Ordinals.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: List-Index, Ordinal
Used by:Functional_Ordered_Resolution_Prover, Lambda_Free_KBOs, Lambda_Free_RPOs, Ordered_Resolution_Prover
Functional_Ordered_Resolution_Prover, Lambda_Free_KBOs, Lambda_Free_RPOs, Ordered_Resolution_Prover, PAC_Checker

Proof outline
Proof document
Browse theories
Download this entry
Older releases:
\ No newline at end of file diff --git a/web/entries/PAC_Checker.html b/web/entries/PAC_Checker.html new file mode 100644 --- /dev/null +++ b/web/entries/PAC_Checker.html @@ -0,0 +1,195 @@ + + + + +Practical Algebraic Calculus Checker - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download
+

 

+

 

+		 +
+

 

+

Practical + + Algebraic + + Calculus + + Checker + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Practical Algebraic Calculus Checker
+ Authors: + + Mathias Fleury and + Daniela Kaufmann +
Submission date:2020-08-31
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.
BibTeX: + 
@article{PAC_Checker-AFP,
+  author  = {Mathias Fleury and Daniela Kaufmann},
+  title   = {Practical Algebraic Calculus Checker},
+  journal = {Archive of Formal Proofs},
+  month   = aug,
+  year    = 2020,
+  note    = {\url{http://isa-afp.org/entries/PAC_Checker.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:Nested_Multisets_Ordinals, Polynomials
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ 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,296 +1,296 @@ Executable Multivariate Polynomials - Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Executable Multivariate Polynomials

 

- +
Title: Executable Multivariate Polynomials
Authors: Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com), 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{http://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, Groebner_Bases, Lambda_Free_KBOs, Symmetric_Polynomials
Deep_Learning, Groebner_Bases, Lambda_Free_KBOs, PAC_Checker, Symmetric_Polynomials

Proof outline
Proof document
Browse theories
Download this entry
Older releases:
\ 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,5058 +1,5083 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

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.

 

 

+ + + + + + + + +
2020
+ 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
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
2020-05-12: Irrationality Criteria for Series by Erdős and Straus
Authors: 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 and Simon Robillard
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
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: Szpilrajn Extension Theorem
Author: Peter Zeller
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
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 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
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
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
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
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 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 and Akihisa Yamada
2018-02-06: First-Order Terms
Authors: 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 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
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
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
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 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 + 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 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
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 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 and Akihisa Yamada
2016-01-29: Polynomial Factorization
Authors: 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, 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 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
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
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
2014-10-03: Certification Monads
Authors: Christian Sternagel and René Thiemann
2014-09-25: Imperative Insertion Sort
Author: 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
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 and Peter Lammich
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
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
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

 

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
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
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
2012-03-01: Abortable Linearizable Modules
Authors: Rachid Guerraoui, Viktor Kuncak and Giuliano Losa
2012-02-29: Executable Transitive Closures
Author: 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
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
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, 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
2010-06-14: Abstract Rewriting
Authors: 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,600 +1,622 @@ 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. - 26 Aug 2020 00:00:00 +0000 + 31 Aug 2020 00:00:00 +0000 + + Practical Algebraic Calculus Checker + https://www.isa-afp.org/entries/PAC_Checker.html + https://www.isa-afp.org/entries/PAC_Checker.html + Mathias Fleury, Daniela Kaufmann + 31 Aug 2020 00:00:00 +0000 + +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. + + + Some classical results in inductive inference of recursive functions + https://www.isa-afp.org/entries/Inductive_Inference.html + https://www.isa-afp.org/entries/Inductive_Inference.html + Frank J. Balbach + 31 Aug 2020 00:00:00 +0000 + +<p> 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. </p> <p> 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. </p> <p> 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 <em>nat +option</em>. 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 +<em>s-m-n</em> theorem, Rice's theorem, and assorted +fixed-point theorems (recursion theorems) by Kleene, Rogers, and +Smullyan. </p> + Relational Disjoint-Set Forests https://www.isa-afp.org/entries/Relational_Disjoint_Set_Forests.html https://www.isa-afp.org/entries/Relational_Disjoint_Set_Forests.html Walter Guttmann 26 Aug 2020 00:00:00 +0000 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. Extensions to the Comprehensive Framework for Saturation Theorem Proving https://www.isa-afp.org/entries/Saturation_Framework_Extensions.html https://www.isa-afp.org/entries/Saturation_Framework_Extensions.html Jasmin Blanchette, Sophie Tourret 25 Aug 2020 00:00:00 +0000 This Isabelle/HOL formalization extends the AFP entry <em>Saturation_Framework</em> 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 <em>Ordered_Resultion_Prover</em>;</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> + Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching + https://www.isa-afp.org/entries/BirdKMP.html + https://www.isa-afp.org/entries/BirdKMP.html + Peter Gammie + 25 Aug 2020 00:00:00 +0000 + +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. + + Amicable Numbers https://www.isa-afp.org/entries/Amicable_Numbers.html https://www.isa-afp.org/entries/Amicable_Numbers.html Angeliki Koutsoukou-Argyraki 04 Aug 2020 00:00:00 +0000 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&#257;bit ibn Qurra's Rule, Euler's Rule, te Riele's Rule and Borho's Rule with breeders. Ordinal Partitions https://www.isa-afp.org/entries/Ordinal_Partitions.html https://www.isa-afp.org/entries/Ordinal_Partitions.html Lawrence C. Paulson 03 Aug 2020 00:00:00 +0000 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$. A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm https://www.isa-afp.org/entries/Chandy_Lamport.html https://www.isa-afp.org/entries/Chandy_Lamport.html Ben Fiedler, Dmitriy Traytel 21 Jul 2020 00:00:00 +0000 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. Relational Characterisations of Paths https://www.isa-afp.org/entries/Relational_Paths.html https://www.isa-afp.org/entries/Relational_Paths.html Walter Guttmann, Peter Höfner 13 Jul 2020 00:00:00 +0000 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. A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles https://www.isa-afp.org/entries/Safe_Distance.html https://www.isa-afp.org/entries/Safe_Distance.html Albert Rizaldi, Fabian Immler 01 Jun 2020 00:00:00 +0000 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. A verified algorithm for computing the Smith normal form of a matrix https://www.isa-afp.org/entries/Smith_Normal_Form.html https://www.isa-afp.org/entries/Smith_Normal_Form.html Jose Divasón 23 May 2020 00:00:00 +0000 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. The Nash-Williams Partition Theorem https://www.isa-afp.org/entries/Nash_Williams.html https://www.isa-afp.org/entries/Nash_Williams.html Lawrence C. Paulson 16 May 2020 00:00:00 +0000 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ć. A Formalization of Knuth–Bendix Orders https://www.isa-afp.org/entries/Knuth_Bendix_Order.html https://www.isa-afp.org/entries/Knuth_Bendix_Order.html Christian Sternagel, René Thiemann 13 May 2020 00:00:00 +0000 We define a generalized version of Knuth&ndash;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. Irrationality Criteria for Series by Erdős and Straus https://www.isa-afp.org/entries/Irrational_Series_Erdos_Straus.html https://www.isa-afp.org/entries/Irrational_Series_Erdos_Straus.html Angeliki Koutsoukou-Argyraki, Wenda Li 12 May 2020 00:00:00 +0000 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. Recursion Theorem in ZF https://www.isa-afp.org/entries/Recursion-Addition.html https://www.isa-afp.org/entries/Recursion-Addition.html Georgy Dunaev 11 May 2020 00:00:00 +0000 This document contains a proof of the recursion theorem. This is a mechanization of the proof of the recursion theorem from the text <i>Introduction to Set Theory</i>, 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. An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation https://www.isa-afp.org/entries/LTL_Normal_Form.html https://www.isa-afp.org/entries/LTL_Normal_Form.html Salomon Sickert 08 May 2020 00:00:00 +0000 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. Formalization of Forcing in Isabelle/ZF https://www.isa-afp.org/entries/Forcing.html https://www.isa-afp.org/entries/Forcing.html Emmanuel Gunther, Miguel Pagano, Pedro Sánchez Terraf 06 May 2020 00:00:00 +0000 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. Banach-Steinhaus Theorem https://www.isa-afp.org/entries/Banach_Steinhaus.html https://www.isa-afp.org/entries/Banach_Steinhaus.html Dominique Unruh, Jose Manuel Rodriguez Caballero 02 May 2020 00:00:00 +0000 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. Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems https://www.isa-afp.org/entries/Attack_Trees.html https://www.isa-afp.org/entries/Attack_Trees.html Florian Kammueller 27 Apr 2020 00:00:00 +0000 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. Power Sum Polynomials https://www.isa-afp.org/entries/Power_Sum_Polynomials.html https://www.isa-afp.org/entries/Power_Sum_Polynomials.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>This article provides a formalisation of the symmetric multivariate polynomials known as <em>power sum polynomials</em>. These are of the form p<sub>n</sub>(<em>X</em><sub>1</sub>,&hellip;, <em>X</em><sub><em>k</em></sub>) = <em>X</em><sub>1</sub><sup>n</sup> + &hellip; + X<sub><em>k</em></sub><sup>n</sup>. A formal proof of the Girard–Newton Theorem is also given. This theorem relates the power sum polynomials to the elementary symmetric polynomials s<sub><em>k</em></sub> in the form of a recurrence relation (-1)<sup><em>k</em></sup> <em>k</em> s<sub><em>k</em></sub> = &sum;<sub>i&isinv;[0,<em>k</em>)</sub> (-1)<sup>i</sup> s<sub>i</sub> p<sub><em>k</em>-<em>i</em></sub>&thinsp;.</p> <p>As an application, this is then used to solve a generalised form of a puzzle given as an exercise in Dummit and Foote's <em>Abstract Algebra</em>: For <em>k</em> complex unknowns <em>x</em><sub>1</sub>, &hellip;, <em>x</em><sub><em>k</em></sub>, define p<sub><em>j</em></sub> := <em>x</em><sub>1</sub><sup><em>j</em></sup> + &hellip; + <em>x</em><sub><em>k</em></sub><sup><em>j</em></sup>. Then for each vector <em>a</em> &isinv; &#x2102;<sup><em>k</em></sup>, show that there is exactly one solution to the system p<sub>1</sub> = a<sub>1</sub>, &hellip;, p<sub><em>k</em></sub> = a<sub><em>k</em></sub> up to permutation of the <em>x</em><sub><em>i</em></sub> and determine the value of p<sub><em>i</em></sub> for i&gt;k.</p> The Lambert W Function on the Reals https://www.isa-afp.org/entries/Lambert_W.html https://www.isa-afp.org/entries/Lambert_W.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>The Lambert <em>W</em> function is a multi-valued function defined as the inverse function of <em>x</em> &#x21A6; <em>x</em> e<sup><em>x</em></sup>. Besides numerous applications in combinatorics, physics, and engineering, it also frequently occurs when solving equations containing both e<sup><em>x</em></sup> and <em>x</em>, or both <em>x</em> and log <em>x</em>.</p> <p>This article provides a definition of the two real-valued branches <em>W</em><sub>0</sub>(<em>x</em>) and <em>W</em><sub>-1</sub>(<em>x</em>) and proves various properties such as basic identities and inequalities, monotonicity, differentiability, asymptotic expansions, and the MacLaurin series of <em>W</em><sub>0</sub>(<em>x</em>) at <em>x</em> = 0.</p> Gaussian Integers https://www.isa-afp.org/entries/Gaussian_Integers.html https://www.isa-afp.org/entries/Gaussian_Integers.html Manuel Eberl 24 Apr 2020 00:00:00 +0000 <p>The Gaussian integers are the subring &#8484;[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.</p> <p>Lastly, this Gaussian integer formalisation is used in two short applications:</p> <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> <p>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.</p> Matrices for ODEs https://www.isa-afp.org/entries/Matrices_for_ODEs.html https://www.isa-afp.org/entries/Matrices_for_ODEs.html Jonathan Julian Huerta y Munive 19 Apr 2020 00:00:00 +0000 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. Authenticated Data Structures As Functors https://www.isa-afp.org/entries/ADS_Functor.html https://www.isa-afp.org/entries/ADS_Functor.html Andreas Lochbihler, Ognjen Marić 16 Apr 2020 00:00:00 +0000 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. Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows https://www.isa-afp.org/entries/Sliding_Window_Algorithm.html https://www.isa-afp.org/entries/Sliding_Window_Algorithm.html Lukas Heimes, Dmitriy Traytel, Joshua Schneider 10 Apr 2020 00:00:00 +0000 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. A Comprehensive Framework for Saturation Theorem Proving https://www.isa-afp.org/entries/Saturation_Framework.html https://www.isa-afp.org/entries/Saturation_Framework.html Sophie Tourret 09 Apr 2020 00:00:00 +0000 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. Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations https://www.isa-afp.org/entries/MFODL_Monitor_Optimized.html https://www.isa-afp.org/entries/MFODL_Monitor_Optimized.html Thibault Dardinier, Lukas Heimes, Martin Raszyk, Joshua Schneider, Dmitriy Traytel 09 Apr 2020 00:00:00 +0000 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. Stateful Protocol Composition and Typing https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html https://www.isa-afp.org/entries/Stateful_Protocol_Composition_and_Typing.html Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker 08 Apr 2020 00:00:00 +0000 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 https://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html https://www.isa-afp.org/entries/Automated_Stateful_Protocol_Verification.html Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker, Anders Schlichtkrull 08 Apr 2020 00:00:00 +0000 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. Lucas's Theorem https://www.isa-afp.org/entries/Lucas_Theorem.html https://www.isa-afp.org/entries/Lucas_Theorem.html Chelsea Edmonds 07 Apr 2020 00:00:00 +0000 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 <em>n</em>, an alternate binomial theorem statement, and a formalised proof of the Freshman's dream (mod <em>p</em>) 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. - - Strong Eventual Consistency of the Collaborative Editing Framework WOOT - https://www.isa-afp.org/entries/WOOT_Strong_Eventual_Consistency.html - https://www.isa-afp.org/entries/WOOT_Strong_Eventual_Consistency.html - Emin Karayel, Edgar Gonzàlez - 25 Mar 2020 00:00:00 +0000 - -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's topology and his proof of the infinitude of primes - https://www.isa-afp.org/entries/Furstenberg_Topology.html - https://www.isa-afp.org/entries/Furstenberg_Topology.html - Manuel Eberl - 22 Mar 2020 00:00:00 +0000 - -<p>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.</p> -<p>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.</p> - - - An Under-Approximate Relational Logic - https://www.isa-afp.org/entries/Relational-Incorrectness-Logic.html - https://www.isa-afp.org/entries/Relational-Incorrectness-Logic.html - Toby Murray - 12 Mar 2020 00:00:00 +0000 - -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. - diff --git a/web/statistics.html b/web/statistics.html --- a/web/statistics.html +++ b/web/statistics.html @@ -1,307 +1,307 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Statistics

 

Statistics

- - - - + + + +
Number of Articles:551
Number of Authors:361
Number of lemmas:~148,900
Lines of Code:~2,609,400
Number of Articles:554
Number of Authors:363
Number of lemmas:~150,600
Lines of Code:~2,632,700

Most used AFP articles:

NameUsed by ? articles
1. List-Index 15
2. Coinductive 12
Collections 12
Regular-Sets 12
3. Landau_Symbols 11
4. Polynomial_Factorization 10
Show 10
5. Abstract-Rewriting 9
Automatic_Refinement 9
Deriving 9
6. Jordan_Normal_Form 8
Native_Word 8

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,899 +1,903 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Index by Topic

 

Computer science

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  

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   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   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   Distributed: DiskPaxos   GenClock   ClockSynchInst   Heard_Of   Consensus_Refined   Abortable_Linearizable_Modules   IMAP-CRDT   CRDT   Chandy_Lamport   OpSets   Stellar_Quorums   WOOT_Strong_Eventual_Consistency   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   Smith_Normal_Form   Safe_Distance   Optimization: Simplex  

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  

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   Auto2_Imperative_HOL   IMP2_Binary_Heap   Priority_Search_Trees   Interval_Arithmetic_Word32   ADS_Functor   Relational_Disjoint_Set_Forests  

Functional programming

Optics   CryptHOL   Probabilistic_While   Monad_Normalisation   Monomorphic_Monad   Show   Certification_Monads   Partial_Function_MR   Lifting_Definition_Option   Coinductive   Stream-Fusion   Tycon   Monad_Memo_DP   XML   Tail_Recursive_Functions   Stream_Fusion_Code   Applicative_Lifting   HOLCF-Prelude   BNF_CC   Binding_Syntax_Theory   Generalized_Counting_Sort   Hello_World   + BirdKMP  

Hardware

SPARCv8  

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   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   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   Compiling: CakeML_Codegen   Compiling-Exceptions-Correctly   NormByEval   Density_Compiler   VeriComp   Static analysis: RIPEMD-160-SPARK   Program-Conflict-Analysis   Shivers-CFA   Slicing   HRB-Slicing   InfPathElimination   Abs_Int_ITP2012   Transformations: Call_Arity   Refine_Imperative_HOL   WorkerWrapper   Monad_Memo_DP   Formal_SSA   Minimal_SSA   Misc: JiveDataStoreModel   Pop_Refinement   Case_Labeling  

Security

Multi_Party_Computation   Noninterference_Generic_Unwinding   Noninterference_Ipurge_Unwinding   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   Cryptography: Game_Based_Crypto   Sigma_Commit_Crypto   CryptHOL   Constructive_Cryptography   RSAPSS   Elliptic_Curves_Group_Law  

Semantics

Launchbury   Clean   Transformer_Semantics   HOL-CSP   QHLProver   TESL_Language   Isabelle_C  

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  

General logic

Classical propositional logic: Free-Boolean-Algebra   Classical first-order logic: FOL-Fitting   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   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   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   Recursion-Addition   Ordinal_Partitions  

Proof theory

Propositional_Proof_Systems   Completeness   SequentInvertibility   Incompleteness   Abstract_Completeness   SuperCalc   Incredible_Proof_Machine   Surprise_Paradox   Abstract_Soundness   FOL_Seq_Calc1  

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  

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   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   Matrices_for_ODEs   Smith_Normal_Form  

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   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  

Probability theory

DiscretePricing   CryptHOL   Constructive_Cryptography   Probabilistic_While   Markov_Models   Density_Compiler   Probabilistic_Timed_Automata   Hidden_Markov_Models   Random_Graph_Subgraph_Threshold   Ergodic_Theory   Source_Coding_Theorem   Buffons_Needle  

Number theory

Arith_Prog_Rel_Primes   Pell   Minkowskis_Theorem   E_Transcendental   Pi_Transcendental   Liouville_Numbers   Prime_Harmonic_Series   Fermat3_4   Perfect-Number-Thm   SumSquares   Lehmer   Pratt_Certificate   Dirichlet_Series   Gauss_Sums   Zeta_Function   Stern_Brocot   Bertrands_Postulate   Bernoulli   Diophantine_Eqns_Lin_Hom   Dirichlet_L   Mersenne_Primes   Irrationality_J_Hancl   Prime_Number_Theorem   Probabilistic_Prime_Tests   Prime_Distribution_Elementary   Transcendence_Series_Hancl_Rucki   Zeta_3_Irrational   Furstenberg_Topology   Lucas_Theorem   Gaussian_Integers   Irrational_Series_Erdos_Straus   Amicable_Numbers  

Games and economics

DiscretePricing   ArrowImpossibilityGS   SenSocialChoice   Vickrey_Clarke_Groves   Parity_Game   First_Welfare_Theorem   Randomised_Social_Choice   SDS_Impossibility   Stable_Matching   Fishburn_Impossibility   Neumann_Morgenstern_Utility  

Geometry

Complex_Geometry   Poincare_Disc   Minkowskis_Theorem   Buildings   Chord_Segments   Triangle   Impossible_Geometry   Tarskis_Geometry   General-Triangle   Nullstellensatz   Ptolemys_Theorem   Buffons_Needle   Stewart_Apollonius   Gromov_Hyperbolicity   Projective_Geometry   Quaternions   Octonions  

Topology

Topology   Knot_Theory   Kuratowski_Closure_Complement   Smooth_Manifolds  

Graph theory

Flow_Networks   Prpu_Maxflow   MFMC_Countable   ShortestPath   Gabow_SCC   Graph_Theory   Planarity_Certificates   Max-Card-Matching   Girth_Chromatic   Random_Graph_Subgraph_Threshold   Flyspeck-Tame   Koenigsberg_Friendship   Tree_Decomposition   Menger   Parity_Game   Factored_Transition_System_Bounding   Graph_Saturation   Relational_Paths  

Combinatorics

Card_Equiv_Relations   Twelvefold_Way   Card_Multisets   Card_Partitions   Card_Number_Partitions   Well_Quasi_Orders   Marriage   Bondy   Ramsey-Infinite   Derangements   Euler_Partition   Discrete_Summation   Open_Induction   Latin_Square   Bell_Numbers_Spivey   Catalan_Numbers   Falling_Factorial_Sum   Matroids   Nash_Williams   Ordinal_Partitions  

Category theory

Category3   MonoidalCategory   Category   Category2   AxiomaticCategoryTheory   Bicategory  

Physics

No_FTL_observers   Safe_Distance  

Misc

FunWithFunctions   FunWithTilings   IMO2019  

Tools

Monad_Normalisation   Constructor_Funs   Lazy_Case   Dict_Construction   Case_Labeling   DPT-SAT-Solver   Nominal2   Separata   Proof_Strategy_Language   Diophantine_Eqns_Lin_Hom   BNF_Operations   BNF_CC   Auto2_HOL   Isabelle_C   Automated_Stateful_Protocol_Verification  
\ No newline at end of file